mirror/guix
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/guix.git synced 2025-01-31 06:46:50 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

inferior: Add #:verify-certificate? to ‘cached-channel-instance’.

Browse source 
* guix/inferior.scm (channel-full-commit): Add #:verify-certificate?
and pass it on.
(cached-channel-instance): Likewise.

Change-Id: I9882660ac9eee2c4d9bb5e227979fd8de10555b1
This commit is contained in:
Ludovic Courtès 2024-12-11 00:04:01 +01:00
parent 7d235a6799
commit 370a0c062f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
guix/inferior.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018-2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018-2024 Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -864,7 +864,7 @@ (define %inferior-cache-directory
(make-parameter (string-append (cache-directory #:ensure? #f) (make-parameter (string-append (cache-directory #:ensure? #f)
"/inferiors"))) "/inferiors")))
(define (channel-full-commit channel) (define* (channel-full-commit channel #:key (verify-certificate? #t))
"Return the commit designated by CHANNEL as quickly as possible. If "Return the commit designated by CHANNEL as quickly as possible. If
CHANNEL's 'commit' field is a full SHA1, return it as-is; if it's a SHA1 CHANNEL's 'commit' field is a full SHA1, return it as-is; if it's a SHA1
prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip." prefix, resolve it; and if 'commit' is unset, fetch CHANNEL's branch tip."
@ -876,7 +876,8 @@ (define (channel-full-commit channel)
(cache commit relation (cache commit relation
(update-cached-checkout (channel-url channel) (update-cached-checkout (channel-url channel)
#:ref ref #:ref ref
#:check-out? #f))) #:check-out? #f
#:verify-certificate? verify-certificate?)))
commit)))) commit))))
(define* (cached-channel-instance store (define* (cached-channel-instance store
@ -886,7 +887,8 @@ (define* (cached-channel-instance store
(cache-directory (%inferior-cache-directory)) (cache-directory (%inferior-cache-directory))
(ttl (* 3600 24 30)) (ttl (* 3600 24 30))
(reference-channels '()) (reference-channels '())
(validate-channels (const #t))) (validate-channels (const #t))
(verify-certificate? #t))
"Return a directory containing a guix filetree defined by CHANNELS, a list of channels. "Return a directory containing a guix filetree defined by CHANNELS, a list of channels.
The directory is a subdirectory of CACHE-DIRECTORY, where entries can be The directory is a subdirectory of CACHE-DIRECTORY, where entries can be
reclaimed after TTL seconds. This procedure opens a new connection to the reclaimed after TTL seconds. This procedure opens a new connection to the
@ -895,12 +897,18 @@ (define* (cached-channel-instance store
VALIDATE-CHANNELS must be a four-argument procedure used to validate channel VALIDATE-CHANNELS must be a four-argument procedure used to validate channel
instances against REFERENCE-CHANNELS; it is passed as #:validate-pull to instances against REFERENCE-CHANNELS; it is passed as #:validate-pull to
'latest-channel-instances' and should raise an exception in case a target 'latest-channel-instances' and should raise an exception in case a target
channel commit is deemed \"invalid\"." channel commit is deemed \"invalid\".
When VERIFY-CERTIFICATE? is true, raise an error when encountering an invalid
X.509 host certificate; otherwise, warn about the problem and keep going."
(define commits (define commits
;; Since computing the instances of CHANNELS is I/O-intensive, use a ;; Since computing the instances of CHANNELS is I/O-intensive, use a
;; cheaper way to get the commit list of CHANNELS. This limits overhead ;; cheaper way to get the commit list of CHANNELS. This limits overhead
;; to the minimum in case of a cache hit. ;; to the minimum in case of a cache hit.
(map channel-full-commit channels)) (map (lambda (channel)
(channel-full-commit channel
#:verify-certificate? verify-certificate?))
channels))
(define key (define key
(bytevector->base32-string (bytevector->base32-string
@ -951,7 +959,9 @@ (define add-temp-root*
#:current-channels #:current-channels
reference-channels reference-channels
#:validate-pull #:validate-pull
validate-channels)) validate-channels
#:verify-certificate?
verify-certificate?))
(profile (profile
(channel-instances->derivation instances))) (channel-instances->derivation instances)))
(mbegin %store-monad (mbegin %store-monad