summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-03-17 21:57:15 +0100
committerLudovic Courtès <ludo@gnu.org>2016-03-17 23:53:53 +0100
commitb879b3e848d9cf4f4cc39ba8164f8b6be346313c (patch)
tree809166bda936f38125aa2dbaa01562683a4a08aa
parent958fb14cdb5970ecf846e7b85c076a8ed3fe093b (diff)
substitute: Do not leak file descriptors for TLS connections.
Partially fixes <http://bugs.gnu.org/20145>. * guix/scripts/substitute.scm (fetch, download-cache-info): (http-multiple-get, fetch-narinfos, progress-report-port): Use 'close-connection' instead of 'close-port'.
-rwxr-xr-xguix/scripts/substitute.scm16
1 files changed, 8 insertions, 8 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index c9e2ca3b83..4563f3df0f 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -19,7 +19,7 @@
(define-module (guix scripts substitute)
#:use-module (guix ui)
- #:use-module (guix store)
+ #:use-module ((guix store) #:hide (close-connection))
#:use-module (guix utils)
#:use-module (guix config)
#:use-module (guix records)
@@ -33,6 +33,7 @@
#:use-module ((guix build download)
#:select (progress-proc uri-abbreviation
open-connection-for-uri
+ close-connection
store-path-abbreviation byte-count->string))
#:use-module (ice-9 rdelim)
#:use-module (ice-9 regex)
@@ -200,7 +201,7 @@ provide."
(unless (or (guile-version>? "2.0.9")
(version>? (version) "2.0.9.39"))
(when port
- (close-port port))))
+ (close-connection port))))
(begin
(when (or (not port) (port-closed? port))
(set! port (open-connection-for-uri uri))
@@ -245,7 +246,7 @@ failure, return #f and #f."
(uri->string (http-get-error-uri c))
(http-get-error-code c)
(http-get-error-reason c))
- (close-port port)
+ (close-connection port)
(warning (_ "ignoring substitute server at '~s'~%") url)
(values #f #f)))
(values (read-cache-info (http-fetch uri
@@ -555,7 +556,7 @@ initial connection on which HTTP requests are sent."
;; Note that even upon "Connection: close", we can read from BODY.
(match (assq 'connection (response-headers resp))
(('connection 'close)
- (close-port p)
+ (close-connection p)
(connect #f tail result)) ;try again
(_
(loop tail result)))))))))) ;keep going
@@ -623,8 +624,7 @@ if file doesn't exist, and the narinfo otherwise."
handle-narinfo-response '()
requests
#:port port)))
- (unless (port-closed? port)
- (close-port port))
+ (close-connection port)
(newline (current-error-port))
result)))
((file #f)
@@ -646,7 +646,7 @@ if file doesn't exist, and the narinfo otherwise."
(begin
(warning (_ "'~a' uses different store '~a'; ignoring it~%")
url (cache-info-store-directory cache-info))
- (close-port port)
+ (close-connection port)
#f)))))
(define (lookup-narinfos cache paths)
@@ -776,7 +776,7 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by
(make-custom-binary-input-port "progress-port-proc"
read! #f #f
- (cut close-port port)))
+ (cut close-connection port)))
(define-syntax with-networking
(syntax-rules ()