diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-01-07 00:48:11 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-01-07 22:55:40 +0100 |
| commit | 01445711db6771cea6122859c3f717f130359f55 (patch) | |
| tree | 4e8397bbef3856c90884965b7ce44b31326bfd86 /guix/scripts/archive.scm | |
| parent | 9385f0e9cbaa84e0a519ea073c361dea63c5d0f0 (diff) | |
guix archive: '-f docker' supports package names as arguments.
This allows users to type:
guix archive -f docker emacs
as was already the case for the 'nar' format.
Reported by David Thompson.
* guix/scripts/archive.scm (%default-options): Add 'format'.
(export-from-store): Dispatch based on the 'format' key in OPTS.
(guix-archive): Call 'export-from-store' in all cases when the 'export'
key is in OPTS.
Diffstat (limited to 'guix/scripts/archive.scm')
| -rw-r--r-- | guix/scripts/archive.scm | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 6eba9e0008..3e056fda9b 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -53,7 +53,8 @@ (define %default-options ;; Alist of default option values. - `((system . ,(%current-system)) + `((format . "nar") + (system . ,(%current-system)) (substitutes? . #t) (graft? . #t) (max-silent-time . 3600) @@ -253,8 +254,21 @@ resulting archive to the standard output port." (if (or (assoc-ref opts 'dry-run?) (build-derivations store drv)) - (export-paths store files (current-output-port) - #:recursive? (assoc-ref opts 'export-recursive?)) + (match (assoc-ref opts 'format) + ("nar" + (export-paths store files (current-output-port) + #:recursive? (assoc-ref opts 'export-recursive?))) + ("docker" + (match files + ((file) + (let ((system (assoc-ref opts 'system))) + (format #t "~a\n" + (build-docker-image file #:system system)))) + (_ + ;; TODO: Remove this restriction. + (leave (_ "only a single item can be exported to Docker~%"))))) + (format + (leave (_ "~a: unknown archive format~%") format))) (leave (_ "unable to export the given packages~%"))))) (define (generate-key-pair parameters) @@ -338,15 +352,7 @@ the input port." (else (with-store store (cond ((assoc-ref opts 'export) - (cond ((equal? (assoc-ref opts 'format) "docker") - (match (car opts) - (('argument . (? store-path? item)) - (format #t "~a\n" - (build-docker-image - item - #:system (assoc-ref opts 'system)))) - (_ (leave (_ "argument must be a direct store path~%"))))) - (_ (export-from-store store opts)))) + (export-from-store store opts)) ((assoc-ref opts 'import) (import-paths store (current-input-port))) ((assoc-ref opts 'missing) |