GNU bug report logs - #74776
[PATCH 0/7] Adding '--no-check-certificate' to 'pull' and 'time-machine'

Previous Next

Full log

View this message in rfc822 format

From: Ludovic Courtès <ludo <at> gnu.org>
To: 74776 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>, Christopher Baines <guix <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Courtès <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr>
Subject: [bug#74776] [PATCH 3/7] guix download: Honor ‘--no-check-certificate’ for ‘--git’.
Date: Wed, 11 Dec 2024 00:34:42 +0100

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
---
 guix/scripts/download.scm | 34 +++++++++++++++++++---------------
 1 file changed, 19 insertions(+), 15 deletions(-)

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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.