branch master updated: Revert "download: Use Disarchive as a last resort."

[guix-commits]

This is an automated email from the git hooks/post-receive script.

samplet pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new e74250c  Revert "download: Use Disarchive as a last resort."
e74250c is described below

commit e74250c3c535b75dd2225a26df51febb7ed94654
Author: Timothy Sample <samplet@ngyro.com>
AuthorDate: Wed Apr 28 00:23:09 2021 -0400

    Revert "download: Use Disarchive as a last resort."
    
    This reverts commit 66b14dccdd0d83c875ce3a8d50ceab8b6f0a3ce2, which broke
    'guix pull'.
---
 guix/build/download.scm           | 83 +++++----------------------------------
 guix/download.scm                 | 19 ++-------
 guix/scripts/perform-download.scm |  7 +---
 3 files changed, 14 insertions(+), 95 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 5431d7c..a22d406 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -2,7 +2,6 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 
Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
-;;; Copyright © 2021 Timothy Sample <samplet@ngyro.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,8 +34,6 @@
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:autoload   (ice-9 ftw) (scandir)
-  #:autoload   (guix base16) (bytevector->base16-string)
-  #:autoload   (guix swh) (swh-download-directory)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (open-socket-for-uri
@@ -629,53 +626,10 @@ Return a list of URIs."
     (else
      (list uri))))
 
