diff options
author | Andy Wingo <wingo@pobox.com> | 2017-04-28 13:38:41 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2017-04-28 13:38:41 +0200 |
commit | 0c102b56e98da39b5a3213bdc567a31ad8ef3e73 (patch) | |
tree | 1fa21dcffd8ce9f362c402d16a047c22c6d05b38 /module/web | |
parent | fc84f4f13dde92a9de61bb137cd1cc2c90e853d3 (diff) | |
download | guile-0c102b56e98da39b5a3213bdc567a31ad8ef3e73.tar.gz |
Fix reading of HTTPS responses that are smaller than port buffer
* module/web/client.scm (tls-wrap): Use get-bytevector-some instead of
get-bytevector-n, to prevent Guile from attempting to read more bytes
than are available. Normally trying to read data on a shut-down
socket is fine, but but gnutls issues an error if you attempt to read
data from a shut-down socket, and that appears to be a security
property. Fixes HTTPS requests whose responses are smaller than the
port buffer.
Diffstat (limited to 'module/web')
-rw-r--r-- | module/web/client.scm | 14 |
1 files changed, 12 insertions, 2 deletions
diff --git a/module/web/client.scm b/module/web/client.scm index 0c055abe9..c30fa99eb 100644 --- a/module/web/client.scm +++ b/module/web/client.scm @@ -130,16 +130,25 @@ host name without trailing dot." ;;(set-log-procedure! log) (handshake session) + ;; FIXME: It appears that session-record-port is entirely + ;; sufficient; it's already a port. The only value of this code is + ;; to keep a reference on "port", to keep it alive! To fix this we + ;; need to arrange to either hand GnuTLS its own fd to close, or to + ;; arrange a reference from the session-record-port to the + ;; underlying socket. (let ((record (session-record-port session))) (define (read! bv start count) - (define read-bv (get-bytevector-n record count)) + (define read-bv (get-bytevector-some record)) (if (eof-object? read-bv) 0 ; read! returns 0 on eof-object (let ((read-bv-len (bytevector-length read-bv))) - (bytevector-copy! read-bv 0 bv start read-bv-len) + (bytevector-copy! read-bv 0 bv start (min read-bv-len count)) + (when (< count read-bv-len) + (unget-bytevector record bv count (- read-bv-len count))) read-bv-len))) (define (write! bv start count) (put-bytevector record bv start count) + (force-output record) count) (define (get-position) (rnrs-ports:port-position record)) @@ -150,6 +159,7 @@ host name without trailing dot." (close-port port)) (unless (port-closed? record) (close-port record))) + (setvbuf record 'block) (make-custom-binary-input/output-port "gnutls wrapped port" read! write! get-position set-position! close)))) |