diff options
| -rw-r--r-- | guix/build/download.scm | 83 | ||||
| -rw-r--r-- | guix/download.scm | 19 | ||||
| -rw-r--r-- | 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 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 diff --git a/guix/download.scm b/guix/download.scm index 72094e7318..30f69c0325 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 6889bcef79..8d409092ba 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 |