summaryrefslogtreecommitdiff
path: root/guix/build/download.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-01-03 15:47:12 +0100
committerLudovic Courtès <ludo@gnu.org>2020-01-03 16:06:26 +0100
commitf4cde9ac4aedb516c050a30fd999673da434bfa0 (patch)
tree1927e98b7b8882fc72290de59ad6b00cfade5f32 /guix/build/download.scm
parent52207b3938d3ccbeb661ba8d0af563cf1e0e3333 (diff)
download: Do not leak file descriptors on TLS ports.
Fixes <https://bugs.gnu.org/20145>. * guix/build/download.scm (%tls-ports, register-tls-record-port): Remove. (tls-wrap): Remove call to 'register-tls-record-port'. Return a custom binary input/output port instead. This is a backport of what Guile 2.2's (web client) module has been doing. (close-connection): Define as an alias for 'close-port'. * guix/http-client.scm (http-fetch): Remove #:keep-alive? parameter, which was ignored and unused. Pass #:keep-alive? #f to 'http-get'. * guix/lint.scm (probe-uri): Use 'close-port' instead of 'close-connection'. * guix/scripts/substitute.scm (http-multiple-get): Likewise.
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r--guix/build/download.scm66
1 files changed, 37 insertions, 29 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 53a144f126..a7bb3b0d6e 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -28,6 +28,7 @@
#:use-module (guix build utils)
#:use-module (guix progress)
#:use-module (rnrs io ports)
+ #:use-module ((ice-9 binary-ports) #:select (unget-bytevector))
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
@@ -160,15 +161,6 @@ out if the connection could not be established in less than TIMEOUT seconds."
'(gnutls)
'(make-session connection-end/client))
-(define %tls-ports
- ;; Mapping of session record ports to the underlying file port.
- (make-weak-key-hash-table))
-
-(define (register-tls-record-port record-port port)
- "Hold a weak reference from RECORD-PORT to PORT, where RECORD-PORT is a TLS
-session record port using PORT as its underlying communication port."
- (hashq-set! %tls-ports record-port port))
-
(define %x509-certificate-directory
;; The directory where X.509 authority PEM certificates are stored.
(make-parameter (or (getenv "GUIX_TLS_CERTIFICATE_DIRECTORY")
@@ -311,17 +303,40 @@ host name without trailing dot."
(apply throw args))))
(let ((record (session-record-port session)))
- ;; Since we use `fileno' above, the file descriptor behind PORT would be
- ;; closed when PORT is GC'd. If we used `port->fdes', it would instead
- ;; never be closed. So we use `fileno', but keep a weak reference to
- ;; PORT, so the file descriptor gets closed when RECORD is GC'd.
- (register-tls-record-port record port)
-
- ;; Write HTTP requests line by line rather than byte by byte:
- ;; <https://bugs.gnu.org/22966>. This is possible with Guile >= 2.2.
- (setvbuf record 'line)
-
- record)))
+ (define (read! bv start 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 (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)
+ (port-position record))
+ (define (set-position! new-position)
+ (set-port-position! record new-position))
+ (define (close)
+ (unless (port-closed? port)
+ (close-port port))
+ (unless (port-closed? record)
+ (close-port record)))
+
+ (setvbuf record 'block)
+
+ ;; Return a port that wraps RECORD to ensure that closing it also
+ ;; closes PORT, the actual socket port, and its file descriptor.
+ ;; XXX: This wrapper would be unnecessary if GnuTLS could
+ ;; automatically close SESSION's file descriptor when RECORD is
+ ;; closed, but that doesn't seem to be possible currently (as of
+ ;; 3.6.9).
+ (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
+ get-position set-position!
+ close))))
(define (ensure-uri uri-or-string) ;XXX: copied from (web http)
(cond
@@ -429,16 +444,9 @@ VERIFY-CERTIFICATE? is true, verify HTTPS server certificates."
#:verify-certificate? verify-certificate?)
s)))))
-(define (close-connection port)
- "Like 'close-port', but (1) idempotent, and (2) also closes the underlying
-port if PORT is a TLS session record port."
- ;; FIXME: This is a partial workaround for <http://bugs.gnu.org/20145>,
- ;; because 'http-fetch' & co. may return a chunked input port whose 'close'
- ;; method calls 'close-port', not 'close-connection'.
+(define (close-connection port) ;deprecated
(unless (port-closed? port)
- (close-port port))
- (and=> (hashq-ref %tls-ports port)
- close-connection))
+ (close-port port)))
;; XXX: This is an awful hack to make sure the (set-port-encoding! p
;; "ISO-8859-1") call in `read-response' passes, even during bootstrap