[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-224-g32299e4

[Andy Wingo]

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=32299e49e83b941082bee348c993630bb455a324

The branch, stable-2.0 has been updated
       via  32299e49e83b941082bee348c993630bb455a324 (commit)
       via  64ead01db7d5110e94be5d6d984aaa8ead4e5e8c (commit)
       via  312e79f8d5bc5a70fccb0dc8b13260acf688493b (commit)
      from  8210c8538a6efb48d8adaf402546f30a8b249bcb (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 32299e49e83b941082bee348c993630bb455a324
Author: Andy Wingo <address@hidden>
Date:   Fri Jul 6 22:24:25 2012 +0200

    add http/1.1 transfer codings to the NEWS
    
    * doc/ref/web.texi (Transfer Codings): Add a note about modules.
    * NEWS: Add NEWS for transfer codings.

commit 64ead01db7d5110e94be5d6d984aaa8ead4e5e8c
Author: Ian Price <address@hidden>
Date:   Tue May 8 00:18:59 2012 +0100

    Document and export `declare-opaque-header!'
    
    * module/web/http.scm (declare-opaque-header!): Add docstring. New export.
    * doc/ref/web.texi (HTTP): Add documentation.

commit 312e79f8d5bc5a70fccb0dc8b13260acf688493b
Author: Ian Price <address@hidden>
Date:   Tue May 8 00:06:01 2012 +0100

    Add HTTP Chunked Encoding support to web modules.
    
    * doc/ref/web.texi(Transfer Codings): New subsection for transfer codings.
    * module/web/http.scm(make-chunked-input-port,
      make-chunked-output-port): New procedures.
    * module/web/response.scm (read-response-body): Handle chunked responses.
    * test-suite/tests/web-response.test: Add test.
    * test-suite/tests/web-http.test: Add tests.
    
    afd

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

Summary of changes:
 NEWS                               |    8 ++-
 doc/ref/web.texi                   |   71 ++++++++++++++++++++++++
 module/web/http.scm                |  107 +++++++++++++++++++++++++++++++++++-
 module/web/response.scm            |   18 ++++--
 test-suite/tests/web-http.test     |   20 +++++++
 test-suite/tests/web-response.test |   24 ++++++++
 6 files changed, 239 insertions(+), 9 deletions(-)

diff --git a/NEWS b/NEWS
index 65272d9..1225206 100644
--- a/NEWS
+++ b/NEWS
@@ -84,6 +84,10 @@ SMOB that was actually applied.  (There was a weak-key map 
from SMOB to
 trampoline functions, where the value had a strong reference on the
 key.)  This has been fixed.  There was much rejoicing!
 
+** Support for HTTP/1.1 chunked transfer coding
+
+See "Transfer Codings" in the manual, for more.
+
 ** Micro-optimizations
 
 A pile of micro-optimizations: the `string-trim' function when called
@@ -107,7 +111,7 @@ with regards to formal parameters of functions.  Thanks to 
Bake Timmons.
 * New interfaces
 
 ** New C function: `scm_to_pointer'
-** New C functions: `scm_new_smob', `scm_new_double_smob'
+** New C inline functions: `scm_new_smob', `scm_new_double_smob'
 ** (ice-9 format): Add ~h specifier for localized number output.
 ** (web response): New procedure: `response-must-not-include-body?'
 ** New predicate: 'supports-source-properties?'
@@ -116,6 +120,8 @@ with regards to formal parameters of functions.  Thanks to 
Bake Timmons.
 ** (language tree-il): New functions: `tree-il=?', `tree-il-hash'
 ** New fluid: `%default-port-conversion-strategy'
 ** New syntax: `=>' within `case'
+** (web http): `make-chunked-input-port', `make-chunked-output-port'
+** (web http): `declare-opaque-header!'
 
 Search the manual for these identifiers, for more information.
 
diff --git a/doc/ref/web.texi b/doc/ref/web.texi
index a3d92ad..161a28d 100644
--- a/doc/ref/web.texi
+++ b/doc/ref/web.texi
@@ -37,6 +37,7 @@ back.
 * URIs::                        Universal Resource Identifiers.
 * HTTP::                        The Hyper-Text Transfer Protocol.
 * HTTP Headers::                How Guile represents specific header values.
+* Transfer Codings::            HTTP Transfer Codings.
 * Requests::                    HTTP requests.
 * Responses::                   HTTP responses.
 * Web Client::                  Accessing web resources over HTTP.
@@ -397,6 +398,11 @@ HTTP stack like this:
     (display (inet-ntoa ip) port)))
 @end example
 
address@hidden {Scheme Procedure} declare-opaque-header! name
+A specialised version of @code{declare-header!} for the case in which
+you want a header's value to be returned/written ``as-is''.
address@hidden deffn
+
 @deffn {Scheme Procedure} valid-header? sym val
 Return a true value iff @var{val} is a valid Scheme value for the header
 with name @var{sym}.
@@ -1020,6 +1026,71 @@ A list of challenges to a user, indicating the need for 
authentication.
 @end example
 @end deftypevr
 
address@hidden Transfer Codings
address@hidden Transfer Codings
+
+HTTP 1.1 allows for various transfer codings to be applied to message
+bodies. These include various types of compression, and HTTP chunked
+encoding. Currently, only chunked encoding is supported by guile.
+
+Chunked coding is an optional coding that may be applied to message
+bodies, to allow messages whose length is not known beforehand to be
+returned. Such messages can be split into chunks, terminated by a final
+zero length chunk.
+
+In order to make dealing with encodings more simple, guile provides
+procedures to create ports that ``wrap'' existing ports, applying
+transformations transparently under the hood.
+
+These procedures are in the @code{(web http)} module.
+
address@hidden
+(use-modules (web http))
address@hidden example
+
address@hidden {Scheme Procedure} make-chunked-input-port port 
[#:keep-alive?=#f]
+Returns a new port, that transparently reads and decodes chunk-encoded
+data from @var{port}. If no more chunk-encoded data is available, it
+returns the end-of-file object. When the port is closed, @var{port} will
+also be closed, unless @var{keep-alive?} is true.
address@hidden deffn
+
address@hidden
+(use-modules (ice-9 rdelim))
+
+(define s "5\r\nFirst\r\nA\r\n line\n Sec\r\n8\r\nond line\r\n0\r\n")
+(define p (make-chunked-input-port (open-input-string s)))
+(read-line s)
address@hidden "First line"
+(read-line s)
address@hidden "Second line"
address@hidden example
+
address@hidden {Scheme Procedure} make-chunked-output-port port 
[#:keep-alive?=#f]
+Returns a new port, which transparently encodes data as chunk-encoded
+before writing it to @var{port}. Whenever a write occurs on this port,
+it buffers it, until the port is flushed, at which point it writes a
+chunk containing all the data written so far. When the port is closed,
+the data remaining is written to @var{port}, as is the terminating zero
+chunk. It also causes @var{port} to be closed, unless @var{keep-alive?}
+is true.
+
+Note. Forcing a chunked output port when there is no data is buffered
+does not write a zero chunk, as this would cause the data to be
+interpreted incorrectly by the client.
address@hidden deffn
+
address@hidden
+(call-with-output-string
+  (lambda (out)
+    (define out* (make-chunked-output-port out #:keep-alive? #t))
+    (display "first chunk" out*)
+    (force-output out*)
+    (force-output out*) ; note this does not write a zero chunk
+    (display "second chunk" out*)
+    (close-port out*)))
address@hidden "b\r\nfirst chunk\r\nc\r\nsecond chunk\r\n0\r\n"
address@hidden example
 
 @node Requests
 @subsection HTTP Requests
diff --git a/module/web/http.scm b/module/web/http.scm
index d579c52..cc5dd5a 100644
--- a/module/web/http.scm
+++ b/module/web/http.scm
@@ -34,11 +34,15 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-19)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 q)
+  #:use-module (ice-9 binary-ports)
+  #:use-module (rnrs bytevectors)
   #:use-module (web uri)
   #:export (string->header
             header->string
 
             declare-header!
+            declare-opaque-header!
             known-header?
             header-parser
             header-validator
@@ -59,7 +63,10 @@
             read-request-line
             write-request-line
             read-response-line
-            write-response-line))
+            write-response-line
+
+            make-chunked-input-port
+            make-chunked-output-port))
 
 
 ;;; TODO
@@ -1139,6 +1146,8 @@ phrase\"."
 ;; emacs: (put 'declare-header! 'scheme-indent-function 1)
 ;; emacs: (put 'declare-opaque!-header 'scheme-indent-function 1)
 (define (declare-opaque-header! name)
+  "Declares a given header as \"opaque\", meaning that its value is not
+treated specially, and is just returned as a plain string."
   (declare-header! name
     parse-opaque-string validate-opaque-string write-opaque-string))
 
@@ -1799,3 +1808,99 @@ phrase\"."
 ;; WWW-Authenticate = 1#challenge
 ;;
 (declare-challenge-list-header! "WWW-Authenticate")
+
+
+;; Chunked Responses
+(define (read-chunk-header port)
+  (let* ((str (read-line port))
+         (extension-start (string-index str (lambda (c) (or (char=? c #\;)
+                                                       (char=? c #\return)))))
+         (size (string->number (if extension-start ; unnecessary?
+                                   (substring str 0 extension-start)
+                                   str)
+                               16)))
+    size))
+
+(define (read-chunk port)
+  (let ((size (read-chunk-header port)))
+    (read-chunk-body port size)))
+
+(define (read-chunk-body port size)
+  (let ((bv (get-bytevector-n port size)))
+    (get-u8 port)                       ; CR
+    (get-u8 port)                       ; LF
+    bv))
+
+(define* (make-chunked-input-port port #:key (keep-alive? #f))
+  "Returns a new port which translates HTTP chunked transfer encoded
+data from @var{port} into a non-encoded format. Returns eof when it has
+read the final chunk from @var{port}. This does not necessarily mean
+that there is no more data on @var{port}. When the returned port is
+closed it will also close @var{port}, unless the KEEP-ALIVE? is true."
+  (define (next-chunk)
+    (read-chunk port))
+  (define finished? #f)
+  (define (close)
+    (unless keep-alive?
+      (close-port port)))
+  (define buffer #vu8())
+  (define buffer-size 0)
+  (define buffer-pointer 0)
+  (define (read! bv idx to-read)
+    (define (loop to-read num-read)
+      (cond ((or finished? (zero? to-read))
+             num-read)
+            ((<= to-read (- buffer-size buffer-pointer))
+             (bytevector-copy! buffer buffer-pointer
+                               bv (+ idx num-read)
+                               to-read)
+             (set! buffer-pointer (+ buffer-pointer to-read))
+             (loop 0 (+ num-read to-read)))
+            (else
+             (let ((n (- buffer-size buffer-pointer)))
+               (bytevector-copy! buffer buffer-pointer
+                                 bv (+ idx num-read)
+                                 n)
+               (set! buffer (next-chunk))
+               (set! buffer-pointer 0)
+               (set! buffer-size (bytevector-length buffer))
+               (set! finished? (= buffer-size 0))
+               (loop (- to-read n)
+                     (+ num-read n))))))
+    (loop to-read 0))
+  (make-custom-binary-input-port "chunked input port" read! #f #f close))
+
+(define* (make-chunked-output-port port #:key (keep-alive? #f))
+  "Returns a new port which translates non-encoded data into a HTTP
+chunked transfer encoded data and writes this to @var{port}. Data
+written to this port is buffered until the port is flushed, at which
+point it is all sent as one chunk. Take care to close the port when
+done, as it will output the remaining data, and encode the final zero
+chunk. When the port is closed it will also close @var{port}, unless
+KEEP-ALIVE? is true."
+  (define (q-for-each f q)
+    (while (not (q-empty? q))
+      (f (deq! q))))
+  (define queue (make-q))
+  (define (put-char c)
+    (enq! queue c))
+  (define (put-string s)
+    (string-for-each (lambda (c) (enq! queue c))
+                     s))
+  (define (flush)
+    ;; It is important that we do _not_ write a chunk if the queue is
+    ;; empty, since it will be treated as the final chunk.
+    (unless (q-empty? queue)
+      (let ((len (q-length queue)))
+        (display (number->string len 16) port)
+        (display "\r\n" port)
+        (q-for-each (lambda (elem) (write-char elem port))
+                    queue)
+        (display "\r\n" port))))
+  (define (close)
+    (flush)
+    (display "0\r\n" port)
+    (force-output port)
+    (unless keep-alive?
+      (close-port port)))
+  (make-soft-port (vector put-char put-string flush #f close) "w"))
diff --git a/module/web/response.scm b/module/web/response.scm
index 07e1245..6eba69d 100644
--- a/module/web/response.scm
+++ b/module/web/response.scm
@@ -227,13 +227,17 @@ This is true for some response types, like those with 
code 304."
 (define (read-response-body r)
   "Reads the response body from @var{r}, as a bytevector.  Returns
 @code{#f} if there was no response body."
-  (let ((nbytes (response-content-length r)))
-    (and nbytes
-         (let ((bv (get-bytevector-n (response-port r) nbytes)))
-           (if (= (bytevector-length bv) nbytes)
-               bv
-               (bad-response "EOF while reading response body: ~a bytes of ~a"
-                            (bytevector-length bv) nbytes))))))
+  (if (member '(chunked) (response-transfer-encoding r))
+      (let ((chunk-port (make-chunked-input-port (response-port r)
+                                                 #:keep-alive? #t)))
+        (get-bytevector-all chunk-port))
+      (let ((nbytes (response-content-length r)))
+        (and nbytes
+             (let ((bv (get-bytevector-n (response-port r) nbytes)))
+               (if (= (bytevector-length bv) nbytes)
+                   bv
+                   (bad-response "EOF while reading response body: ~a bytes of 
~a"
+                                 (bytevector-length bv) nbytes)))))))
 
 (define (write-response-body r bv)
   "Write @var{bv}, a bytevector, to the port corresponding to the HTTP
diff --git a/test-suite/tests/web-http.test b/test-suite/tests/web-http.test
index 7984565..97f5559 100644
--- a/test-suite/tests/web-http.test
+++ b/test-suite/tests/web-http.test
@@ -20,6 +20,7 @@
 (define-module (test-suite web-http)
   #:use-module (web uri)
   #:use-module (web http)
+  #:use-module (rnrs io ports)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 control)
   #:use-module (srfi srfi-19)
@@ -232,3 +233,22 @@
   (pass-if-parse vary "foo, bar" '(foo bar))
   (pass-if-parse www-authenticate "Basic realm=\"guile\""
                  '((basic (realm . "guile")))))
+
+(with-test-prefix "chunked encoding"
+  (let* ((s "5\r\nFirst\r\nA\r\n line\n Sec\r\n8\r\nond line\r\n0\r\n")
+         (p (make-chunked-input-port (open-input-string s))))
+    (pass-if (equal? "First line\n Second line"
+                     (get-string-all p)))
+    (pass-if (port-eof? (make-chunked-input-port (open-input-string 
"0\r\n")))))
+  (pass-if
+      (equal? (call-with-output-string
+               (lambda (out-raw)
+                 (let ((out-chunked (make-chunked-output-port out-raw
+                                                              #:keep-alive? 
#t)))
+                   (display "First chunk" out-chunked)
+                   (force-output out-chunked)
+                   (display "Second chunk" out-chunked)
+                   (force-output out-chunked)
+                   (display "Third chunk" out-chunked)
+                   (close-port out-chunked))))
+              "b\r\nFirst chunk\r\nc\r\nSecond chunk\r\nb\r\nThird 
chunk\r\n0\r\n")))
diff --git a/test-suite/tests/web-response.test 
b/test-suite/tests/web-response.test
index a21a702..ddd55a7 100644
--- a/test-suite/tests/web-response.test
+++ b/test-suite/tests/web-response.test
@@ -40,6 +40,19 @@ Content-Type: text/html; charset=utf-8\r
 \r
 abcdefghijklmnopqrstuvwxyz0123456789")
 
+(define example-2
+  "HTTP/1.1 200 OK\r
+Transfer-Encoding: chunked\r
+Content-Type: text/plain
+\r
+1c\r
+Lorem ipsum dolor sit amet, \r
+1d\r
+consectetur adipisicing elit,\r
+43\r
+ sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.\r
+0\r\n")
+
 (define (responses-equal? r1 body1 r2 body2)
   (and (equal? (response-version r1) (response-version r2))
        (equal? (response-code r1) (response-code r2))
@@ -100,3 +113,14 @@ abcdefghijklmnopqrstuvwxyz0123456789")
 
     (pass-if "by accessor"
       (equal? (response-content-encoding r) '(gzip)))))
+
+(with-test-prefix "example-2"
+ (let* ((r (read-response (open-input-string example-2)))
+        (b (read-response-body r)))
+   (pass-if (equal? '((chunked))
+                    (response-transfer-encoding r)))
+   (pass-if (equal? b
+                    (string->utf8
+                     (string-append
+                      "Lorem ipsum dolor sit amet, consectetur adipisicing 
elit,"
+                      " sed do eiusmod tempor incididunt ut labore et dolore 
magna aliqua."))))))


hooks/post-receive
-- 
GNU Guile