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'.

1 files changed, 86 insertions, 72 deletions

diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 1317a72fb1..088a41a15c 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -361,6 +361,19 @@ indefinitely."
   (or (getenv "GUIX_BINARY_SUBSTITUTE_URL")
       "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.
@@ -370,77 +383,78 @@ indefinitely."
   "Implement the build daemon's substituter protocol."
   (mkdir-p %narinfo-cache-directory)
   (maybe-remove-expired-cached-narinfo)
-  (match args
-    (("--query")
-     (let ((cache (delay (open-cache %cache-url))))
-       (let loop ((command (read-line)))
-         (or (eof-object? command)
-             (begin
-               (match (string-tokenize command)
-                 (("have" paths ..1)
-                  ;; Return the subset of PATHS available in CACHE.
-                  (let ((substitutable
-                         (if cache
-                             (par-map (cut lookup-narinfo cache <>)
-                                      paths)
-                             '())))
-                    (for-each (lambda (narinfo)
-                                (when narinfo
-                                  (format #t "~a~%" (narinfo-path narinfo))))
-                              (filter narinfo? substitutable))
-                    (newline)))
-                 (("info" paths ..1)
-                  ;; Reply info about PATHS if it's in CACHE.
-                  (let ((substitutable
-                         (if cache
-                             (par-map (cut lookup-narinfo cache <>)
-                                      paths)
-                             '())))
-                    (for-each (lambda (narinfo)
-                                (format #t "~a\n~a\n~a\n"
-                                        (narinfo-path narinfo)
-                                        (or (and=> (narinfo-deriver narinfo)
-                                                   (cute string-append
-                                                         (%store-prefix) "/"
-                                                         <>))
-                                            "")
-                                        (length (narinfo-references narinfo)))
-                                (for-each (cute format #t "~a/~a~%"
-                                                (%store-prefix) <>)
-                                          (narinfo-references narinfo))
-                                (format #t "~a\n~a\n"
-                                        (or (narinfo-file-size narinfo) 0)
-                                        (or (narinfo-size narinfo) 0)))
-                              (filter narinfo? substitutable))
-                    (newline)))
-                 (wtf
-                  (error "unknown `--query' command" wtf)))
-               (loop (read-line)))))))
-    (("--substitute" store-path destination)
-     ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
-     (let* ((cache   (delay (open-cache %cache-url)))
-            (narinfo (lookup-narinfo cache store-path))
-            (uri     (narinfo-uri narinfo)))
-       ;; Tell the daemon what the expected hash of the Nar itself is.
-       (format #t "~a~%" (narinfo-hash narinfo))
-
-       (let*-values (((raw download-size)
-                      (fetch uri #:buffered? #f))
-                     ((input pids)
-                      (decompressed-port (narinfo-compression narinfo)
-                                         raw)))
-         ;; Note that Hydra currently generates Nars on the fly and doesn't
-         ;; specify a Content-Length, so DOWNLOAD-SIZE is #f in practice.
-         (format (current-error-port)
-                 (_ "downloading `~a' from `~a'~:[~*~; (~,1f KiB)~]...~%")
-                 store-path (uri->string uri)
-                 download-size
-                 (and=> download-size (cut / <> 1024.0)))
-
-         ;; Unpack the Nar at INPUT into DESTINATION.
-         (restore-file input destination)
-         (every (compose zero? cdr waitpid) pids))))
-    (("--version")
-     (show-version-and-exit "guix substitute-binary"))))
+  (with-networking
+   (match args
+     (("--query")
+      (let ((cache (delay (open-cache %cache-url))))
+        (let loop ((command (read-line)))
+          (or (eof-object? command)
+              (begin
+                (match (string-tokenize command)
+                  (("have" paths ..1)
+                   ;; Return the subset of PATHS available in CACHE.
+                   (let ((substitutable
+                          (if cache
+                              (par-map (cut lookup-narinfo cache <>)
+                                       paths)
+                              '())))
+                     (for-each (lambda (narinfo)
+                                 (when narinfo
+                                   (format #t "~a~%" (narinfo-path narinfo))))
+                               (filter narinfo? substitutable))
+                     (newline)))
+                  (("info" paths ..1)
+                   ;; Reply info about PATHS if it's in CACHE.
+                   (let ((substitutable
+                          (if cache
+                              (par-map (cut lookup-narinfo cache <>)
+                                       paths)
+                              '())))
+                     (for-each (lambda (narinfo)
+                                 (format #t "~a\n~a\n~a\n"
+                                         (narinfo-path narinfo)
+                                         (or (and=> (narinfo-deriver narinfo)
+                                                    (cute string-append
+                                                          (%store-prefix) "/"
+                                                          <>))
+                                             "")
+                                         (length (narinfo-references narinfo)))
+                                 (for-each (cute format #t "~a/~a~%"
+                                                 (%store-prefix) <>)
+                                           (narinfo-references narinfo))
+                                 (format #t "~a\n~a\n"
+                                         (or (narinfo-file-size narinfo) 0)
+                                         (or (narinfo-size narinfo) 0)))
+                               (filter narinfo? substitutable))
+                     (newline)))
+                  (wtf
+                   (error "unknown `--query' command" wtf)))
+                (loop (read-line)))))))
+     (("--substitute" store-path destination)
+      ;; Download STORE-PATH and add store it as a Nar in file DESTINATION.
+      (let* ((cache   (delay (open-cache %cache-url)))
+             (narinfo (lookup-narinfo cache store-path))
+             (uri     (narinfo-uri narinfo)))
+        ;; Tell the daemon what the expected hash of the Nar itself is.
+        (format #t "~a~%" (narinfo-hash narinfo))
+
+        (let*-values (((raw download-size)
+                       (fetch uri #:buffered? #f))
+                      ((input pids)
+                       (decompressed-port (narinfo-compression narinfo)
+                                          raw)))
+          ;; Note that Hydra currently generates Nars on the fly and doesn't
+          ;; specify a Content-Length, so DOWNLOAD-SIZE is #f in practice.
+          (format (current-error-port)
+                  (_ "downloading `~a' from `~a'~:[~*~; (~,1f KiB)~]...~%")
+                  store-path (uri->string uri)
+                  download-size
+                  (and=> download-size (cut / <> 1024.0)))
+
+          ;; Unpack the Nar at INPUT into DESTINATION.
+          (restore-file input destination)
+          (every (compose zero? cdr waitpid) pids))))
+     (("--version")
+      (show-version-and-exit "guix substitute-binary")))))
 
 ;;; substitute-binary.scm ends here