diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-03-26 10:05:54 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-03-26 10:07:57 +0200 |
| commit | 7d85fcde2343e59bd2eb5ba5d08123877a38da6c (patch) | |
| tree | d86b5659a164d3ecb75a3e16d2661398d40235b8 /guix | |
| parent | e784e2561ea54ee9301a8ced005ada9a15e1f93c (diff) | |
guix build: 'guix build --log-file' gracefully reports certificate errors.
Previously 'guix build --log-file' would print a backtrace upon X.509
certificate verification errors.
* guix/scripts/build.scm (log-url): Catch 'tls-certificate-error' in
addition to 'getaddrinfo-error'.
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/scripts/build.scm | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 57f2d82c5c..401087e830 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; ;;; This file is part of GNU Guix. @@ -69,13 +69,21 @@ found. Return #f if no build log was found." (define (valid-url? url) ;; Probe URL and return #t if it is accessible. - (catch 'getaddrinfo-error + (catch #t (lambda () (guard (c ((http-get-error? c) #f)) (close-port (http-fetch url #:buffered? #f)) #t)) - (lambda _ - #f))) + (match-lambda* + (('getaddrinfo-error . _) + #f) + (('tls-certificate-error args ...) + (report-error (G_ "cannot access build log at '~a':~%") url) + (print-exception (current-error-port) #f + 'tls-certificate-error args) + (exit 1)) + ((key . args) + (apply throw key args))))) (define (find-url file) (let ((base (basename file))) |