guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

05/05: guix build: 'guix build --log-file' gracefully reports certificat


From: Ludovic Courtès
Subject: 05/05: guix build: 'guix build --log-file' gracefully reports certificate errors.
Date: Mon, 26 Mar 2018 04:08:40 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit 7d85fcde2343e59bd2eb5ba5d08123877a38da6c
Author: Ludovic Courtès <address@hidden>
Date:   Mon Mar 26 10:05:54 2018 +0200

    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'.
---
 guix/scripts/build.scm | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 57f2d82..401087e 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 
<address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès 
<address@hidden>
 ;;; Copyright © 2013 Mark H Weaver <address@hidden>
 ;;;
 ;;; 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)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]