Commit | Line | Data |
---|---|---|
c52a5bf0 LC |
1 | #!/bin/sh |
2 | # aside from this initial boilerplate, this is actually -*- scheme -*- code | |
3 | ||
b8605698 LC |
4 | prefix="@prefix@" |
5 | datarootdir="@datarootdir@" | |
6 | ||
c52a5bf0 LC |
7 | GUILE_LOAD_COMPILED_PATH="@guilemoduledir@:$GUILE_LOAD_COMPILED_PATH" |
8 | export GUILE_LOAD_COMPILED_PATH | |
9 | ||
10 | main='(module-ref (resolve-interface '\''(guix-download)) '\'guix-download')' | |
11 | exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ | |
12 | -c "(apply $main (cdr (command-line)))" "$@" | |
13 | !# | |
233e7676 LC |
14 | ;;; GNU Guix --- Functional package management for GNU |
15 | ;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> | |
c52a5bf0 | 16 | ;;; |
233e7676 | 17 | ;;; This file is part of GNU Guix. |
c52a5bf0 | 18 | ;;; |
233e7676 | 19 | ;;; GNU Guix is free software; you can redistribute it and/or modify it |
c52a5bf0 LC |
20 | ;;; under the terms of the GNU General Public License as published by |
21 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
22 | ;;; your option) any later version. | |
23 | ;;; | |
233e7676 | 24 | ;;; GNU Guix is distributed in the hope that it will be useful, but |
c52a5bf0 LC |
25 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of |
26 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
27 | ;;; GNU General Public License for more details. | |
28 | ;;; | |
29 | ;;; You should have received a copy of the GNU General Public License | |
233e7676 | 30 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. |
c52a5bf0 LC |
31 | |
32 | (define-module (guix-download) | |
073c34d7 | 33 | #:use-module (guix ui) |
c52a5bf0 LC |
34 | #:use-module (guix store) |
35 | #:use-module (guix utils) | |
ddc29a78 | 36 | #:use-module (guix base32) |
ec4d308a LC |
37 | #:use-module ((guix download) #:select (%mirrors)) |
38 | #:use-module (guix build download) | |
39 | #:use-module (web uri) | |
c52a5bf0 LC |
40 | #:use-module (ice-9 match) |
41 | #:use-module (srfi srfi-1) | |
42 | #:use-module (srfi srfi-11) | |
43 | #:use-module (srfi srfi-26) | |
44 | #:use-module (srfi srfi-37) | |
45 | #:use-module (rnrs bytevectors) | |
46 | #:use-module (rnrs io ports) | |
47 | #:export (guix-download)) | |
48 | ||
c52a5bf0 LC |
49 | (define (call-with-temporary-output-file proc) |
50 | (let* ((template (string-copy "guix-download.XXXXXX")) | |
51 | (out (mkstemp! template))) | |
52 | (dynamic-wind | |
53 | (lambda () | |
54 | #t) | |
55 | (lambda () | |
56 | (proc template out)) | |
57 | (lambda () | |
58 | (false-if-exception (delete-file template)))))) | |
59 | ||
ec4d308a LC |
60 | (define (fetch-and-store store fetch name) |
61 | "Call FETCH for URI, and pass it the name of a file to write to; eventually, | |
62 | copy data from that port to STORE, under NAME. Return the resulting | |
63 | store path." | |
352ec143 | 64 | (call-with-temporary-output-file |
ec4d308a LC |
65 | (lambda (temp port) |
66 | (let ((result | |
67 | (parameterize ((current-output-port (current-error-port))) | |
68 | (fetch temp)))) | |
69 | (close port) | |
70 | (and result | |
71 | (add-to-store store name #t #f "sha256" temp)))))) | |
c52a5bf0 LC |
72 | \f |
73 | ;;; | |
74 | ;;; Command-line options. | |
75 | ;;; | |
76 | ||
77 | (define %default-options | |
78 | ;; Alist of default option values. | |
79 | `((format . ,bytevector->nix-base32-string))) | |
80 | ||
c52a5bf0 LC |
81 | (define (show-help) |
82 | (display (_ "Usage: guix-download [OPTION]... URL | |
83 | Download the file at URL, add it to the store, and print its store path | |
84 | and the hash of its contents.\n")) | |
85 | (format #t (_ " | |
86 | -f, --format=FMT write the hash in the given format (default: `nix-base32')")) | |
87 | (newline) | |
88 | (display (_ " | |
89 | -h, --help display this help and exit")) | |
90 | (display (_ " | |
91 | -V, --version display version information and exit")) | |
92 | (newline) | |
3441e164 | 93 | (show-bug-report-information)) |
c52a5bf0 LC |
94 | |
95 | (define %options | |
96 | ;; Specifications of the command-line options. | |
97 | (list (option '(#\f "format") #t #f | |
98 | (lambda (opt name arg result) | |
99 | (define fmt-proc | |
100 | (match arg | |
101 | ("nix-base32" | |
102 | bytevector->nix-base32-string) | |
103 | ("base32" | |
104 | bytevector->base32-string) | |
105 | ((or "base16" "hex" "hexadecimal") | |
106 | bytevector->base16-string) | |
107 | (x | |
108 | (format (current-error-port) | |
109 | "unsupported hash format: ~a~%" arg)))) | |
110 | ||
111 | (alist-cons 'format fmt-proc | |
112 | (alist-delete 'format result)))) | |
113 | ||
114 | (option '(#\h "help") #f #f | |
115 | (lambda args | |
116 | (show-help) | |
117 | (exit 0))) | |
118 | (option '(#\V "version") #f #f | |
119 | (lambda args | |
cdd5d6f9 | 120 | (show-version-and-exit "guix-download"))))) |
c52a5bf0 LC |
121 | |
122 | \f | |
123 | ;;; | |
124 | ;;; Entry point. | |
125 | ;;; | |
126 | ||
127 | (define (guix-download . args) | |
128 | (define (parse-options) | |
129 | ;; Return the alist of option values. | |
130 | (args-fold args %options | |
131 | (lambda (opt name arg result) | |
132 | (leave (_ "~A: unrecognized option~%") name)) | |
133 | (lambda (arg result) | |
134 | (alist-cons 'argument arg result)) | |
135 | %default-options)) | |
136 | ||
137 | (setlocale LC_ALL "") | |
138 | (textdomain "guix") | |
139 | (setvbuf (current-output-port) _IOLBF) | |
140 | (setvbuf (current-error-port) _IOLBF) | |
141 | ||
142 | (let* ((opts (parse-options)) | |
143 | (store (open-connection)) | |
ec4d308a LC |
144 | (arg (assq-ref opts 'argument)) |
145 | (uri (or (string->uri arg) | |
ecdb81e1 | 146 | (leave (_ "guix-download: ~a: failed to parse URI~%") |
ec4d308a LC |
147 | arg))) |
148 | (path (case (uri-scheme uri) | |
352ec143 LC |
149 | ((file) |
150 | (add-to-store store (basename (uri-path uri)) | |
151 | #t #f "sha256" (uri-path uri))) | |
c52a5bf0 | 152 | (else |
ec4d308a LC |
153 | (fetch-and-store store |
154 | (cut url-fetch arg <> | |
155 | #:mirrors %mirrors) | |
156 | (basename (uri-path uri)))))) | |
157 | (hash (call-with-input-file | |
158 | (or path | |
159 | (leave (_ "guix-download: ~a: download failed~%") | |
160 | arg)) | |
a3aa25f8 LC |
161 | (compose sha256 get-bytevector-all))) |
162 | (fmt (assq-ref opts 'format))) | |
163 | (format #t "~a~%~a~%" path (fmt hash)) | |
c52a5bf0 | 164 | #t)) |