pull: Use /etc/ssl/certs by default if it exists and is non-empty.

Previously, on machines where /etc/ssl/certs did exist, we'd have this:

  $ unset SSL_CERT_DIR
  $ unset SSL_CERT_FILE
  $ guix pull
  Updating channel 'guix' from Git repository at 'https://git.savannah.gnu.org/git/guix.git'...
  guix pull: error: Git error: the SSL certificate is invalid

This is because we'd let OpenSSL look for certificates in its default
location, which is an empty directory in its own prefix.

* guix/scripts/pull.scm (honor-x509-certificates): New procedure.
(guix-pull): Use it instead of calling 'honor-lets-encrypt-certificates!'.
master
Ludovic Courtès 2018-09-18 23:19:18 +02:00
parent 1d2b542d34
commit 20f8d73fac
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 12 additions and 7 deletions

View File

@ -178,6 +178,17 @@ Download and deploy the latest version of Guix.\n"))
(build-derivations store (list drv))
(set-tls-certificate-locations! certs)))
(define (honor-x509-certificates store)
"Use the right X.509 certificates for Git checkouts over HTTPS."
(let ((file (getenv "SSL_CERT_FILE"))
(directory (or (getenv "SSL_CERT_DIR") "/etc/ssl/certs")))
(if (or (and file (file-exists? file))
(and=> (stat directory #f)
(lambda (st)
(> (stat:nlink st) 2))))
(set-tls-certificate-locations! directory file)
(honor-lets-encrypt-certificates! store))))
(define (report-git-error error)
"Report the given Guile-Git error."
;; Prior to Guile-Git commit b6b2760c2fd6dfaa5c0fedb43eeaff06166b3134,
@ -423,13 +434,7 @@ Use '~/.config/guix/channels.scm' instead."))
(parameterize ((%graft? (assoc-ref opts 'graft?))
(%repository-cache-directory cache))
(set-build-options-from-command-line store opts)
;; When certificates are already installed, use them.
;; Otherwise, use the Let's Encrypt certificates, which we
;; know Savannah uses.
(let ((certs (or (getenv "SSL_CERT_DIR") "/etc/ssl/certs")))
(unless (file-exists? certs)
(honor-lets-encrypt-certificates! store)))
(honor-x509-certificates store)
(let ((instances (latest-channel-instances store channels)))
(format (current-error-port)