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=802a25b1ed5c738aa5f9d3d01f33eb89b22afd1b The branch, stable-2.0 has been updated via 802a25b1ed5c738aa5f9d3d01f33eb89b22afd1b (commit) via 6df03222128887bf9982631183ab1cf6c144fe42 (commit) from 2d6a3144a122982d5b6a9365943f73891bdb87d3 (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 802a25b1ed5c738aa5f9d3d01f33eb89b22afd1b Author: Ludovic Courtès <l...@gnu.org> Date: Wed Jan 15 23:41:23 2014 +0100 web: Don't throw if a response is longer than its Content-Length says. * module/web/response.scm (make-delimited-input-port): Read at most LEN bytes from PORT, instead of trying to read more and returning an error if more is available. Try again when 'get-bytevector-n!' return zero. * test-suite/tests/web-response.test (example-1): Add garbage after the body itself. commit 6df03222128887bf9982631183ab1cf6c144fe42 Author: Ludovic Courtès <l...@gnu.org> Date: Wed Jan 15 23:07:25 2014 +0100 Custom binary input ports sanity-check the return value of 'read!'. * libguile/r6rs-ports.c (cbip_fill_input): Throw an exception when C_OCTETS is greater than what was requested. * test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["custom binary input port 'read!' returns too much"]: New test. ----------------------------------------------------------------------- Summary of changes: libguile/r6rs-ports.c | 10 +++++++--- module/web/response.scm | 27 ++++++++++++++++----------- test-suite/tests/r6rs-ports.test | 9 +++++++++ test-suite/tests/web-response.test | 6 ++++-- 4 files changed, 36 insertions(+), 16 deletions(-) diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 790c24c..0b1d162 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -350,9 +350,11 @@ cbip_fill_input (SCM port) if (c_port->read_pos >= c_port->read_end) { /* Invoke the user's `read!' procedure. */ - unsigned c_octets; + size_t c_octets, c_requested; SCM bv, read_proc, octets; + c_requested = c_port->read_buf_size; + /* Use the bytevector associated with PORT as the buffer passed to the `read!' procedure, thereby avoiding additional allocations. */ bv = SCM_CBIP_BYTEVECTOR (port); @@ -366,8 +368,10 @@ cbip_fill_input (SCM port) == SCM_BYTEVECTOR_LENGTH (bv)); octets = scm_call_3 (read_proc, bv, SCM_INUM0, - SCM_I_MAKINUM (CBIP_BUFFER_SIZE)); - c_octets = scm_to_uint (octets); + scm_from_size_t (c_requested)); + c_octets = scm_to_size_t (octets); + if (SCM_UNLIKELY (c_octets > c_requested)) + scm_out_of_range (FUNC_NAME, octets); c_port->read_pos = (unsigned char *) SCM_BYTEVECTOR_CONTENTS (bv); c_port->read_end = (unsigned char *) c_port->read_pos + c_octets; diff --git a/module/web/response.scm b/module/web/response.scm index 570a2d7..58e3f11 100644 --- a/module/web/response.scm +++ b/module/web/response.scm @@ -1,6 +1,6 @@ ;;; HTTP response objects -;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -246,16 +246,21 @@ closes PORT, unless KEEP-ALIVE? is true." bytes-read len)) (define (read! bv start count) - (let ((ret (get-bytevector-n! port bv start count))) - (if (eof-object? ret) - (if (= bytes-read len) - 0 - (fail)) - (begin - (set! bytes-read (+ bytes-read ret)) - (if (> bytes-read len) - (fail) - ret))))) + ;; Read at most LEN bytes in total. HTTP/1.1 doesn't say what to do + ;; when a server provides more than the Content-Length, but it seems + ;; wise to just stop reading at LEN. + (let ((count (min count (- len bytes-read)))) + (let loop ((ret (get-bytevector-n! port bv start count))) + (cond ((eof-object? ret) + (if (= bytes-read len) + 0 ; EOF + (fail))) + ((and (zero? ret) (> count 0)) + ;; Do not return zero since zero means EOF, so try again. + (loop (get-bytevector-n! port bv start count))) + (else + (set! bytes-read (+ bytes-read ret)) + ret))))) (define close (and (not keep-alive?) diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index eaae29f..2b62bed 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -411,6 +411,15 @@ (not (or (port-has-port-position? port) (port-has-set-port-position!? port))))) + (pass-if-exception "custom binary input port 'read!' returns too much" + exception:out-of-range + ;; In Guile <= 2.0.9 this would segfault. + (let* ((read! (lambda (bv start count) + (+ count 4242))) + (port (make-custom-binary-input-port "the port" read! + #f #f #f))) + (get-bytevector-all port))) + (pass-if-equal "custom binary input port supports `port-position', \ not `set-port-position!'" 42 diff --git a/test-suite/tests/web-response.test b/test-suite/tests/web-response.test index f9679f5..99b1293 100644 --- a/test-suite/tests/web-response.test +++ b/test-suite/tests/web-response.test @@ -1,6 +1,6 @@ ;;;; web-response.test --- HTTP responses -*- mode: scheme; coding: utf-8; -*- ;;;; -;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc. +;;;; Copyright (C) 2010, 2011, 2012, 2014 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -39,7 +39,9 @@ Content-Encoding: gzip\r Content-Length: 36\r Content-Type: text/html; charset=utf-8\r \r -abcdefghijklmnopqrstuvwxyz0123456789") +abcdefghijklmnopqrstuvwxyz0123456789 +-> Here is trailing garbage that should be ignored because it is + beyond Content-Length.") (define example-2 "HTTP/1.1 200 OK\r hooks/post-receive -- GNU Guile