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:
Ludovic Courtès 2016-10-29 01:16:24 +02:00
parent eb4b3e4bef
commit 1bcc87bb68
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 51 additions and 20 deletions

View File

@ -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

View File

@ -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~%")

View File

@ -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