mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
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.
This commit is contained in:
parent
fc84f4f13d
commit
0c102b56e9
1 changed files with 12 additions and 2 deletions
|
@ -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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue