summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-03-17 21:34:33 +0100
committerLudovic Courtès <ludo@gnu.org>2016-03-17 23:53:53 +0100
commit097a951e96718a037dbfa6d579e2d26f7dab3e82 (patch)
tree43a40eb58e76e95214d4ad32821b412a76dd9d07
parentfc3ea24bf44d2d47dfb2ba8b1ac4d3a971f5e4c4 (diff)
download: Add 'close-connection'.
Partially fixes <http://bugs.gnu.org/20145>. * guix/build/download.scm (add-weak-reference): Remove. (%tls-ports): New variable. (register-tls-record-port): New procedure. (tls-wrap): Use it instead of 'add-weak-reference'. (close-connection): New procedure.
-rw-r--r--guix/build/download.scm32
1 files changed, 24 insertions, 8 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 8843804c40..0568800d7f 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;;
@@ -34,6 +34,7 @@
#:use-module (ice-9 format)
#:export (open-socket-for-uri
open-connection-for-uri
+ close-connection
resolve-uri-reference
maybe-expand-mirrors
url-fetch
@@ -236,11 +237,14 @@ abbreviation of URI showing the scheme, host, and basename of the file."
(module-autoload! (current-module)
'(gnutls) '(make-session connection-end/client))
-(define add-weak-reference
- (let ((table (make-weak-key-hash-table)))
- (lambda (from to)
- "Hold a weak reference from FROM to TO."
- (hashq-set! table from to))))
+(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 (tls-wrap port server)
"Return PORT wrapped in a TLS connection to SERVER. SERVER must be a DNS
@@ -275,7 +279,7 @@ host name without trailing dot."
;; 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.
- (add-weak-reference record port)
+ (register-tls-record-port record port)
record)))
(define (ensure-uri uri-or-string) ;XXX: copied from (web http)
@@ -337,7 +341,8 @@ ETIMEDOUT error is raised."
(loop (cdr addresses))))))))
(define* (open-connection-for-uri uri #:key timeout)
- "Like 'open-socket-for-uri', but also handle HTTPS connections."
+ "Like 'open-socket-for-uri', but also handle HTTPS connections. The
+resulting port must be closed with 'close-connection'."
(define https?
(eq? 'https (uri-scheme uri)))
@@ -367,6 +372,17 @@ ETIMEDOUT error is raised."
(tls-wrap s (uri-host uri))
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'.
+ (unless (port-closed? port)
+ (close-port port))
+ (and=> (hashq-ref %tls-ports port)
+ close-connection))
+
;; 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
;; where iconv is not available.