diff options
| -rw-r--r-- | guix/download.scm | 19 | ||||
| -rw-r--r-- | guix/scripts/download.scm | 23 | ||||
| -rw-r--r-- | guix/ui.scm | 16 | ||||
| -rw-r--r-- | guix/utils.scm | 16 |
4 files changed, 36 insertions, 38 deletions
diff --git a/guix/download.scm b/guix/download.scm index ea00798b4b..b315b4c1d0 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -21,13 +21,15 @@ #:use-module (ice-9 match) #:use-module (guix derivations) #:use-module (guix packages) - #:use-module ((guix store) #:select (derivation-path?)) + #:use-module ((guix store) #:select (derivation-path? add-to-store)) + #:use-module ((guix build download) #:renamer (symbol-prefix-proc 'build:)) #:use-module (guix utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:export (%mirrors - url-fetch)) + url-fetch + download-to-store)) ;;; Commentary: ;;; @@ -231,4 +233,17 @@ must be a list of symbol/URL-list pairs." #:guile-for-build guile-for-build #:env-vars env-vars))) +(define* (download-to-store store url #:optional (name (basename url)) + #:key (log (current-error-port))) + "Download from URL to STORE, either under NAME or URL's basename if +omitted. Write progress reports to LOG." + (call-with-temporary-output-file + (lambda (temp port) + (let ((result + (parameterize ((current-output-port log)) + (build:url-fetch url temp #:mirrors %mirrors)))) + (close port) + (and result + (add-to-store store name #f "sha256" temp)))))) + ;;; download.scm ends here diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index c8760454de..220211e6b8 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -21,30 +21,15 @@ #:use-module (guix store) #:use-module (guix utils) #:use-module (guix base32) - #:use-module ((guix download) #:select (%mirrors)) - #:use-module (guix build download) + #:use-module (guix download) #:use-module (web uri) #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-11) - #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:export (guix-download)) -(define (fetch-and-store store fetch name) - "Call FETCH for URI, and pass it the name of a file to write to; eventually, -copy data from that port to STORE, under NAME. Return the resulting -store path." - (call-with-temporary-output-file - (lambda (temp port) - (let ((result - (parameterize ((current-output-port (current-error-port))) - (fetch temp)))) - (close port) - (and result - (add-to-store store name #f "sha256" temp)))))) ;;; ;;; Command-line options. @@ -124,10 +109,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16' (add-to-store store (basename (uri-path uri)) #f "sha256" (uri-path uri))) (else - (fetch-and-store store - (cut url-fetch arg <> - #:mirrors %mirrors) - (basename (uri-path uri)))))) + (download-to-store store (uri->string uri) + (basename (uri-path uri)))))) (hash (call-with-input-file (or path (leave (_ "~a: download failed~%") diff --git a/guix/ui.scm b/guix/ui.scm index 778711be92..9ea2f02ce2 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -41,7 +41,6 @@ with-error-handling read/eval-package-expression location->string - call-with-temporary-output-file switch-symlinks config-directory fill-paragraph @@ -205,21 +204,6 @@ available for download." (($ <location> file line column) (format #f "~a:~a:~a" file line column)))) -(define (call-with-temporary-output-file proc) - "Call PROC with a name of a temporary file and open output port to that -file; close the file and delete it when leaving the dynamic extent of this -call." - (let* ((template (string-copy "guix-file.XXXXXX")) - (out (mkstemp! template))) - (dynamic-wind - (lambda () - #t) - (lambda () - (proc template out)) - (lambda () - (false-if-exception (close out)) - (false-if-exception (delete-file template)))))) - (define (switch-symlinks link target) "Atomically switch LINK, a symbolic link, to point to TARGET. Works both when LINK already exists and when it does not." diff --git a/guix/utils.scm b/guix/utils.scm index f13e585e2b..ad1c463be8 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -60,6 +60,7 @@ version-compare version>? package-name->name+version + call-with-temporary-output-file fold2)) @@ -464,6 +465,21 @@ introduce the version part." ((head tail ...) (loop tail (cons head prefix)))))) +(define (call-with-temporary-output-file proc) + "Call PROC with a name of a temporary file and open output port to that +file; close the file and delete it when leaving the dynamic extent of this +call." + (let* ((template (string-copy "guix-file.XXXXXX")) + (out (mkstemp! template))) + (dynamic-wind + (lambda () + #t) + (lambda () + (proc template out)) + (lambda () + (false-if-exception (close out)) + (false-if-exception (delete-file template)))))) + (define fold2 (case-lambda ((proc seed1 seed2 lst) |