summaryrefslogtreecommitdiff
path: root/guix/build/download.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-03-03 22:42:31 +0100
committerLudovic Courtès <ludo@gnu.org>2022-03-03 23:57:00 +0100
commitc1a871a1662fefb498a4d32e9a47579ac9813926 (patch)
tree47c1a324409f7c20f824ebd19798f9d1a5a2b977 /guix/build/download.scm
parentb4acb39b6b6257b25ee205d14b17580c9ad1bb5e (diff)
download: Load X.509 certificates only once.
Previously we'd load /etc/ssl/certs/*.pem (or similar) every time 'http-fetch' is called. * guix/build/download.scm (make-credendials-with-ca-trust-files): Wrap in 'mlambda'.
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r--guix/build/download.scm42
1 files changed, 23 insertions, 19 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index c938151113..911f551b57 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -28,6 +28,7 @@
#:use-module (guix ftp-client)
#:use-module (guix build utils)
#:use-module (guix progress)
+ #:use-module (guix memoization)
#:use-module (rnrs io ports)
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
@@ -177,27 +178,30 @@ name decoding bug described at
(let ((data (call-with-input-file file get-bytevector-all)))
(set-certificate-credentials-x509-trust-data! cred data format)))
-(define (make-credendials-with-ca-trust-files directory)
- "Return certificate credentials with X.509 authority certificates read from
+(define make-credendials-with-ca-trust-files
+ (mlambda (directory)
+ "Return certificate credentials with X.509 authority certificates read from
DIRECTORY. Those authority certificates are checked when
'peer-certificate-status' is later called."
- (let ((cred (make-certificate-credentials))
- (files (match (scandir directory (cut string-suffix? ".pem" <>))
- ((or #f ())
- ;; Some distros provide nothing but bundles (*.crt) under
- ;; /etc/ssl/certs, so look for them.
- (or (scandir directory (cut string-suffix? ".crt" <>))
- '()))
- (pem pem))))
- (for-each (lambda (file)
- (let ((file (string-append directory "/" file)))
- ;; Protect against dangling symlinks.
- (when (file-exists? file)
- (set-certificate-credentials-x509-trust-file!*
- cred file
- x509-certificate-format/pem))))
- files)
- cred))
+ ;; Memoize the result to avoid scanning all the certificates every time a
+ ;; connection is made.
+ (let ((cred (make-certificate-credentials))
+ (files (match (scandir directory (cut string-suffix? ".pem" <>))
+ ((or #f ())
+ ;; Some distros provide nothing but bundles (*.crt) under
+ ;; /etc/ssl/certs, so look for them.
+ (or (scandir directory (cut string-suffix? ".crt" <>))
+ '()))
+ (pem pem))))
+ (for-each (lambda (file)
+ (let ((file (string-append directory "/" file)))
+ ;; Protect against dangling symlinks.
+ (when (file-exists? file)
+ (set-certificate-credentials-x509-trust-file!*
+ cred file
+ x509-certificate-format/pem))))
+ files)
+ cred)))
(define (peer-certificate session)
"Return the certificate of the remote peer in SESSION."