me/guix
Archived
1
0
Fork 0
Code Activity

download: Add 'close-connection'.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2016-03-17 21:34:33 +01:00
parent fc3ea24bf4
commit 097a951e96
1 changed files with 24 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
guix/build/download.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com> ;;; Copyright © 2015 Steve Sprang <scs@stevesprang.com>
;;; ;;;
@ -34,6 +34,7 @@
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (open-socket-for-uri #:export (open-socket-for-uri
open-connection-for-uri open-connection-for-uri
close-connection
resolve-uri-reference resolve-uri-reference
maybe-expand-mirrors maybe-expand-mirrors
url-fetch url-fetch
@ -236,11 +237,14 @@ abbreviation of URI showing the scheme, host, and basename of the file."
(module-autoload! (current-module) (module-autoload! (current-module)
'(gnutls) '(make-session connection-end/client)) '(gnutls) '(make-session connection-end/client))
(define add-weak-reference (define %tls-ports
(let ((table (make-weak-key-hash-table))) ;; Mapping of session record ports to the underlying file port.
(lambda (from to) (make-weak-key-hash-table))
"Hold a weak reference from FROM to TO."
(hashq-set! table from to)))) (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) (define (tls-wrap port server)
"Return PORT wrapped in a TLS connection to SERVER. SERVER must be a DNS "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 ;; 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 ;; 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. ;; PORT, so the file descriptor gets closed when RECORD is GC'd.
(add-weak-reference record port) (register-tls-record-port record port)
record))) record)))
(define (ensure-uri uri-or-string) ;XXX: copied from (web http) (define (ensure-uri uri-or-string) ;XXX: copied from (web http)
@ -337,7 +341,8 @@ ETIMEDOUT error is raised."
(loop (cdr addresses)))))))) (loop (cdr addresses))))))))
(define* (open-connection-for-uri uri #:key timeout) (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? (define https?
(eq? 'https (uri-scheme uri))) (eq? 'https (uri-scheme uri)))
@ -367,6 +372,17 @@ ETIMEDOUT error is raised."
(tls-wrap s (uri-host uri)) (tls-wrap s (uri-host uri))
s))))) 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 ;; 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 ;; "ISO-8859-1") call in `read-response' passes, even during bootstrap
;; where iconv is not available. ;; where iconv is not available.