amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix download: Honor ‘--no-check-certificate’ for ‘--git’.

Browse source 
Until now ‘--no-check-certificate’ had no effect when combined with
‘--git’.  This can be tested with:

  guix shell libfaketime -- faketime 2019-01-01 \
    guix download --no-check-certificate --git \
    https://git.savannah.gnu.org/git/shepherd.git

* guix/scripts/download.scm (git-download-to-file): Add #:verify-certificate?
and honor it.
(git-download-to-store*): Likewise.
(add-git-download-option): Likewise.
(%options): Likewise.

Change-Id: Ib3905398199d814a02319ed3328eb8a4ed219bd5
This commit is contained in:
Ludovic Courtès 2024-12-10 23:43:31 +01:00
parent 9544a04411
commit fc438ef675
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 19 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

30
guix/scripts/download.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012-2013, 2015-2017, 2020, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -94,7 +94,8 @@
#t #t
source)) source))
(define (git-download-to-file url file reference recursive?) (define* (git-download-to-file url file reference recursive?
#:key (verify-certificate? #t))
"Download the git repo at URL to file, checked out at REFERENCE. "Download the git repo at URL to file, checked out at REFERENCE.
REFERENCE must be a pair argument as understood by 'latest-repository-commit'. REFERENCE must be a pair argument as understood by 'latest-repository-commit'.
Return FILE." Return FILE."
@ -108,7 +109,8 @@ Return FILE."
(else url)))) (else url))))
(copy-recursively-without-dot-git (copy-recursively-without-dot-git
(with-git-error-handling (with-git-error-handling
(update-cached-checkout url #:ref reference #:recursive? recursive?)) (update-cached-checkout url #:ref reference #:recursive? recursive?
#:verify-certificate? verify-certificate?))
file)) file))
file) file)
@ -151,12 +153,13 @@ pair argument as understood by 'latest-repository-commit'."
(string-drop url (string-length "file:"))) (string-drop url (string-length "file:")))
url))) url)))
(with-store store (with-store store
;; TODO: Verify certificate support and deactivation.
(with-git-error-handling (with-git-error-handling
(latest-repository-commit store (latest-repository-commit store
url url
#:recursive? recursive? #:recursive? recursive?
#:ref reference))))) #:ref reference
#:verify-certificate?
verify-certificate?)))))
(define %default-options (define %default-options
;; Alist of default option values. ;; Alist of default option values.
@ -207,9 +210,10 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(define (add-git-download-option result) (define (add-git-download-option result)
(alist-cons 'download-proc (alist-cons 'download-proc
;; XXX: #:verify-certificate? currently ignored.
(lambda* (url #:key verify-certificate? ref recursive?) (lambda* (url #:key verify-certificate? ref recursive?)
(git-download-to-store* url ref recursive?)) (git-download-to-store* url ref recursive?
#:verify-certificate?
verify-certificate?))
(alist-delete 'download result))) (alist-delete 'download result)))
(define %options (define %options
@ -243,20 +247,20 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(alist-cons 'verify-certificate? #f result))) (alist-cons 'verify-certificate? #f result)))
(option '(#\o "output") #t #f (option '(#\o "output") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(let* ((git (let* ((git (assoc-ref result 'git-reference)))
(assoc-ref result 'git-reference)))
(if git (if git
(alist-cons 'download-proc (alist-cons 'download-proc
(lambda* (url (lambda* (url #:key
#:key (verify-certificate? #t)
verify-certificate?
ref ref
recursive?) recursive?)
(git-download-to-file (git-download-to-file
url url
arg arg
(assoc-ref result 'git-reference) (assoc-ref result 'git-reference)
recursive?)) recursive?
#:verify-certificate?
verify-certificate?))
(alist-delete 'download result)) (alist-delete 'download result))
(alist-cons 'download-proc (alist-cons 'download-proc
(lambda* (url (lambda* (url