Factorize `download-and-store'.
* guix/download.scm (download-to-store): New procedure. * guix/scripts/download.scm (fetch-and-store): Remove. (guix-download): Use `download-to-store' instead. * guix/ui.scm (call-with-temporary-output-file): Move to... * guix/utils.scm (call-with-temporary-output-file): ... here.
This commit is contained in:
parent
6c365eca6d
commit
861693f3e7
|
@ -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
|
||||
|
|
|
@ -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~%")
|
||||
|
|
16
guix/ui.scm
16
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."
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue