[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-86-g76702cd

[Mark H Weaver]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=76702cdcefb1d4a149b78fa0a474d22bed348e75

The branch, stable-2.0 has been updated
       via  76702cdcefb1d4a149b78fa0a474d22bed348e75 (commit)
       via  3b2226ec916b648b23a2ae30ce1a657d16d61314 (commit)
      from  361553b49d89b2668cff967401d602ab930a26c4 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 76702cdcefb1d4a149b78fa0a474d22bed348e75
Author: Mark H Weaver <address@hidden>
Date:   Thu Sep 12 18:45:13 2013 -0400

    Web: Use functional setters in extend-request and extend-response.
    
    * module/web/client.scm (extend-request):
    * module/web/server.scm (extend-response): Reimplement using
      functional setters.

commit 3b2226ec916b648b23a2ae30ce1a657d16d61314
Author: Mark H Weaver <address@hidden>
Date:   Thu Sep 12 18:34:39 2013 -0400

    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.

-----------------------------------------------------------------------

Summary of changes:
 module/web/client.scm |   17 ++++++++---------
 module/web/server.scm |   12 +++++-------
 2 files changed, 13 insertions(+), 16 deletions(-)

diff --git a/module/web/client.scm b/module/web/client.scm
index a018ee1..3f6c45b 100644
--- a/module/web/client.scm
+++ b/module/web/client.scm
@@ -41,6 +41,8 @@
   #:use-module (web uri)
   #:use-module (web http)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
   #:export (current-http-proxy
             open-socket-for-uri
             http-get
@@ -103,14 +105,9 @@
               (loop (cdr addresses))))))))
 
 (define (extend-request r k v . additional)
-  (let ((r (build-request (request-uri r)
-                          #:method (request-method r)
-                          #:version (request-version r)
-                          #:headers
-                          (assoc-set! (copy-tree (request-headers r))
-                                      k v)
-                          #:port (request-port r)
-                          #:meta (request-meta r))))
+  (let ((r (set-field r (request-headers)
+                      (assoc-set! (copy-tree (request-headers r))
+                                  k v))))
     (if (null? additional)
         r
         (apply extend-request r additional))))
@@ -139,6 +136,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 +174,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 54ab9e3..99196fa 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)
@@ -164,12 +165,9 @@ values."
    #:post-error (lambda _ (values #f #f #f))))
 
 (define (extend-response r k v . additional)
-  (let ((r (build-response #:version (response-version r)
-                           #:code (response-code r)
-                           #:headers
-                           (assoc-set! (copy-tree (response-headers r))
-                                       k v)
-                           #:port (response-port r))))
+  (let ((r (set-field r (response-headers)
+                      (assoc-set! (copy-tree (response-headers r))
+                                  k v))))
     (if (null? additional)
         r
         (apply extend-response r additional))))
@@ -232,6 +230,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 +241,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.


hooks/post-receive
-- 
GNU Guile