diff options
Diffstat (limited to 'guix/scripts/substitute-binary.scm')
| -rwxr-xr-x | guix/scripts/substitute-binary.scm | 32 |
1 files changed, 24 insertions, 8 deletions
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 1afc93bbc9..83e3d25dba 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -123,7 +123,8 @@ again." (lambda () body ...) (lambda args - ;; The SIGALRM triggers EINTR, because of the bug at + ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR + ;; because of the bug at ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>. ;; When that happens, try again. Note: SA_RESTART cannot be ;; used because of <http://bugs.gnu.org/14640>. @@ -162,10 +163,17 @@ provide." (warning (_ "while fetching ~a: server is unresponsive~%") (uri->string uri)) (warning (_ "try `--no-substitutes' if the problem persists~%")) - (when port - (close-port port))) + + ;; Before Guile v2.0.9-39-gfe51c7b, EINTR was reported to the user, + ;; and thus PORT had to be closed and re-opened. This is not the + ;; case afterward. + (unless (or (guile-version>? "2.0.9") + (version>? (version) "2.0.9.39")) + (when port + (close-port port)))) (begin - (set! port (open-socket-for-uri uri #:buffered? buffered?)) + (when (or (not port) (port-closed? port)) + (set! port (open-socket-for-uri uri #:buffered? buffered?))) (http-fetch uri #:text? #f #:port port))))))) (define-record-type <cache> @@ -290,6 +298,12 @@ reading PORT." (time>? (subtract-duration now (make-time time-duration 0 ttl)) (make-time time-monotonic 0 date))) +(define %lookup-threads + ;; Number of threads spawned to perform lookup operations. This means we + ;; can have this many simultaneous HTTP GET requests to the server, which + ;; limits the impact of connection latency. + 20) + (define (lookup-narinfo cache path) "Check locally if we have valid info about PATH, otherwise go to CACHE and check what it has." @@ -489,8 +503,9 @@ Internal tool to substitute a pre-built binary to a local build.\n")) ;; Return the subset of PATHS available in CACHE. (let ((substitutable (if cache - (par-map (cut lookup-narinfo cache <>) - paths) + (n-par-map %lookup-threads + (cut lookup-narinfo cache <>) + paths) '()))) (for-each (lambda (narinfo) (when narinfo @@ -501,8 +516,9 @@ Internal tool to substitute a pre-built binary to a local build.\n")) ;; Reply info about PATHS if it's in CACHE. (let ((substitutable (if cache - (par-map (cut lookup-narinfo cache <>) - paths) + (n-par-map %lookup-threads + (cut lookup-narinfo cache <>) + paths) '()))) (for-each (lambda (narinfo) (format #t "~a\n~a\n~a\n" |