From c1a871a1662fefb498a4d32e9a47579ac9813926 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 3 Mar 2022 22:42:31 +0100
Subject: 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'.
---
 guix/build/download.scm | 42 +++++++++++++++++++++++-------------------
 1 file 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."
-- 
cgit v1.2.3