mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-17 01:00:20 +02:00
Code Activity

Web client+server: Add Content-Length header for empty bodies.

Browse source 
* module/web/client.scm (sanitize-request): Add a Content-Length
  header if a body if given, even if the body is empty.

* module/web/server.scm (sanitize-response): Add a Content-Length
  header if a body if given, even if the body is empty.
This commit is contained in:
Mark H Weaver 2013-09-12 18:34:39 -04:00
parent 361553b49d
commit 3b2226ec91
2 changed files with 4 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/web/client.scm
View file

@ -139,6 +139,9 @@ as is the case by default with a request returned by `build-request'."
((not body) ((not body)
(let ((length (request-content-length request))) (let ((length (request-content-length request)))
(if length (if length
;; FIXME make this stricter: content-length header should be
;; prohibited if there's no body, even if the content-length
;; is 0.
(unless (zero? length) (unless (zero? length)
(error "content-length, but no body")) (error "content-length, but no body"))
(when (assq 'transfer-encoding (request-headers request)) (when (assq 'transfer-encoding (request-headers request))
@ -174,7 +177,6 @@ as is the case by default with a request returned by `build-request'."
(rlen (if (= rlen blen) (rlen (if (= rlen blen)
request request
(error "bad content-length" rlen blen))) (error "bad content-length" rlen blen)))
((zero? blen) request)
(else (extend-request request 'content-length blen)))) (else (extend-request request 'content-length blen))))
body)))) body))))

2
module/web/server.scm
View file

@ -232,6 +232,7 @@ on the procedure being called at any particular time."
(error "unexpected body type")) (error "unexpected body type"))
((and (response-must-not-include-body? response) ((and (response-must-not-include-body? response)
body body
;; FIXME make this stricter: even an empty body should be prohibited.
(not (zero? (bytevector-length body)))) (not (zero? (bytevector-length body))))
(error "response with this status code must not include body" response)) (error "response with this status code must not include body" response))
(else (else
@ -242,7 +243,6 @@ on the procedure being called at any particular time."
(rlen (if (= rlen blen) (rlen (if (= rlen blen)
response response
(error "bad content-length" rlen blen))) (error "bad content-length" rlen blen)))
((zero? blen) response)
(else (extend-response response 'content-length blen)))) (else (extend-response response 'content-length blen))))
(if (eq? (request-method request) 'HEAD) (if (eq? (request-method request) 'HEAD)
;; Responses to HEAD requests must not include bodies. ;; Responses to HEAD requests must not include bodies.