diff options
| -rw-r--r-- | guix/scripts/download.scm | 47 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 4 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 6 | ||||
| -rw-r--r-- | guix/store.scm | 18 | ||||
| -rw-r--r-- | guix/ui.scm | 4 |
5 files changed, 50 insertions, 29 deletions
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 3dc227fdcd..3f989a3494 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -110,26 +110,27 @@ and the hash of its contents.\n")) (alist-cons 'argument arg result)) %default-options)) - (let* ((opts (parse-options)) - (store (open-connection)) - (arg (assq-ref opts 'argument)) - (uri (or (string->uri arg) - (leave (_ "guix-download: ~a: failed to parse URI~%") - arg))) - (path (case (uri-scheme uri) - ((file) - (add-to-store store (basename (uri-path uri)) - #f "sha256" (uri-path uri))) - (else - (fetch-and-store store - (cut url-fetch arg <> - #:mirrors %mirrors) - (basename (uri-path uri)))))) - (hash (call-with-input-file - (or path - (leave (_ "guix-download: ~a: download failed~%") - arg)) - (compose sha256 get-bytevector-all))) - (fmt (assq-ref opts 'format))) - (format #t "~a~%~a~%" path (fmt hash)) - #t)) + (with-error-handling + (let* ((opts (parse-options)) + (store (open-connection)) + (arg (assq-ref opts 'argument)) + (uri (or (string->uri arg) + (leave (_ "guix-download: ~a: failed to parse URI~%") + arg))) + (path (case (uri-scheme uri) + ((file) + (add-to-store store (basename (uri-path uri)) + #f "sha256" (uri-path uri))) + (else + (fetch-and-store store + (cut url-fetch arg <> + #:mirrors %mirrors) + (basename (uri-path uri)))))) + (hash (call-with-input-file + (or path + (leave (_ "guix-download: ~a: download failed~%") + arg)) + (compose sha256 get-bytevector-all))) + (fmt (assq-ref opts 'format))) + (format #t "~a~%~a~%" path (fmt hash)) + #t))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index dd7d6ca112..a9ed79184e 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -712,8 +712,8 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n")) (let ((opts (parse-options))) (or (process-query opts) - (parameterize ((%store (open-connection))) - (with-error-handling + (with-error-handling + (parameterize ((%store (open-connection))) (parameterize ((%guile-for-build (package-derivation (%store) (if (assoc-ref opts 'bootstrap?) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 942bf501c5..bc72dc4088 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -194,9 +194,9 @@ Download and deploy the latest version of Guix.\n")) (leave (_ "~A: unexpected argument~%") arg)) %default-options)) - (let ((opts (parse-options)) - (store (open-connection))) - (with-error-handling + (with-error-handling + (let ((opts (parse-options)) + (store (open-connection))) (let ((tarball (download-and-store store))) (unless tarball (leave (_ "failed to download up-to-date source, exiting\n"))) diff --git a/guix/store.scm b/guix/store.scm index 80b36daf93..eaf1cd544f 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -39,6 +39,9 @@ nix-server-socket &nix-error nix-error? + &nix-connection-error nix-connection-error? + nix-connection-error-file + nix-connection-error-code &nix-protocol-error nix-protocol-error? nix-protocol-error-message nix-protocol-error-status @@ -373,6 +376,11 @@ (define-condition-type &nix-error &error nix-error?) +(define-condition-type &nix-connection-error &nix-error + nix-connection-error? + (file nix-connection-error-file) + (errno nix-connection-error-code)) + (define-condition-type &nix-protocol-error &nix-error nix-protocol-error? (message nix-protocol-error-message) @@ -392,7 +400,15 @@ operate, should the disk become full. Return a server object." ;; Enlarge the receive buffer. (setsockopt s SOL_SOCKET SO_RCVBUF (* 12 1024)) - (connect s a) + (catch 'system-error + (cut connect s a) + (lambda args + ;; Translate the error to something user-friendly. + (let ((errno (system-error-errno args))) + (raise (condition (&nix-connection-error + (file file) + (errno errno))))))) + (write-int %worker-magic-1 s) (let ((r (read-int s))) (and (eqv? r %worker-magic-2) diff --git a/guix/ui.scm b/guix/ui.scm index 03d881a428..94f0825a0a 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -111,6 +111,10 @@ General help using GNU software: <http://www.gnu.org/gethelp/>")) (leave (_ "~a:~a:~a: error: package `~a' has an invalid input: ~s~%") file line column (package-full-name package) input))) + ((nix-connection-error? c) + (leave (_ "error: failed to connect to `~a': ~a~%") + (nix-connection-error-file c) + (strerror (nix-connection-error-code c)))) ((nix-protocol-error? c) ;; FIXME: Server-provided error messages aren't i18n'd. (leave (_ "error: build failed: ~a~%") |