ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-24 19:49:25 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

substitute: Rework connection error handling.

Browse source 
This is part of trying to reduce the interdependency of code within the
substitute module.

This commit addresses some of the error handling that was performed through
open-connection-for-uri/maybe. The new approach is to use
call-with-connection-error-handling, and wrap calls to http-multiple-get and
http-fetch with that procedure, which takes care of handling connection
errors.

I think this is even slightly more rigerous than the previous setup, because
this approach handles connection errors that occur when http-multiple-get
reconnects to a host.

* guix/scripts/substitute.scm (open-connection-for-uri/maybe): Transform in to
call-with-connection-error-handling.
(fetch-narinfos): Use call-with-connection-error-handling.
(process-query): Replace open-connection-for-uri/maybe with
open-connection-for-uri/cached.
(open-connection-for-uri/cached): Set a default timeout, matching the
behaviour in open-connection-for-uri/maybe.
(process-substitution): Use call-with-connection-error-handling.
This commit is contained in:
Christopher Baines 2021-02-13 11:06:37 +00:00
parent 187e970968
commit 20c08a8a45
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
1 changed files with 22 additions and 25 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
guix/scripts/substitute.scm
View file

@ -281,22 +281,13 @@ (define %unreachable-hosts
;; Set of names of unreachable hosts. ;; Set of names of unreachable hosts.
(make-hash-table)) (make-hash-table))
(define* (open-connection-for-uri/maybe uri (define* (call-with-connection-error-handling uri proc)
#:key "Call PROC, and catch if a connection fails, print a warning and return #f."
fresh?
(time %fetch-timeout)
verify-certificate?)
"Open a connection to URI via 'open-connection-for-uri/cached' and return a
port to it, or, if connection failed, print a warning and return #f. Pass
#:fresh? to 'open-connection-for-uri/cached'."
(define host (define host
(uri-host uri)) (uri-host uri))
(catch #t (catch #t
(lambda () proc
(open-connection-for-uri/cached uri #:timeout time
#:fresh? fresh?
#:verify-certificate? verify-certificate?))
(match-lambda* (match-lambda*
(('getaddrinfo-error error) (('getaddrinfo-error error)
(unless (hash-ref %unreachable-hosts host) (unless (hash-ref %unreachable-hosts host)
@ -377,11 +368,14 @@ (define (do-fetch uri)
(let* ((requests (map (cut narinfo-request url <>) paths)) (let* ((requests (map (cut narinfo-request url <>) paths))
(result (begin (result (begin
(update-progress!) (update-progress!)
(http-multiple-get uri (call-with-connection-error-handling
handle-narinfo-response '() uri
requests (lambda ()
#:open-connection open-connection (http-multiple-get uri
#:verify-certificate? #f)))) handle-narinfo-response '()
requests
#:open-connection open-connection
#:verify-certificate? #f))))))
(newline (current-error-port)) (newline (current-error-port))
result)) result))
((file #f) ((file #f)
@ -595,7 +589,7 @@ (define valid?
;; Return the subset of PATHS available in CACHE-URLS. ;; Return the subset of PATHS available in CACHE-URLS.
(let ((substitutable (lookup-narinfos/diverse (let ((substitutable (lookup-narinfos/diverse
cache-urls paths valid? cache-urls paths valid?
#:open-connection open-connection-for-uri/maybe))) #:open-connection open-connection-for-uri/cached)))
(for-each (lambda (narinfo) (for-each (lambda (narinfo)
(format #t "~a~%" (narinfo-path narinfo))) (format #t "~a~%" (narinfo-path narinfo)))
substitutable) substitutable)
@ -604,7 +598,7 @@ (define valid?
;; Reply info about PATHS if it's in CACHE-URLS. ;; Reply info about PATHS if it's in CACHE-URLS.
(let ((substitutable (lookup-narinfos/diverse (let ((substitutable (lookup-narinfos/diverse
cache-urls paths valid? cache-urls paths valid?
#:open-connection open-connection-for-uri/maybe))) #:open-connection open-connection-for-uri/cached)))
(for-each display-narinfo-data substitutable) (for-each display-narinfo-data substitutable)
(newline))) (newline)))
(wtf (wtf
@ -617,7 +611,7 @@ (define %max-cached-connections
(define open-connection-for-uri/cached (define open-connection-for-uri/cached
(let ((cache '())) (let ((cache '()))
(lambda* (uri #:key fresh? timeout verify-certificate?) (lambda* (uri #:key fresh? (timeout %fetch-timeout) verify-certificate?)
"Return a connection for URI, possibly reusing a cached connection. "Return a connection for URI, possibly reusing a cached connection.
When FRESH? is true, delete any cached connections for URI and open a new one. When FRESH? is true, delete any cached connections for URI and open a new one.
Return #f if URI's scheme is 'file' or #f. Return #f if URI's scheme is 'file' or #f.
@ -704,11 +698,14 @@ (define (fetch uri)
(warning (G_ "while fetching ~a: server is somewhat slow~%") (warning (G_ "while fetching ~a: server is somewhat slow~%")
(uri->string uri)) (uri->string uri))
(warning (G_ "try `--no-substitutes' if the problem persists~%"))) (warning (G_ "try `--no-substitutes' if the problem persists~%")))
(http-fetch uri #:text? #f (call-with-connection-error-handling
#:open-connection open-connection-for-uri/maybe uri
#:keep-alive? #t (lambda ()
#:buffered? #f (http-fetch uri #:text? #f
#:verify-certificate? #f)))) #:open-connection open-connection-for-uri/cached
#:keep-alive? #t
#:buffered? #f
#:verify-certificate? #f))))))
(else (else
(leave (G_ "unsupported substitute URI scheme: ~a~%") (leave (G_ "unsupported substitute URI scheme: ~a~%")
(uri->string uri))))) (uri->string uri)))))