ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

substitute: Do not leak file descriptors for TLS connections.

Browse source 
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'.
This commit is contained in:
Ludovic Courtès 2016-03-17 21:57:15 +01:00
parent 958fb14cdb
commit b879b3e848
1 changed files with 8 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
guix/scripts/substitute.scm
View file

@ -19,7 +19,7 @@
(define-module (guix scripts substitute) (define-module (guix scripts substitute)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix store) #:use-module ((guix store) #:hide (close-connection))
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix records) #:use-module (guix records)
@ -33,6 +33,7 @@ (define-module (guix scripts substitute)
#:use-module ((guix build download) #:use-module ((guix build download)
#:select (progress-proc uri-abbreviation #:select (progress-proc uri-abbreviation
open-connection-for-uri open-connection-for-uri
close-connection
store-path-abbreviation byte-count->string)) store-path-abbreviation byte-count->string))
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
@ -200,7 +201,7 @@ (define* (fetch uri #:key (buffered? #t) (timeout? #t))
(unless (or (guile-version>? "2.0.9") (unless (or (guile-version>? "2.0.9")
(version>? (version) "2.0.9.39")) (version>? (version) "2.0.9.39"))
(when port (when port
(close-port port)))) (close-connection port))))
(begin (begin
(when (or (not port) (port-closed? port)) (when (or (not port) (port-closed? port))
(set! port (open-connection-for-uri uri)) (set! port (open-connection-for-uri uri))
@ -245,7 +246,7 @@ (define (read-cache-info port)
(uri->string (http-get-error-uri c)) (uri->string (http-get-error-uri c))
(http-get-error-code c) (http-get-error-code c)
(http-get-error-reason c)) (http-get-error-reason c))
(close-port port) (close-connection port)
(warning (_ "ignoring substitute server at '~s'~%") url) (warning (_ "ignoring substitute server at '~s'~%") url)
(values #f #f))) (values #f #f)))
(values (read-cache-info (http-fetch uri (values (read-cache-info (http-fetch uri
@ -555,7 +556,7 @@ (define* (http-multiple-get base-uri proc seed requests
;; Note that even upon "Connection: close", we can read from BODY. ;; Note that even upon "Connection: close", we can read from BODY.
(match (assq 'connection (response-headers resp)) (match (assq 'connection (response-headers resp))
(('connection 'close) (('connection 'close)
(close-port p) (close-connection p)
(connect #f tail result)) ;try again (connect #f tail result)) ;try again
(_ (_
(loop tail result)))))))))) ;keep going (loop tail result)))))))))) ;keep going
@ -623,8 +624,7 @@ (define (do-fetch uri port)
handle-narinfo-response '() handle-narinfo-response '()
requests requests
#:port port))) #:port port)))
(unless (port-closed? port) (close-connection port)
(close-port port))
(newline (current-error-port)) (newline (current-error-port))
result))) result)))
((file #f) ((file #f)
@ -646,7 +646,7 @@ (define (do-fetch uri port)
(begin (begin
(warning (_ "'~a' uses different store '~a'; ignoring it~%") (warning (_ "'~a' uses different store '~a'; ignoring it~%")
url (cache-info-store-directory cache-info)) url (cache-info-store-directory cache-info))
(close-port port) (close-connection port)
#f))))) #f)))))
(define (lookup-narinfos cache paths) (define (lookup-narinfos cache paths)
@ -776,7 +776,7 @@ (define (read! bv start count)
(make-custom-binary-input-port "progress-port-proc" (make-custom-binary-input-port "progress-port-proc"
read! #f #f read! #f #f
(cut close-port port))) (cut close-connection port)))
(define-syntax with-networking (define-syntax with-networking
(syntax-rules () (syntax-rules ()