From e74250c3c535b75dd2225a26df51febb7ed94654 Mon Sep 17 00:00:00 2001
From: Timothy Sample <samplet@ngyro.com>
Date: Wed, 28 Apr 2021 00:23:09 -0400
Subject: Revert "download: Use Disarchive as a last resort."

This reverts commit 66b14dccdd0d83c875ce3a8d50ceab8b6f0a3ce2, which broke
'guix pull'.
---
 guix/build/download.scm | 83 ++++++-------------------------------------------
 1 file changed, 10 insertions(+), 73 deletions(-)

(limited to 'guix/build')

diff --git a/guix/build/download.scm b/guix/build/download.scm
index 5431d7c682..a22d4064ca 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
-- 
cgit v1.2.3