futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

download: Load X.509 certificates only once.

Browse Source 
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'.
This commit is contained in:
Ludovic Courtès 2022-03-03 22:42:31 +01:00
parent b4acb39b6b
commit c1a871a166
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 23 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
guix/build/download.scm
View File

@ -28,6 +28,7 @@
#:use-module (guix ftp-client) #:use-module (guix ftp-client)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (guix progress) #:use-module (guix progress)
#:use-module (guix memoization)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -177,27 +178,30 @@ name decoding bug described at
(let ((data (call-with-input-file file get-bytevector-all))) (let ((data (call-with-input-file file get-bytevector-all)))
(set-certificate-credentials-x509-trust-data! cred data format))) (set-certificate-credentials-x509-trust-data! cred data format)))
(define (make-credendials-with-ca-trust-files directory) (define make-credendials-with-ca-trust-files
"Return certificate credentials with X.509 authority certificates read from (mlambda (directory)
"Return certificate credentials with X.509 authority certificates read from
DIRECTORY. Those authority certificates are checked when DIRECTORY. Those authority certificates are checked when
'peer-certificate-status' is later called." 'peer-certificate-status' is later called."
(let ((cred (make-certificate-credentials)) ;; Memoize the result to avoid scanning all the certificates every time a
(files (match (scandir directory (cut string-suffix? ".pem" <>)) ;; connection is made.
((or #f ()) (let ((cred (make-certificate-credentials))
;; Some distros provide nothing but bundles (*.crt) under (files (match (scandir directory (cut string-suffix? ".pem" <>))
;; /etc/ssl/certs, so look for them. ((or #f ())
(or (scandir directory (cut string-suffix? ".crt" <>)) ;; Some distros provide nothing but bundles (*.crt) under
'())) ;; /etc/ssl/certs, so look for them.
(pem pem)))) (or (scandir directory (cut string-suffix? ".crt" <>))
(for-each (lambda (file) '()))
(let ((file (string-append directory "/" file))) (pem pem))))
;; Protect against dangling symlinks. (for-each (lambda (file)
(when (file-exists? file) (let ((file (string-append directory "/" file)))
(set-certificate-credentials-x509-trust-file!* ;; Protect against dangling symlinks.
cred file (when (file-exists? file)
x509-certificate-format/pem)))) (set-certificate-credentials-x509-trust-file!*
files) cred file
cred)) x509-certificate-format/pem))))
files)
cred)))
(define (peer-certificate session) (define (peer-certificate session)
"Return the certificate of the remote peer in SESSION." "Return the certificate of the remote peer in SESSION."