-(define* (disarchive-fetch/any uris file
-                               #:key (timeout 10) (verify-certificate? #t))
-  "Fetch a Disarchive specification from any of URIS, assemble it,
-and write the output to FILE."
-  (define (fetch-specification uris)
-    (any (lambda (uri)
-           (false-if-exception*
-            (let-values (((port size) (http-fetch uri
-                                                  #:verify-certificate?
-                                                  verify-certificate?
-                                                  #:timeout timeout)))
-              (let ((specification (read port)))
-                (close-port port)
-                specification))))
-         uris))
-
-  (define (resolve addresses output)
-    (any (match-lambda
-           (('swhid swhid)
-            (match (string-split swhid #\:)
-              (("swh" "1" "dir" id)
-               (format #t "Downloading from Software Heritage...~%" file)
-               (false-if-exception*
-                (swh-download-directory id output)))
-              (_ #f)))
-           (_ #f))
-         addresses))
-
-  (format #t "Trying to use Disarchive to assemble ~a...~%" file)
-  (match (and=> (resolve-module '(disarchive) #:ensure #f)
-                (lambda (disarchive)
-                  (cons (module-ref disarchive '%disarchive-log-port)
-                        (module-ref disarchive 'disarchive-assemble))))
-    (#f
-     (format #t "could not load Disarchive~%"))
-    ((%disarchive-log-port . disarchive-assemble)
-     (match (fetch-specification uris)
-       (#f
-        (format #t "could not find its Disarchive specification~%"))
-       (spec (parameterize ((%disarchive-log-port (current-output-port)))
-               (disarchive-assemble spec file #:resolver resolve)))))))
-
 (define* (url-fetch url file
                     #:key
                     (timeout 10) (verify-certificate? #t)
                     (mirrors '()) (content-addressed-mirrors '())
-                    (disarchive-mirrors '())
                     (hashes '())
                     print-build-trace?)
   "Fetch FILE from URL; URL may be either a single string, or a list of
@@ -739,18 +693,6 @@ otherwise simply ignore them."
                               hashes))
                 content-addressed-mirrors))
 
-  (define disarchive-uris
-    (append-map (match-lambda
-                  ((? string? mirror)
-                   (map (match-lambda
-                          ((hash-algo . hash)
-                           (string->uri
-                            (string-append mirror
-                                           (symbol->string hash-algo) "/"
-                                           (bytevector->base16-string hash)))))
-                        hashes)))
-                disarchive-mirrors))
-
   ;; Make this unbuffered so 'progress-report/file' works as expected.  'line
   ;; means '\n', not '\r', so it's not appropriate here.
   (setvbuf (current-output-port) 'none)
@@ -763,20 +705,15 @@ otherwise simply ignore them."
        (or (fetch uri file)
            (try tail)))
       (()
-       ;; If we are looking for a software archive, one last thing we
-       ;; can try is to use Disarchive to assemble it.
-       (or (disarchive-fetch/any disarchive-uris file
-                                 #:verify-certificate? verify-certificate?
-                                 #:timeout timeout)
-           (begin
-             (format (current-error-port) "failed to download ~s from ~s~%"
-                     file url)
-             ;; Remove FILE in case we made an incomplete download, for
-             ;; example due to ENOSPC.
-             (catch 'system-error
-               (lambda ()
-                 (delete-file file))
-               (const #f))
-             #f))))))
+       (format (current-error-port) "failed to download ~s from ~s~%"
+               file url)
+
+       ;; Remove FILE in case we made an incomplete download, for example due
+       ;; to ENOSPC.
+       (catch 'system-error
+         (lambda ()
+           (delete-file file))
+         (const #f))
+       #f))))
 
 ;;; download.scm ends here
diff --git a/guix/download.scm b/guix/download.scm
index 72094e7..30f69c0 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -406,19 +406,12 @@
   (plain-file "content-addressed-mirrors"
               (object->string %content-addressed-mirrors)))
 
-(define %disarchive-mirrors
-  '("https://disarchive.ngyro.com/";))
-
-(define %disarchive-mirror-file
-  (plain-file "disarchive-mirrors" (object->string %disarchive-mirrors)))
-
 (define built-in-builders*
   (store-lift built-in-builders))
 
 (define* (built-in-download file-name url
                             #:key system hash-algo hash
                             mirrors content-addressed-mirrors
-                            disarchive-mirrors
                             executable?
                             (guile 'unused))
   "Download FILE-NAME from URL using the built-in 'download' builder.  When
@@ -429,16 +422,13 @@ explicitly depend on Guile, GnuTLS, etc.  Instead, the 
daemon performs the
 download by itself using its own dependencies."
   (mlet %store-monad ((mirrors (lower-object mirrors))
                       (content-addressed-mirrors
-                       (lower-object content-addressed-mirrors))
-                      (disarchive-mirrors (lower-object disarchive-mirrors)))
+                       (lower-object content-addressed-mirrors)))
     (raw-derivation file-name "builtin:download" '()
                     #:system system
                     #:hash-algo hash-algo
                     #:hash hash
                     #:recursive? executable?
-                    #:sources (list mirrors
-                                    content-addressed-mirrors
-                                    disarchive-mirrors)
+                    #:sources (list mirrors content-addressed-mirrors)
 
                     ;; Honor the user's proxy and locale settings.
                     #:leaked-env-vars '("http_proxy" "https_proxy"
@@ -449,7 +439,6 @@ download by itself using its own dependencies."
                                  ("mirrors" . ,mirrors)
                                  ("content-addressed-mirrors"
                                   . ,content-addressed-mirrors)
-                                 ("disarchive-mirrors" . ,disarchive-mirrors)
                                  ,@(if executable?
                                        '(("executable" . "1"))
                                        '()))
@@ -503,9 +492,7 @@ name in the store."
                              #:executable? executable?
                              #:mirrors %mirror-file
                              #:content-addressed-mirrors
-                             %content-addressed-mirror-file
-                             #:disarchive-mirrors
-                             %disarchive-mirror-file)))))
+                             %content-addressed-mirror-file)))))
 
 (define* (url-fetch/executable url hash-algo hash
                                #:optional name
diff --git a/guix/scripts/perform-download.scm 
b/guix/scripts/perform-download.scm
index 6889bce..8d40909 100644
--- a/guix/scripts/perform-download.scm
+++ b/guix/scripts/perform-download.scm
@@ -54,8 +54,7 @@ actual output is different from that when we're doing a 
'bmCheck' or
                        (output* "out")
                        (executable "executable")
                        (mirrors "mirrors")
-                       (content-addressed-mirrors "content-addressed-mirrors")
-                       (disarchive-mirrors "disarchive-mirrors"))
+                       (content-addressed-mirrors "content-addressed-mirrors"))
     (unless url
       (leave (G_ "~a: missing URL~%") (derivation-file-name drv)))
 
@@ -80,10 +79,6 @@ actual output is different from that when we're doing a 
'bmCheck' or
                              (lambda (port)
                                (eval (read port) %user-module)))
                            '())
-                       #:disarchive-mirrors
-                       (if disarchive-mirrors
-                           (call-with-input-file disarchive-mirrors read)
-                           '())
                        #:hashes `((,algo . ,hash))
 
                        ;; Since DRV's output hash is known, X.509 certificate