diff options
| author | Mark H Weaver <mhw@netris.org> | 2013-09-12 18:34:39 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2013-09-12 18:36:45 -0400 |
| commit | 3b2226ec916b648b23a2ae30ce1a657d16d61314 (patch) | |
| tree | 60e9b2c2987a414e8ce7b2a90907459f2b14f80c | |
| parent | 361553b49d89b2668cff967401d602ab930a26c4 (diff) | |
| download | guile-3b2226ec916b648b23a2ae30ce1a657d16d61314.tar.gz | |
Web client+server: Add Content-Length header for empty bodies.
* 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.
| -rw-r--r-- | module/web/client.scm | 4 | ||||
| -rw-r--r-- | module/web/server.scm | 2 |
2 files changed, 4 insertions, 2 deletions
diff --git a/module/web/client.scm b/module/web/client.scm index a018ee1ff..4da361ab7 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -139,6 +139,9 @@ as is the case by default with a request returned by `build-request'." ((not body) (let ((length (request-content-length request))) (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) (error "content-length, but no body")) (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) request (error "bad content-length" rlen blen))) - ((zero? blen) request) (else (extend-request request 'content-length blen)))) body)))) diff --git a/module/web/server.scm b/module/web/server.scm index 54ab9e335..bc204808d 100644 --- a/module/web/server.scm +++ b/module/web/server.scm @@ -232,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 @@ -242,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. |