guix download: Add '-o' option.
* guix/scripts/download.scm (download-to-file, download-to-store*): New procedures. (%default-options): Add 'download-proc'. (show-help): Adjust description and document '-o'. (%options): Add '-o'. (guix-download): Remove 'store' variable. Add 'fetch' and define 'path' to as its result. * tests/guix-download.sh: Add test.
This commit is contained in:
parent
eb4b3e4bef
commit
1bcc87bb68
|
@ -4836,6 +4836,10 @@ When using this option, you have @emph{absolutely no guarantee} that you
|
||||||
are communicating with the authentic server responsible for the given
|
are communicating with the authentic server responsible for the given
|
||||||
URL, which makes you vulnerable to ``man-in-the-middle'' attacks.
|
URL, which makes you vulnerable to ``man-in-the-middle'' attacks.
|
||||||
|
|
||||||
|
@item --output=@var{file}
|
||||||
|
@itemx -o @var{file}
|
||||||
|
Save the downloaded file to @var{file} instead of adding it to the
|
||||||
|
store.
|
||||||
@end table
|
@end table
|
||||||
|
|
||||||
@node Invoking guix hash
|
@node Invoking guix hash
|
||||||
|
|
|
@ -23,12 +23,15 @@
|
||||||
#:use-module (guix hash)
|
#:use-module (guix hash)
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix base32)
|
#:use-module (guix base32)
|
||||||
#:use-module (guix download)
|
#:use-module ((guix download) #:hide (url-fetch))
|
||||||
#:use-module ((guix build download) #:select (current-terminal-columns))
|
#:use-module ((guix build download)
|
||||||
#:use-module ((guix build syscalls) #:select (terminal-columns))
|
#:select (url-fetch current-terminal-columns))
|
||||||
|
#:use-module ((guix build syscalls)
|
||||||
|
#:select (terminal-columns))
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-37)
|
#:use-module (srfi srfi-37)
|
||||||
#:use-module (rnrs bytevectors)
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (ice-9 binary-ports)
|
#:use-module (ice-9 binary-ports)
|
||||||
|
@ -39,15 +42,31 @@
|
||||||
;;; Command-line options.
|
;;; Command-line options.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
(define (download-to-file url file)
|
||||||
|
"Download the file at URI to FILE. Return FILE."
|
||||||
|
(let ((uri (string->uri url)))
|
||||||
|
(match (uri-scheme uri)
|
||||||
|
((or 'file #f)
|
||||||
|
(copy-file (uri-path uri) file))
|
||||||
|
(_
|
||||||
|
(url-fetch url file)))
|
||||||
|
file))
|
||||||
|
|
||||||
|
(define* (download-to-store* url #:key (verify-certificate? #t))
|
||||||
|
(with-store store
|
||||||
|
(download-to-store store url
|
||||||
|
#:verify-certificate? verify-certificate?)))
|
||||||
|
|
||||||
(define %default-options
|
(define %default-options
|
||||||
;; Alist of default option values.
|
;; Alist of default option values.
|
||||||
`((format . ,bytevector->nix-base32-string)
|
`((format . ,bytevector->nix-base32-string)
|
||||||
(verify-certificate? . #t)))
|
(verify-certificate? . #t)
|
||||||
|
(download-proc . ,download-to-store*)))
|
||||||
|
|
||||||
(define (show-help)
|
(define (show-help)
|
||||||
(display (_ "Usage: guix download [OPTION] URL
|
(display (_ "Usage: guix download [OPTION] URL
|
||||||
Download the file at URL, add it to the store, and print its store path
|
Download the file at URL to the store or to the given file, and print its
|
||||||
and the hash of its contents.
|
file name and the hash of its contents.
|
||||||
|
|
||||||
Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||||
('hex' and 'hexadecimal' can be used as well).\n"))
|
('hex' and 'hexadecimal' can be used as well).\n"))
|
||||||
|
@ -56,6 +75,8 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||||
(format #t (_ "
|
(format #t (_ "
|
||||||
--no-check-certificate
|
--no-check-certificate
|
||||||
do not validate the certificate of HTTPS servers "))
|
do not validate the certificate of HTTPS servers "))
|
||||||
|
(format #f (_ "
|
||||||
|
-o, --output=FILE download to FILE"))
|
||||||
(newline)
|
(newline)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
|
@ -84,6 +105,12 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||||
(option '("no-check-certificate") #f #f
|
(option '("no-check-certificate") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'verify-certificate? #f result)))
|
(alist-cons 'verify-certificate? #f result)))
|
||||||
|
(option '(#\o "output") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'download-proc
|
||||||
|
(lambda* (url #:key verify-certificate?)
|
||||||
|
(download-to-file url arg))
|
||||||
|
(alist-delete 'download result))))
|
||||||
|
|
||||||
(option '(#\h "help") #f #f
|
(option '(#\h "help") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
|
@ -113,24 +140,17 @@ Supported formats: 'nix-base32' (default), 'base32', and 'base16'
|
||||||
|
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(let* ((opts (parse-options))
|
(let* ((opts (parse-options))
|
||||||
(store (open-connection))
|
|
||||||
(arg (or (assq-ref opts 'argument)
|
(arg (or (assq-ref opts 'argument)
|
||||||
(leave (_ "no download URI was specified~%"))))
|
(leave (_ "no download URI was specified~%"))))
|
||||||
(uri (or (string->uri arg)
|
(uri (or (string->uri arg)
|
||||||
(leave (_ "~a: failed to parse URI~%")
|
(leave (_ "~a: failed to parse URI~%")
|
||||||
arg)))
|
arg)))
|
||||||
(path (case (uri-scheme uri)
|
(fetch (assq-ref opts 'download-proc))
|
||||||
((file)
|
(path (parameterize ((current-terminal-columns
|
||||||
(add-to-store store (basename (uri-path uri))
|
(terminal-columns)))
|
||||||
#f "sha256" (uri-path uri)))
|
(fetch arg
|
||||||
(else
|
#:verify-certificate?
|
||||||
(parameterize ((current-terminal-columns
|
(assq-ref opts 'verify-certificate?))))
|
||||||
(terminal-columns)))
|
|
||||||
(download-to-store store (uri->string uri)
|
|
||||||
(basename (uri-path uri))
|
|
||||||
#:verify-certificate?
|
|
||||||
(assoc-ref opts
|
|
||||||
'verify-certificate?))))))
|
|
||||||
(hash (call-with-input-file
|
(hash (call-with-input-file
|
||||||
(or path
|
(or path
|
||||||
(leave (_ "~a: download failed~%")
|
(leave (_ "~a: download failed~%")
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
# GNU Guix --- Functional package management for GNU
|
# GNU Guix --- Functional package management for GNU
|
||||||
# Copyright © 2012, 2015 Ludovic Courtès <ludo@gnu.org>
|
# Copyright © 2012, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
|
||||||
#
|
#
|
||||||
# This file is part of GNU Guix.
|
# This file is part of GNU Guix.
|
||||||
#
|
#
|
||||||
|
@ -35,6 +35,13 @@ then false; else true; fi
|
||||||
# This one should succeed.
|
# This one should succeed.
|
||||||
guix download "file://$abs_top_srcdir/README"
|
guix download "file://$abs_top_srcdir/README"
|
||||||
|
|
||||||
|
# This one too, even if it cannot talk to the daemon.
|
||||||
|
output="t-download-$$"
|
||||||
|
trap 'rm -f "$output"' EXIT
|
||||||
|
GUIX_DAEMON_SOCKET="/nowhere" guix download -o "$output" \
|
||||||
|
"file://$abs_top_srcdir/README"
|
||||||
|
cmp "$output" "$abs_top_srcdir/README"
|
||||||
|
|
||||||
# This one should fail.
|
# This one should fail.
|
||||||
if guix download "file:///does-not-exist" "file://$abs_top_srcdir/README"
|
if guix download "file:///does-not-exist" "file://$abs_top_srcdir/README"
|
||||||
then false; else true; fi
|
then false; else true; fi
|
||||||
|
|
Loading…
Reference in New Issue