aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/git.scm38
-rw-r--r--guix/scripts/pull.scm26
2 files changed, 40 insertions, 24 deletions
diff --git a/guix/git.scm b/guix/git.scm
index 51b8aa9ae5..0e3ce37e26 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -35,6 +35,8 @@
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (%repository-cache-directory
+ honor-system-x509-certificates!
+
update-cached-checkout
latest-repository-commit
@@ -52,12 +54,48 @@
(make-parameter (string-append (cache-directory #:ensure? #f)
"/checkouts")))
+(define (honor-system-x509-certificates!)
+ "Use the system's X.509 certificates for Git checkouts over HTTPS. Honor
+the 'SSL_CERT_FILE' and 'SSL_CERT_DIR' environment variables."
+ ;; 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")))
+ (and (or file
+ (and=> (stat directory #f)
+ (lambda (st)
+ (> (stat:nlink st) 2))))
+ (begin
+ (set-tls-certificate-locations! directory file)
+ #t))))
+
+(define %certificates-initialized?
+ ;; Whether 'honor-system-x509-certificates!' has already been called.
+ #f)
+
(define-syntax-rule (with-libgit2 thunk ...)
(begin
;; XXX: The right thing to do would be to call (libgit2-shutdown) here,
;; but pointer finalizers used in guile-git may be called after shutdown,
;; resulting in a segfault. Hence, let's skip shutdown call for now.
(libgit2-init!)
+ (unless %certificates-initialized?
+ (honor-system-x509-certificates!)
+ (set! %certificates-initialized? #t))
thunk ...))
(define* (url-cache-directory url
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 683ab3f059..3320200c07 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -216,30 +216,8 @@ true, display what would be built without actually building it."
(define (honor-x509-certificates store)
"Use the right X.509 certificates for Git checkouts over HTTPS."
- ;; 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 file
- (and=> (stat directory #f)
- (lambda (st)
- (> (stat:nlink st) 2))))
- (set-tls-certificate-locations! directory file)
- (honor-lets-encrypt-certificates! store))))
+ (unless (honor-system-x509-certificates!)
+ (honor-lets-encrypt-certificates! store)))
(define (report-git-error error)
"Report the given Guile-Git error."