Message ID | 20210520120413.21644-2-mail@cbaines.net |
---|---|
State | New |
Headers | show |
Series | [bug#47174,v3,1/2] guix: Alter http-fetch to return the response. | expand |
Christopher Baines <mail@cbaines.net> skribis: > When reusing a HTTP connection to fetch multiple nars, and the remote server > signals that the connection should be closed. Incomplete sentence? > * guix/scripts/substitute.scm (process-substitution): Close connections to > substitute servers when a Connection: close header is specified in the > response. > --- > guix/scripts/substitute.scm | 17 ++++++++++++++--- > 1 file changed, 14 insertions(+), 3 deletions(-) > > diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm > index 96f425eaa0..208b8f1273 100755 > --- a/guix/scripts/substitute.scm > +++ b/guix/scripts/substitute.scm > @@ -464,7 +464,9 @@ PORT." > (case (uri-scheme uri) > ((file) > (let ((port (open-file (uri-path uri) "r0b"))) > - (values port (stat:size (stat port))))) > + (values port > + (stat:size (stat port)) > + (const #t)))) ; no cleanup to do > ((http https) > (guard (c ((http-get-error? c) > (leave (G_ "download from '~a' failed: ~a, ~s~%") > @@ -487,7 +489,12 @@ PORT." > #:keep-alive? #t > #:buffered? #f))) > (values raw > - (response-content-length response))))))) > + (response-content-length response) > + (match (assq 'connection (response-headers response)) > + (('connection 'close) > + (lambda () > + (close-port port))) > + (_ (const #t))))))))) > (else > (leave (G_ "unsupported substitute URI scheme: ~a~%") > (uri->string uri))))) > @@ -504,7 +511,7 @@ PORT." > (format (current-error-port) > (G_ "Downloading ~a...~%") (uri->string uri))) > > - (let*-values (((raw download-size) > + (let*-values (((raw download-size post-fetch-cleanup) > ;; 'guix publish' without '--cache' doesn't specify a > ;; Content-Length, so DOWNLOAD-SIZE is #f in this case. > (fetch uri)) > @@ -565,6 +572,10 @@ PORT." > ;; Wait for the reporter to finish. > (every (compose zero? cdr waitpid) pids) > > + ;; Do post-fetch cleanup, maybe closing the HTTP connection if HTTP is > + ;; being used, and the connection should be closed > + (post-fetch-cleanup) How about returning a Boolean as the third value, ‘close?’, indicating whether the port should be closed upon completion? That seems marginally clearer to me that the post-cleanup thunk. Otherwise LGTM, thanks! Ludo’.
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm index 96f425eaa0..208b8f1273 100755 --- a/guix/scripts/substitute.scm +++ b/guix/scripts/substitute.scm @@ -464,7 +464,9 @@ PORT." (case (uri-scheme uri) ((file) (let ((port (open-file (uri-path uri) "r0b"))) - (values port (stat:size (stat port))))) + (values port + (stat:size (stat port)) + (const #t)))) ; no cleanup to do ((http https) (guard (c ((http-get-error? c) (leave (G_ "download from '~a' failed: ~a, ~s~%") @@ -487,7 +489,12 @@ PORT." #:keep-alive? #t #:buffered? #f))) (values raw - (response-content-length response))))))) + (response-content-length response) + (match (assq 'connection (response-headers response)) + (('connection 'close) + (lambda () + (close-port port))) + (_ (const #t))))))))) (else (leave (G_ "unsupported substitute URI scheme: ~a~%") (uri->string uri))))) @@ -504,7 +511,7 @@ PORT." (format (current-error-port) (G_ "Downloading ~a...~%") (uri->string uri))) - (let*-values (((raw download-size) + (let*-values (((raw download-size post-fetch-cleanup) ;; 'guix publish' without '--cache' doesn't specify a ;; Content-Length, so DOWNLOAD-SIZE is #f in this case. (fetch uri)) @@ -565,6 +572,10 @@ PORT." ;; Wait for the reporter to finish. (every (compose zero? cdr waitpid) pids) + ;; Do post-fetch cleanup, maybe closing the HTTP connection if HTTP is + ;; being used, and the connection should be closed + (post-fetch-cleanup) + ;; Skip a line after what 'progress-reporter/file' printed, and another ;; one to visually separate substitutions. When PRINT-BUILD-TRACE? is ;; true, leave it up to (guix status) to prettify things.