mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 14:16:55 -05:00
substitute-binary: Gracefully exit upon networking errors.
Suggested by Andreas Enge <andreas@enge.fr>. * guix/scripts/substitute-binary.scm (with-networking): New macro. (guix-substitute-binary): Wrap the body in `with-networking'.
This commit is contained in:
parent
56b1f4b780
commit
cf5d2ca329
1 changed files with 84 additions and 70 deletions
|
@ -361,6 +361,19 @@ (define %cache-url
|
||||||
(or (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
(or (getenv "GUIX_BINARY_SUBSTITUTE_URL")
|
||||||
"http://hydra.gnu.org"))
|
"http://hydra.gnu.org"))
|
||||||
|
|
||||||
|
(define-syntax with-networking
|
||||||
|
(syntax-rules ()
|
||||||
|
"Catch DNS lookup errors and gracefully exit."
|
||||||
|
;; Note: no attempt is made to catch other networking errors, because DNS
|
||||||
|
;; lookup errors are typically the first one, and because other errors are
|
||||||
|
;; a subset of `system-error', which is harder to filter.
|
||||||
|
((_ exp ...)
|
||||||
|
(catch 'getaddrinfo-error
|
||||||
|
(lambda () exp ...)
|
||||||
|
(lambda (key error)
|
||||||
|
(leave (_ "host name lookup error: ~a~%")
|
||||||
|
(gai-strerror error)))))))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Entry point.
|
;;; Entry point.
|
||||||
|
@ -370,6 +383,7 @@ (define (guix-substitute-binary . args)
|
||||||
"Implement the build daemon's substituter protocol."
|
"Implement the build daemon's substituter protocol."
|
||||||
(mkdir-p %narinfo-cache-directory)
|
(mkdir-p %narinfo-cache-directory)
|
||||||
(maybe-remove-expired-cached-narinfo)
|
(maybe-remove-expired-cached-narinfo)
|
||||||
|
(with-networking
|
||||||
(match args
|
(match args
|
||||||
(("--query")
|
(("--query")
|
||||||
(let ((cache (delay (open-cache %cache-url))))
|
(let ((cache (delay (open-cache %cache-url))))
|
||||||
|
@ -441,6 +455,6 @@ (define (guix-substitute-binary . args)
|
||||||
(restore-file input destination)
|
(restore-file input destination)
|
||||||
(every (compose zero? cdr waitpid) pids))))
|
(every (compose zero? cdr waitpid) pids))))
|
||||||
(("--version")
|
(("--version")
|
||||||
(show-version-and-exit "guix substitute-binary"))))
|
(show-version-and-exit "guix substitute-binary")))))
|
||||||
|
|
||||||
;;; substitute-binary.scm ends here
|
;;; substitute-binary.scm ends here
|
||||||
|
|
Loading…
Reference in a new issue