diff options
author | Mark H Weaver <mhw@netris.org> | 2013-09-13 00:24:04 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2013-09-13 00:24:04 -0400 |
commit | c04bf4337b88ea45641065b7fe70dd0973b8ce94 (patch) | |
tree | 53e2d02477e40bd1da5a45cc3240ea1420691777 /module/web/server.scm | |
parent | 6871327742d3e1a0966aa8fed04c911311c12c2a (diff) | |
parent | 803c087e6b72f59ed9e529c1e1ca4fbe34e8eda5 (diff) | |
download | guile-c04bf4337b88ea45641065b7fe70dd0973b8ce94.tar.gz |
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts:
module/srfi/srfi-9.scm
module/web/server.scm
Diffstat (limited to 'module/web/server.scm')
-rw-r--r-- | module/web/server.scm | 10 |
1 files changed, 4 insertions, 6 deletions
diff --git a/module/web/server.scm b/module/web/server.scm index affc2e6b6..471bb98de 100644 --- a/module/web/server.scm +++ b/module/web/server.scm @@ -74,6 +74,7 @@ (define-module (web server) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (rnrs bytevectors) #:use-module (ice-9 binary-ports) #:use-module (web request) @@ -167,11 +168,8 @@ values." (define (extend-alist alist k v) (let ((pair (assq k alist))) (acons k v (if pair (delq pair alist) alist)))) - (let ((r (build-response #:version (response-version r) - #:code (response-code r) - #:headers - (extend-alist (response-headers r) k v) - #:port (response-port r)))) + (let ((r (set-field r (response-headers) + (extend-alist (response-headers r) k v)))) (if (null? additional) r (apply extend-response r additional)))) @@ -234,6 +232,7 @@ on the procedure being called at any particular time." (error "unexpected body type")) ((and (response-must-not-include-body? response) body + ;; FIXME make this stricter: even an empty body should be prohibited. (not (zero? (bytevector-length body)))) (error "response with this status code must not include body" response)) (else @@ -244,7 +243,6 @@ on the procedure being called at any particular time." (rlen (if (= rlen blen) response (error "bad content-length" rlen blen))) - ((zero? blen) response) (else (extend-response response 'content-length blen)))) (if (eq? (request-method request) 'HEAD) ;; Responses to HEAD requests must not include bodies. |