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=e46f69e25ca15f299f11be14b28f82c881074dfc The branch, master has been updated via e46f69e25ca15f299f11be14b28f82c881074dfc (commit) via e7fb779fb0599d81f60350c036a37454a7beb6fe (commit) from 9eed1010e7cdc39c7c0ac18a34414f3653da7a5a (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 e46f69e25ca15f299f11be14b28f82c881074dfc Author: Andy Wingo <wi...@pobox.com> Date: Mon Dec 6 15:30:45 2010 +0100 fix read-{request,response}-body/latin-1 * module/web/request.scm (read-response-body/latin-1): * module/web/response.scm (read-response-body/latin-1): Avoid the craziness of the read-delimited! interface and hand-roll our own. Fixes errors if read-delimited returns #f or EOF. commit e7fb779fb0599d81f60350c036a37454a7beb6fe Author: Andy Wingo <wi...@pobox.com> Date: Mon Dec 6 15:19:40 2010 +0100 update read-delimited! docs * doc/ref/api-io.texi (Line/Delimited): Update the read-delimited! docs. ----------------------------------------------------------------------- Summary of changes: doc/ref/api-io.texi | 19 +++++++++++-------- module/web/request.scm | 28 +++++++++++++++++++--------- module/web/response.scm | 26 ++++++++++++++++++-------- 3 files changed, 48 insertions(+), 25 deletions(-) diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi index e2b1b51..47dc8fc 100644 --- a/doc/ref/api-io.texi +++ b/doc/ref/api-io.texi @@ -534,14 +534,17 @@ from the value returned by @code{(current-input-port)}. @c begin (scm-doc-string "rdelim.scm" "read-delimited!") @deffn {Scheme Procedure} read-delimited! delims buf [port] [handle-delim] [start] [end] -Read text into the supplied string @var{buf} and return the number of -characters added to @var{buf} (subject to @var{handle-delim}, which takes -the same values specified for @code{read-line}. If @var{buf} is filled, -...@code{#f} is returned for both the number of characters read and the -delimiter. Also terminates if one of the characters in the string -...@var{delims} is found -or end-of-file is reached. Read from @var{port} if supplied, otherwise -from the value returned by @code{(current-input-port)}. +Read text into the supplied string @var{buf}. + +If a delimiter was found, return the number of characters written, +except if @var{handle-delim} is @code{split}, in which case the return +value is a pair, as noted above. + +As a special case, if @var{port} was already at end-of-stream, the EOF +object is returned. Also, if no characters were written because the +buffer was full, @code{#f} is returned. + +It's something of a wacky interface, to be honest. @end deffn @deffn {Scheme Procedure} write-line obj [port] diff --git a/module/web/request.scm b/module/web/request.scm index 3451b8a..9f86638 100644 --- a/module/web/request.scm +++ b/module/web/request.scm @@ -192,15 +192,25 @@ ;; Probably not what you want to use "in production". Relies on one byte ;; per char because we are in latin-1 encoding. ;; -(define (read-request-body/latin-1 r) - (let ((nbytes (request-content-length r))) - (and nbytes - (let* ((buf (make-string nbytes)) - (n (read-delimited! "" buf (request-port r)))) - (if (= n nbytes) - buf - (bad-request "EOF while reading request body: ~a bytes of ~a" - n nbytes)))))) +(define (read-response-body/latin-1 r) + (cond + ((request-content-length r) => + (lambda (nbytes) + (let ((buf (make-string nbytes)) + (port (request-port r))) + (let lp ((i 0)) + (cond + ((< i nbytes) + (let ((c (read-char port))) + (cond + ((eof-object? c) + (bad-request "EOF while reading request body: ~a bytes of ~a" + i nbytes)) + (else + (string-set! buf i c) + (lp (1+ i)))))) + (else buf)))))) + (else #f))) ;; Likewise, assumes that body can be written in the latin-1 encoding, ;; and that the latin-1 encoding is what is expected by the server. diff --git a/module/web/response.scm b/module/web/response.scm index a4b1cb9..c3c69cd 100644 --- a/module/web/response.scm +++ b/module/web/response.scm @@ -185,14 +185,24 @@ ;; per char because we are in latin-1 encoding. ;; (define (read-response-body/latin-1 r) - (let ((nbytes (response-content-length r))) - (and nbytes - (let* ((buf (make-string nbytes)) - (n (read-delimited! "" buf (response-port r)))) - (if (= n nbytes) - buf - (bad-response "EOF while reading response body: ~a bytes of ~a" - n nbytes)))))) + (cond + ((response-content-length r) => + (lambda (nbytes) + (let ((buf (make-string nbytes)) + (port (response-port r))) + (let lp ((i 0)) + (cond + ((< i nbytes) + (let ((c (read-char port))) + (cond + ((eof-object? c) + (bad-response "EOF while reading response body: ~a bytes of ~a" + i nbytes)) + (else + (string-set! buf i c) + (lp (1+ i)))))) + (else buf)))))) + (else #f))) ;; Likewise, assumes that body can be written in the latin-1 encoding, ;; and that the latin-1 encoding is what is expected by the server. hooks/post-receive -- GNU Guile
