summaryrefslogtreecommitdiff
path: root/guix/scripts/pack.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-03-16 18:02:59 +0100
committerLudovic Courtès <ludo@gnu.org>2017-03-16 22:50:15 +0100
commitb1edfbc37f2f008188d91f594b046c5986485e47 (patch)
treee6ae31922409381c2bba08cdcb50d77d373ee3aa /guix/scripts/pack.scm
parent2971f39c3330a69f44d1ac97443e42b0f8e0173e (diff)
pack: Add '--format' option and Docker output support.
* guix/docker.scm: Remove dependency on (guix store) and (guix utils). Use (guix build store-copy). Load (json) lazily. (build-docker-image): Remove #:system. Add #:closure, #:compressor, and 'image' parameters. Use 'uname' to determine the architecture. Remove use of 'call-with-temporary-directory'. Use 'read-reference-graph' to compute ITEMS. Honor #:compressor. * guix/scripts/pack.scm (docker-image): New procedure. (%default-options): Add 'format'. (%formats): New variable. (%options, show-help): Add '--format'. (guix-pack): Honor '--format'. * guix/scripts/archive.scm: Remove '--format' option. This reverts commits 1545a012cb7cd78e25ed99ecee26df457be590e9, 01445711db6771cea6122859c3f717f130359f55, and 03476a23ff2d4175b7d3c808726178f764359bec. * doc/guix.texi (Invoking guix pack): Document '--format'. (Invoking guix archive): Remove documentation of '--format'.
Diffstat (limited to 'guix/scripts/pack.scm')
-rw-r--r--guix/scripts/pack.scm95
1 files changed, 85 insertions, 10 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index e422b3cdda..c6f2145c5c 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -24,6 +24,7 @@
#:use-module (guix store)
#:use-module (guix grafts)
#:use-module (guix monads)
+ #:use-module (guix modules)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module (guix derivations)
@@ -32,6 +33,8 @@
#:use-module (gnu packages compression)
#:autoload (gnu packages base) (tar)
#:autoload (gnu packages package-management) (guix)
+ #:autoload (gnu packages gnupg) (libgcrypt)
+ #:autoload (gnu packages guile) (guile-json)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-37)
@@ -177,6 +180,59 @@ added to the pack."
build
#:references-graphs `(("profile" ,profile))))
+(define* (docker-image name profile
+ #:key deduplicate?
+ (compressor (first %compressors))
+ localstatedir?
+ (symlinks '())
+ (tar tar))
+ "Return a derivation to construct a Docker image of PROFILE. The
+image is a tarball conforming to the Docker Image Specification, compressed
+with COMPRESSOR. It can be passed to 'docker load'."
+ ;; FIXME: Honor SYMLINKS and LOCALSTATEDIR?.
+ (define not-config?
+ (match-lambda
+ (('guix 'config) #f)
+ (('guix rest ...) #t)
+ (('gnu rest ...) #t)
+ (rest #f)))
+
+ (define config
+ ;; (guix config) module for consumption by (guix gcrypt).
+ (scheme-file "gcrypt-config.scm"
+ #~(begin
+ (define-module (guix config)
+ #:export (%libgcrypt))
+
+ ;; XXX: Work around <http://bugs.gnu.org/15602>.
+ (eval-when (expand load eval)
+ (define %libgcrypt
+ #+(file-append libgcrypt "/lib/libgcrypt"))))))
+
+ (define build
+ (with-imported-modules `(,@(source-module-closure '((guix docker))
+ #:select? not-config?)
+ ((guix config) => ,config))
+ #~(begin
+ ;; Guile-JSON is required by (guix docker).
+ (add-to-load-path
+ (string-append #$guile-json "/share/guile/site/"
+ (effective-version)))
+
+ (use-modules (guix docker))
+
+ (setenv "PATH"
+ (string-append #$tar "/bin:"
+ #$(compressor-package compressor) "/bin"))
+
+ (build-docker-image #$output #$profile
+ #:closure "profile"
+ #:compressor '#$(compressor-command compressor)))))
+
+ (gexp->derivation (string-append name ".tar."
+ (compressor-extension compressor))
+ build
+ #:references-graphs `(("profile" ,profile))))
;;;
@@ -185,7 +241,8 @@ added to the pack."
(define %default-options
;; Alist of default option values.
- `((system . ,(%current-system))
+ `((format . tarball)
+ (system . ,(%current-system))
(substitutes? . #t)
(graft? . #t)
(max-silent-time . 3600)
@@ -193,6 +250,11 @@ added to the pack."
(symlinks . ())
(compressor . ,(first %compressors))))
+(define %formats
+ ;; Supported pack formats.
+ `((tarball . ,self-contained-tarball)
+ (docker . ,docker-image)))
+
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
@@ -206,6 +268,9 @@ added to the pack."
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+ (option '(#\f "format") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'format (string->symbol arg) result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
@@ -242,6 +307,8 @@ Create a bundle of PACKAGE.\n"))
(show-transformation-options-help)
(newline)
(display (_ "
+ -f, --format=FORMAT build a pack in the given FORMAT"))
+ (display (_ "
-s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\""))
(display (_ "
-C, --compression=TOOL compress using TOOL--e.g., \"lzip\""))
@@ -280,8 +347,16 @@ Create a bundle of PACKAGE.\n"))
(specification->package+output spec))
list))
specs))
- (compressor (assoc-ref opts 'compressor))
- (symlinks (assoc-ref opts 'symlinks))
+ (pack-format (assoc-ref opts 'format))
+ (name (string-append (symbol->string pack-format)
+ "-pack"))
+ (compressor (assoc-ref opts 'compressor))
+ (symlinks (assoc-ref opts 'symlinks))
+ (build-image (match (assq-ref %formats pack-format)
+ ((? procedure? proc) proc)
+ (#f
+ (leave (_ "~a: unknown pack format")
+ format))))
(localstatedir? (assoc-ref opts 'localstatedir?)))
(with-store store
;; Set the build options before we do anything else.
@@ -290,13 +365,13 @@ Create a bundle of PACKAGE.\n"))
(run-with-store store
(mlet* %store-monad ((profile (profile-derivation
(packages->manifest packages)))
- (drv (self-contained-tarball "pack" profile
- #:compressor
- compressor
- #:symlinks
- symlinks
- #:localstatedir?
- localstatedir?)))
+ (drv (build-image name profile
+ #:compressor
+ compressor
+ #:symlinks
+ symlinks
+ #:localstatedir?
+ localstatedir?)))
(mbegin %store-monad
(show-what-to-build* (list drv)
#:use-substitutes?