diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2016-03-17 21:57:15 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2016-03-17 23:53:53 +0100 |
| commit | b879b3e848d9cf4f4cc39ba8164f8b6be346313c (patch) | |
| tree | 809166bda936f38125aa2dbaa01562683a4a08aa /guix/scripts | |
| parent | 958fb14cdb5970ecf846e7b85c076a8ed3fe093b (diff) | |
| download | gnu-guix-b879b3e848d9cf4f4cc39ba8164f8b6be346313c.tar gnu-guix-b879b3e848d9cf4f4cc39ba8164f8b6be346313c.tar.gz | |
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'.
Diffstat (limited to 'guix/scripts')
| -rwxr-xr-x | guix/scripts/substitute.scm | 16 |
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 () |