[bug#74776] [PATCH 5/7] pull: Add ‘--no-check-certificate’.

[Ludovic Courtès]

This can be tested with:

  guix shell libfaketime -- faketime 2019-01-01 \
    guix pull -q --no-check-certificate -p /tmp/p

* guix/scripts/pull.scm (%options, show-help): Add
‘--no-check-certificate’.
(%default-options): Add ‘verify-certificate?’ key.
(guix-pull): Honor it.
* doc/guix.texi (Invoking guix pull): Document it.

Change-Id: Ia9d7af1c64156b112e86027fb637e2e02dae6e3c
---
 doc/guix.texi         |  8 ++++++++
 guix/scripts/pull.scm | 16 +++++++++++++---
 2 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a2915de954..cad16a0660 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4635,6 +4635,14 @@ Invoking guix pull
 @option{--disable-authentication}.
 @end quotation
 
+@item --no-check-certificate
+Do not validate the X.509 certificates of HTTPS servers.
+
+When using this option, you have @emph{absolutely no guarantee} that you
+are communicating with the authentic server responsible for the given
+URL.  Unless the channel is authenticated, this makes you vulnerable to
+``man-in-the-middle'' attacks.
+
 @item --system=@var{system}
 @itemx -s @var{system}
 Attempt to build for @var{system}---e.g., @code{i686-linux}---instead of
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 58d3cd7e83..76aed0b5cc 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2015, 2017-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2015, 2017-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2020, 2021 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
@@ -77,6 +77,7 @@ (define %default-options
     (debug . 0)
     (verbosity . 1)
     (authenticate-channels? . #t)
+    (verify-certificate? . #t)
     (validate-pull . ,ensure-forward-channel-update)))
 
 (define (show-help)
@@ -98,6 +99,9 @@ (define (show-help)
   (display (G_ "
       --disable-authentication
                          disable channel authentication"))
+  (display (G_ "
+      --no-check-certificate
+                         do not validate the certificate of HTTPS servers"))
   (display (G_ "
   -N, --news             display news compared to the previous generation"))
   (display (G_ "
@@ -183,6 +187,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 '(#\p "profile") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'profile (canonicalize-profile arg)
@@ -845,7 +852,8 @@ (define-command (guix-pull . args)
             (profile      (or (assoc-ref opts 'profile) %current-profile))
             (current-channels (profile-channels profile))
             (validate-pull    (assoc-ref opts 'validate-pull))
-            (authenticate?    (assoc-ref opts 'authenticate-channels?)))
+            (authenticate?    (assoc-ref opts 'authenticate-channels?))
+            (verify-certificate? (assoc-ref opts 'verify-certificate?)))
        (cond
         ((assoc-ref opts 'query)
          (process-query opts profile))
@@ -877,7 +885,9 @@ (define-command (guix-pull . args)
                                                    #:validate-pull
                                                    validate-pull
                                                    #:authenticate?
-                                                   authenticate?)))
+                                                   authenticate?
+                                                   #:verify-certificate?
+                                                   verify-certificate?)))
                    (format (current-error-port)
                            (N_ "Building from this channel:~%"
                                "Building from these channels:~%"
-- 
2.46.0