summaryrefslogtreecommitdiff
path: root/guix/scripts/archive.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-01-07 00:48:11 +0100
committerLudovic Courtès <ludo@gnu.org>2017-01-07 22:55:40 +0100
commit01445711db6771cea6122859c3f717f130359f55 (patch)
tree4e8397bbef3856c90884965b7ce44b31326bfd86 /guix/scripts/archive.scm
parent9385f0e9cbaa84e0a519ea073c361dea63c5d0f0 (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.scm30
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)