ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix archive: '-f docker' supports package names as arguments.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2017-01-07 00:48:11 +01:00
parent 9385f0e9cb
commit 01445711db
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 18 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
guix/scripts/archive.scm
View file

@ -53,7 +53,8 @@ (define-module (guix scripts archive)
(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 @@ (define (export-from-store store opts)
(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 @@ (define (lines 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)