Subject: [bug#74776] [PATCH 7/7] time-machine: Add ‘--no-check-certificate’.

From: Ludovic Courtès <[email-masked]>
Date: Wed, 11 Dec 2024 00:34:46 +0100

This can be tested with:

  guix shell libfaketime -- faketime 2019-01-01 \
    guix time-machine -q --no-check-certificate

* guix/scripts/time-machine.scm (%options, show-help): Add
‘--no-check-certificate’.
(%default-options): Add ‘verify-certificate?’ key.
(guix-time-machine): Honor it.

Change-Id: I25a29d03d4df78d1618c6a416ec85fd8e90fec6c
---
 guix/scripts/time-machine.scm | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/time-machine.scm b/guix/scripts/time-machine.scm
index 21145239d4..0fd2d15eb5 100644
--- a/guix/scripts/time-machine.scm
+++ b/guix/scripts/time-machine.scm
@@ -70,6 +70,9 @@ (define (show-help)
   (display (G_ "
       --disable-authentication
                          disable channel authentication"))
+  (display (G_ "
+      --no-check-certificate
+                         do not validate the certificate of HTTPS servers"))
   (newline)
   (show-build-options-help)
   (newline)
@@ -101,6 +104,9 @@ (define %options
          (option '("disable-authentication") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'authenticate-channels? #f result)))
+         (option '("no-check-certificate") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'verify-certificate? #f result)))
          (option '(#\h "help") #f #f
                  (lambda args
                    (leave-on-EPIPE (show-help))
@@ -120,6 +126,7 @@ (define %default-options
     (print-extended-build-trace? . #t)
     (multiplexed-build-output? . #t)
     (authenticate-channels? . #t)
+    (verify-certificate? . #t)
     (graft? . #t)
     (debug . 0)
     (verbosity . 1)))
@@ -180,7 +187,8 @@ (define-command (guix-time-machine . args)
             (command-line (assoc-ref opts 'exec))
             (ref          (assoc-ref opts 'ref))
             (substitutes?  (assoc-ref opts 'substitutes?))
-            (authenticate? (assoc-ref opts 'authenticate-channels?)))
+            (authenticate? (assoc-ref opts 'authenticate-channels?))
+            (verify-certificate? (assoc-ref opts 'verify-certificate?)))
        (let* ((directory
                (with-store store
                  (with-status-verbosity (assoc-ref opts 'verbosity)
@@ -195,7 +203,9 @@ (define-command (guix-time-machine . args)
                                               #:reference-channels
                                               %reference-channels
                                               #:validate-channels
-                                              validate-guix-channel)))))
+                                              validate-guix-channel
+                                              #:verify-certificate?
+                                              verify-certificate?)))))
               (executable (string-append directory "/bin/guix")))
          (if command-line
              (apply execl (cons* executable executable command-line))
-- 
2.46.0