download: Fix premature socket close on TLS connections.

This would manifest when downloading a large file such as the Bazaar
tarball, leading to an "Error in the pull function" GnuTLS exception.

* guix/build/download.scm (add-weak-reference): New procedure.
  (tls-wrap): Add (add-weak-reference record port).
This commit is contained in:
Ludovic Courtès 2013-05-10 01:14:25 +02:00
parent a81bc5312b
commit dd9afe64b5

View file

@ -101,6 +101,12 @@ (define (ftp-fetch uri 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
(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-wrap port) (define (tls-wrap port)
"Return PORT wrapped in a TLS connection." "Return PORT wrapped in a TLS connection."
(define (log level str) (define (log level str)
@ -117,7 +123,13 @@ (define (log level str)
;;(set-log-procedure! log) ;;(set-log-procedure! log)
(handshake session) (handshake session)
(session-record-port session))) (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.
(add-weak-reference record port)
record)))
(define (open-connection-for-uri uri) (define (open-connection-for-uri uri)
"Return an open input/output port for a connection to URI. "Return an open input/output port for a connection to URI.