From 64b8695cd8bbdca44dde226bde698489d68a44be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 7 Nov 2016 23:29:45 +0100
Subject: [PATCH] guix download: Add '--no-check-certificate' option.

* guix/download.scm (download-to-store): Add #:verify-certificate?
parameter and honor it.
* guix/scripts/download.scm (%default-options): Add
'verify-certificate?' key.
(show-help, %options): Add '--no-check-certificate'.
(guix-download): Pass #:verify-certificate to 'download-to-store'.
* doc/guix.texi (Invoking guix download): Document it.
---
 doc/guix.texi             | 12 ++++++++++--
 guix/download.scm         | 11 ++++++++---
 guix/scripts/download.scm | 14 ++++++++++++--
 3 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 349c4816a1..d99f409061 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4771,15 +4771,23 @@ GnuTLS-Guile}, for more information.
 @command{guix download} verifies HTTPS server certificates by loading
 the certificates of X.509 authorities from the directory pointed to by
 the @code{SSL_CERT_DIR} environment variable (@pxref{X.509
-Certificates}).
+Certificates}), unless @option{--no-check-certificate} is used.
 
-The following option is available:
+The following options are available:
 
 @table @code
 @item --format=@var{fmt}
 @itemx -f @var{fmt}
 Write the hash in the format specified by @var{fmt}.  For more
 information on the valid values for @var{fmt}, @pxref{Invoking guix hash}.
+
+@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, which makes you vulnerable to ``man-in-the-middle'' attacks.
+
 @end table
 
 @node Invoking guix hash
diff --git a/guix/download.scm b/guix/download.scm
index d94051951c..0c275053c5 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -434,10 +434,12 @@ own.  This helper makes it easier to deal with \"tar bombs\"."
                       #:local-build? #t)))
 
 (define* (download-to-store store url #:optional (name (basename url))
-                            #:key (log (current-error-port)) recursive?)
+                            #:key (log (current-error-port)) recursive?
+                            (verify-certificate? #t))
   "Download from URL to STORE, either under NAME or URL's basename if
 omitted.  Write progress reports to LOG.  RECURSIVE? has the same effect as
-the same-named parameter of 'add-to-store'."
+the same-named parameter of 'add-to-store'.  VERIFY-CERTIFICATE? determines
+whether or not to validate HTTPS server certificates."
   (define uri
     (string->uri url))
 
@@ -448,7 +450,10 @@ the same-named parameter of 'add-to-store'."
        (lambda (temp port)
          (let ((result
                 (parameterize ((current-output-port log))
-                  (build:url-fetch url temp #:mirrors %mirrors))))
+                  (build:url-fetch url temp
+                                   #:mirrors %mirrors
+                                   #:verify-certificate?
+                                   verify-certificate?))))
            (close port)
            (and result
                 (add-to-store store name recursive? "sha256" temp)))))))
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index bcb4eaa043..ec30b05ac0 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
@@ -41,7 +41,8 @@
 
 (define %default-options
   ;; Alist of default option values.
-  `((format . ,bytevector->nix-base32-string)))
+  `((format . ,bytevector->nix-base32-string)
+    (verify-certificate? . #t)))
 
 (define (show-help)
   (display (_ "Usage: guix download [OPTION] URL
@@ -52,6 +53,9 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
 ('hex' and 'hexadecimal' can be used as well).\n"))
   (format #t (_ "
   -f, --format=FMT       write the hash in the given format"))
+  (format #t (_ "
+      --no-check-certificate
+                         do not validate the certificate of HTTPS servers "))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -77,6 +81,9 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
 
                   (alist-cons 'format fmt-proc
                               (alist-delete 'format 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
@@ -120,7 +127,10 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
                      (parameterize ((current-terminal-columns
                                      (terminal-columns)))
                        (download-to-store store (uri->string uri)
-                                          (basename (uri-path uri)))))))
+                                          (basename (uri-path uri))
+                                          #:verify-certificate?
+                                          (assoc-ref opts
+                                                     'verify-certificate?))))))
            (hash  (call-with-input-file
                       (or path
                           (leave (_ "~a: download failed~%")