06/06: pull: Try harder to use the host's X.509 certificates.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 88268a34bc76c88c5c5e4ecc244924f3c8503d16
Author: Ludovic Courtès <address@hidden>
Date:   Tue Sep 25 18:44:38 2018 +0200

    pull: Try harder to use the host's X.509 certificates.
    
    * guix/scripts/pull.scm (honor-x509-certificates): Use commonly-found
    certificate bundles.
---
 guix/scripts/pull.scm | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 10e1a99..39aebb1 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -180,9 +180,25 @@ Download and deploy the latest version of Guix.\n"))
 
 (define (honor-x509-certificates store)
   "Use the right X.509 certificates for Git checkouts over HTTPS."
-  (let ((file      (getenv "SSL_CERT_FILE"))
+  ;; On distros such as CentOS 7, /etc/ssl/certs contains only a couple of
+  ;; files (instead of all the certificates) among which "ca-bundle.crt".  On
+  ;; other distros /etc/ssl/certs usually contains the whole set of
+  ;; certificates along with "ca-certificates.crt".  Try to choose the right
+  ;; one.
+  (let ((file      (letrec-syntax ((choose
+                                    (syntax-rules ()
+                                      ((_ file rest ...)
+                                       (let ((f file))
+                                         (if (and f (file-exists? f))
+                                             f
+                                             (choose rest ...))))
+                                      ((_)
+                                       #f))))
+                     (choose (getenv "SSL_CERT_FILE")
+                             "/etc/ssl/certs/ca-certificates.crt"
+                             "/etc/ssl/certs/ca-bundle.crt")))
         (directory (or (getenv "SSL_CERT_DIR") "/etc/ssl/certs")))
-    (if (or (and file (file-exists? file))
+    (if (or file
             (and=> (stat directory #f)
                    (lambda (st)
                      (> (stat:nlink st) 2))))