mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Add support for content-disposition

Browse source 
* module/web/http.scm ("Content-Disposition"): Add a parser and
  serializer.  Defined in RFC2616 section 19.5.1.

* test-suite/tests/web-http.test ("entity headers"): New test case.
This commit is contained in:
Andy Wingo 2014-01-18 21:08:52 +01:00 • committed by Mark H Weaver
parent 8ca97482b0
commit 6f4cc6a31e
2 changed files with 28 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

26
module/web/http.scm
View file

@ -1,6 +1,6 @@
;;; HTTP messages
;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@ -1483,6 +1483,30 @@ treated specially, and is just returned as a plain string."
;;
(declare-symbol-list-header! "Allow")
;; Content-Disposition = disposition-type *( ";" disposition-parm )
;; disposition-type = "attachment" | disp-extension-token
;; disposition-parm = filename-parm | disp-extension-parm
;; filename-parm = "filename" "=" quoted-string
;; disp-extension-token = token
;; disp-extension-parm = token "=" ( token | quoted-string )
;;
(declare-header! "Content-Disposition"
(lambda (str)
(let ((disposition (parse-param-list str default-val-parser)))
;; Lazily reuse the param list parser.
(unless (and (pair? disposition)
(null? (cdr disposition)))
(bad-header-component 'content-disposition str))
(car disposition)))
(lambda (val)
(and (pair? val)
(symbol? (car val))
(list-of? (cdr val)
(lambda (x)
(and (pair? x) (symbol? (car x)) (string? (cdr x)))))))
(lambda (val port)
(write-param-list (list val) port)))
;; Content-Encoding = 1#content-coding
;;
(declare-symbol-list-header! "Content-Encoding")

4
test-suite/tests/web-http.test
View file

@ -1,6 +1,6 @@
;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
;;;;
;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
;;;; Copyright (C) 2010, 2011, 2014 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@ -252,6 +252,8 @@
(with-test-prefix "entity headers"
(pass-if-parse allow "foo, bar" '(foo bar))
(pass-if-parse content-disposition "form-data; name=\"file\"; filename=\"q.go\""
'(form-data (name . "file") (filename . "q.go")))
(pass-if-parse content-encoding "qux, baz" '(qux baz))
(pass-if-parse content-language "qux, baz" '("qux" "baz"))
(pass-if-parse content-length "100" 100)