Re: [PATCH 01/12] guix: download: properly detect https when mirror:// is used.

[ludo@gnu.org (Ludovic Courtès)]

[-- Attachment #1: Type: text/plain, Size: 1826 bytes --]

Cyril Roelandt <tipecaml@gmail.com> skribis:

> * guix/download.scm (url-fetch): fix need-gnutls? which always returned #f when
>   a URL with "mirror://" scheme was used.

[...]

>    (define need-gnutls?
> -    ;; True if any of the URLs need TLS support.

Please keep/adjust the comment.

> -    (let ((https? (cut string-prefix? "https://" <>)))
> -      (match url
> -        ((? string?)
> -         (https? url))
> -        ((url ...)
> -         (any https? url)))))
> +    (let ((https? (lambda (uri)
> +                    (eq? 'https (uri-scheme uri)))))
> +      (any https? (append-map (cut build:maybe-expand-mirrors <> %mirrors)
> +                  (match url
> +                    ((_ ...) (map string->uri url))
> +                    (_       (list (string->uri url))))))))

This looks like a good idea, but it might raise bootstrapping issues.

For instance, what if mirror://gnu includes HTTPS URLs?  Try the
following:

  guix gc -d /gnu/store/*-glibc-2.22.tar.xz
  ./pre-inst-env guix build -S \
     -e '(@@ (gnu packages commencement) glibc-final)' \
     --no-substitutes

If mirror://gnu contains HTTPS URLs, this will create a circular
dependency (glibc’s source depends on GnuTLS, which depends on glibc,
which depends on glibc’s source), leading to a stack overflow and
maximum user unhappiness.

So address that, I modified the patch as shown in the attached file.  It
solves the bootstrapping case.

But that still doesn’t handle the more general problem of creating a
circular dependency between GnuTLS and source downloads.  That could
actually happen anywhere in the package graph.  So all in all, I’d
rather take the conservative approach and avoid that.

Is there a mirror for which that is a serious issue?

Thanks,
Ludo’.


[-- Attachment #2: the patch --]
[-- Type: text/x-patch, Size: 3617 bytes --]

From ae4e4168aefd04b001ba1dd368fb08ae0c5af433 Mon Sep 17 00:00:00 2001
From: Cyril Roelandt <tipecaml@gmail.com>
Date: Mon, 12 Oct 2015 23:40:57 +0200
Subject: [PATCH] download: Detect https when mirror:// is used.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* guix/download.scm (url-fetch): Add #:allow-tls? parameter and honor
  it.
  [https?]: New local procedure.
  [need-gnutls?]: Check whether any of the mirrors requires HTTPS.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 gnu/packages/bootstrap.scm |  5 ++++-
 guix/download.scm          | 25 ++++++++++++++++---------
 2 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index f5bf069..8ab9713 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -63,7 +63,10 @@
               #:optional name #:key system)
       (fetch url hash-algo hash
              #:guile %bootstrap-guile
-             #:system system)))
+             #:system system
+
+             ;; Make sure we don't introduce a dependency on GnuTLS.
+             #:allow-tls? #f)))
 
   (define %bootstrap-patch-inputs
     ;; Packages used when an <origin> has a non-empty 'patches' field.
diff --git a/guix/download.scm b/guix/download.scm
index 204cfc0..2780f4c 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -45,6 +45,7 @@
           '(;; This one redirects to a (supposedly) nearby and (supposedly)
             ;; up-to-date mirror.
             "http://ftpmirror.gnu.org/"
+            "https://ftpmirror.gnu.org/"
 
             "ftp://ftp.cs.tu-berlin.de/pub/gnu/"
             "ftp://ftp.funet.fi/pub/mirrors/ftp.gnu.org/gnu/"
@@ -216,7 +217,8 @@
 (define* (url-fetch url hash-algo hash
                     #:optional name
                     #:key (system (%current-system))
-                    (guile (default-guile)))
+                    (guile (default-guile))
+                    (allow-tls? #t))
   "Return a fixed-output derivation that fetches URL (a string, or a list of
 strings denoting alternate URLs), which is expected to have hash HASH of type
 HASH-ALGO (a symbol).  By default, the file name is the base name of URL;
@@ -226,7 +228,10 @@ When one of the URL starts with mirror://, then its host part is
 interpreted as the name of a mirror scheme, taken from %MIRROR-FILE.
 
 Alternately, when URL starts with file://, return the corresponding file name
-in the store."
+in the store.
+
+ALLOW-TLS? determines whether to allow TLS for downloads, which entails adding
+a dependency on GnuTLS."
   (define file-name
     (match url
       ((head _ ...)
@@ -234,18 +239,20 @@ in the store."
       (_
        (basename url))))
 
+  (define (https? uri)
+    (eq? 'https (uri-scheme uri)))
+
   (define need-gnutls?
     ;; True if any of the URLs need TLS support.
-    (let ((https? (cut string-prefix? "https://" <>)))
-      (match url
-        ((? string?)
-         (https? url))
-        ((url ...)
-         (any https? url)))))
+    (any https?
+         (append-map (cut build:maybe-expand-mirrors <> %mirrors)
+                     (match url
+                       ((_ ...) (map string->uri url))
+                       (_       (list (string->uri url)))))))
 
   (define builder
     #~(begin
-        #+(if need-gnutls?
+        #+(if (and allow-tls? need-gnutls?)
 
               ;; Add GnuTLS to the inputs and to the load path.
               #~(eval-when (load expand eval)
-- 
2.5.0