Subject: bug#25975: Use HTTPS in `guix pull`

From: Marius Bakke <[email-masked]>
Date: Sat, 11 Mar 2017 19:40:38 +0100

Leo Famulari <[email-masked]> writes:

> On Sat, Mar 11, 2017 at 11:26:12AM +0100, Ludovic Courtès wrote:
>> > +           (map (lambda (cert)
>> > +                  (copy-file cert (string-append out "/"
>> > +                                                 (strip-store-file-name cert))))
>> > +                (list root intermediate backup))))))
>> 
>> ‘for-each’ instead of ‘map’, to make it clear that it’s for side
>> effects.
>
> Done!
>
>> > +    (license license:public-domain))) ; XXX what license?
>> 
>> It’s not copyrightable so yeah, this is a good approximation.
>
> Okay!
>
> I also changed the home-page to <https://letsencrypt.org/certificates/>.
>
> Updated patch attached.

Great! Here's a revision of `guix pull` that uses this "le-certs"
package, and assumes GnuTLS is available.

One caveat with this approach is that users will need to install GnuTLS
in their profile and set up GUILE_LOAD_PATH before `guix pull` works.

From 61bf52ff461e8a53175546928bd4ee41645bb5ca Mon Sep 17 00:00:00 2001
From: Marius Bakke <[email-masked]>
Date: Wed, 1 Mar 2017 22:11:02 +0100
Subject: [PATCH] pull: Default to HTTPS.

* guix/scripts/pull.scm (%snapshot-url): Use HTTPS.
(guix-pull): Authenticate against LE-CERTS when URL is from Savannah.
---
 guix/scripts/pull.scm | 22 ++++++++++++++++++++--
 1 file changed, 20 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index a4824e4fd..8e31ad620 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <[email-masked]>
+;;; Copyright © 2017 Marius Bakke <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,10 +30,13 @@
   #:use-module (guix monads)
   #:use-module ((guix build utils)
                 #:select (with-directory-excursion delete-file-recursively))
+  #:use-module ((guix build download)
+                #:select (%x509-certificate-directory))
   #:use-module (gnu packages base)
   #:use-module (gnu packages guile)
   #:use-module ((gnu packages bootstrap)
                 #:select (%bootstrap-guile))
+  #:use-module ((gnu packages certs) #:select (le-certs))
   #:use-module (gnu packages compression)
   #:use-module (gnu packages gnupg)
   #:use-module (srfi srfi-1)
@@ -45,7 +49,7 @@
 
 (define %snapshot-url
   ;; "http://hydra.gnu.org/job/guix/master/tarball/latest/download"
-  "http://git.savannah.gnu.org/cgit/guix.git/snapshot/master.tar.gz"
+  "https://git.savannah.gnu.org/cgit/guix.git/snapshot/master.tar.gz"
   )
 
 (define-syntax-rule (with-environment-variable variable value body ...)
@@ -221,11 +225,25 @@ contained therein."
                   (leave (_ "~A: unexpected argument~%") arg))
                 %default-options))
 
+  (define (use-le-certs? url)
+    (string-prefix? "https://git.savannah.gnu.org/" url))
+
+  (define (fetch-tarball store url)
+    (download-to-store store url "guix-latest.tar.gz"))
+
   (with-error-handling
     (let* ((opts  (parse-options))
            (store (open-connection))
            (url   (assoc-ref opts 'tarball-url)))
-      (let ((tarball (download-to-store store url "guix-latest.tar.gz")))
+      (let ((tarball
+             (if (use-le-certs? url)
+                 (let* ((drv (package-derivation store le-certs))
+                        (certs (string-append (derivation->output-path drv)
+                                              "/etc/ssl/certs")))
+                   (build-derivations store (list drv))
+                   (parameterize ((%x509-certificate-directory certs))
+                     (fetch-tarball store url)))
+                 (fetch-tarball store url))))
         (unless tarball
           (leave (_ "failed to download up-to-date source, exiting\n")))
         (parameterize ((%guile-for-build
-- 
2.12.0