aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi34
-rw-r--r--guix/docker.scm103
-rw-r--r--guix/scripts/archive.scm31
-rw-r--r--guix/scripts/pack.scm95
4 files changed, 161 insertions, 102 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 3382ac414e..45d171c52d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2435,6 +2435,22 @@ guix pack -S /opt/gnu/bin=bin guile emacs geiser
@noindent
That way, users can happily type @file{/opt/gnu/bin/guile} and enjoy.
+Alternatively, you can produce a pack in the Docker image format, as
+described in
+@uref{https://github.com/docker/docker/blob/master/image/spec/v1.2.md,
+version 1.2 of the specification}. This is what the following command
+does:
+
+@example
+guix pack -f docker guile emacs geiser
+@end example
+
+@noindent
+The result is a tarball that can be passed to the @command{docker load}
+command. See the
+@uref{https://docs.docker.com/engine/reference/commandline/load/, Docker
+documentation} for more information.
+
Several command-line options allow you to customize your pack:
@table @code
@@ -2537,7 +2553,7 @@ what you should use in this case (@pxref{Invoking guix copy}).
@cindex nar, archive format
@cindex normalized archive (nar)
-By default archives are stored in the ``normalized archive'' or ``nar'' format, which is
+Archives are stored in the ``normalized archive'' or ``nar'' format, which is
comparable in spirit to `tar', but with differences
that make it more appropriate for our purposes. First, rather than
recording all Unix metadata for each file, the nar format only mentions
@@ -2553,9 +2569,6 @@ verifies the signature and rejects the import in case of an invalid
signature or if the signing key is not authorized.
@c FIXME: Add xref to daemon doc about signatures.
-Optionally, archives can be exported as a Docker image in the tar
-archive format using @code{--format=docker}.
-
The main options are:
@table @code
@@ -2584,19 +2597,6 @@ Read a list of store file names from the standard input, one per line,
and write on the standard output the subset of these files missing from
the store.
-@item -f
-@item --format=@var{FMT}
-@cindex docker, export
-@cindex export format
-Specify the export format. Acceptable arguments are @code{nar} and
-@code{docker}. The default is the nar format. When the format is
-@code{docker}, recursively export the specified store directory as a
-Docker image in tar archive format, as specified in
-@uref{https://github.com/docker/docker/blob/master/image/spec/v1.2.md,
-version 1.2.0 of the Docker Image Specification}. Using
-@code{--format=docker} implies @code{--recursive}. The generated
-archive can be loaded by Docker using @command{docker load}.
-
@item --generate-key[=@var{parameters}]
@cindex signing, archives
Generate a new key pair for the daemon. This is a prerequisite before
diff --git a/guix/docker.scm b/guix/docker.scm
index 6dabaf25b0..56a0f7ec2b 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,17 +19,18 @@
(define-module (guix docker)
#:use-module (guix hash)
- #:use-module (guix store)
#:use-module (guix base16)
- #:use-module (guix utils)
#:use-module ((guix build utils)
#:select (delete-file-recursively
with-directory-excursion))
- #:use-module (json)
+ #:use-module (guix build store-copy)
#:use-module (rnrs bytevectors)
#:use-module (ice-9 match)
#:export (build-docker-image))
+;; Load Guile-JSON at run time to simplify the job of 'imported-modules' & co.
+(module-use! (current-module) (resolve-interface '(json)))
+
;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image
;; containing the closure at PATH.
(define docker-id
@@ -81,48 +83,55 @@
(rootfs . ((type . "layers")
(diff_ids . (,(layer-diff-id layer)))))))
-(define* (build-docker-image path #:key system)
- "Generate a Docker image archive from the given store PATH. The image
-contains the closure of the given store item."
- (let ((id (docker-id path))
+(define* (build-docker-image image path #:key closure compressor)
+ "Write to IMAGE a Docker image archive from the given store PATH. The image
+contains the closure of PATH, as specified in CLOSURE (a file produced by
+#:references-graphs). Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"),
+to compress IMAGE."
+ (let ((directory "/tmp/docker-image") ;temporary working directory
+ (closure (canonicalize-path closure))
+ (id (docker-id path))
(time (strftime "%FT%TZ" (localtime (current-time))))
- (name (string-append (getcwd)
- "/docker-image-" (basename path) ".tar"))
- (arch (match system
- ("x86_64-linux" "amd64")
- ("i686-linux" "386")
- ("armhf-linux" "arm")
- ("mips64el-linux" "mips64le"))))
- (and (call-with-temporary-directory
- (lambda (directory)
- (with-directory-excursion directory
- ;; Add symlink from /bin to /gnu/store/.../bin
- (symlink (string-append path "/bin") "bin")
-
- (mkdir id)
- (with-directory-excursion id
- (with-output-to-file "VERSION"
- (lambda () (display schema-version)))
- (with-output-to-file "json"
- (lambda () (scm->json (image-description id time))))
-
- ;; Wrap it up
- (let ((items (with-store store
- (requisites store (list path)))))
- (and (zero? (apply system* "tar" "-cf" "layer.tar"
- (cons "../bin" items)))
- (delete-file "../bin"))))
-
- (with-output-to-file "config.json"
- (lambda ()
- (scm->json (config (string-append id "/layer.tar")
- time arch))))
- (with-output-to-file "manifest.json"
- (lambda ()
- (scm->json (manifest path id))))
- (with-output-to-file "repositories"
- (lambda ()
- (scm->json (repositories path id)))))
- (and (zero? (system* "tar" "-C" directory "-cf" name "."))
- (begin (delete-file-recursively directory) #t))))
- name)))
+ (arch (match (utsname:machine (uname))
+ ("x86_64" "amd64")
+ ("i686" "386")
+ ("armv7l" "arm")
+ ("mips64" "mips64le"))))
+ ;; Make sure we start with a fresh, empty working directory.
+ (mkdir directory)
+
+ (and (with-directory-excursion directory
+ ;; Add symlink from /bin to /gnu/store/.../bin
+ (symlink (string-append path "/bin") "bin")
+
+ (mkdir id)
+ (with-directory-excursion id
+ (with-output-to-file "VERSION"
+ (lambda () (display schema-version)))
+ (with-output-to-file "json"
+ (lambda () (scm->json (image-description id time))))
+
+ ;; Wrap it up
+ (let ((items (call-with-input-file closure
+ read-reference-graph)))
+ (and (zero? (apply system* "tar" "-cf" "layer.tar"
+ (cons "../bin" items)))
+ (delete-file "../bin"))))
+
+ (with-output-to-file "config.json"
+ (lambda ()
+ (scm->json (config (string-append id "/layer.tar")
+ time arch))))
+ (with-output-to-file "manifest.json"
+ (lambda ()
+ (scm->json (manifest path id))))
+ (with-output-to-file "repositories"
+ (lambda ()
+ (scm->json (repositories path id)))))
+
+ (and (zero? (apply system* "tar" "-C" directory "-cf" image
+ `(,@(if compressor
+ (list "-I" (string-join compressor))
+ '())
+ ".")))
+ (begin (delete-file-recursively directory) #t)))))
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index cad279fb50..8137455a9d 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -1,6 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -45,11 +44,6 @@
#:export (guix-archive
options->derivations+files))
-;; XXX: Use this hack instead of #:autoload to avoid compilation errors.
-;; See <http://bugs.gnu.org/12202>.
-(module-autoload! (current-module)
- '(guix docker) '(build-docker-image))
-
;;;
;;; Command-line options.
@@ -57,8 +51,7 @@
(define %default-options
;; Alist of default option values.
- `((format . "nar")
- (system . ,(%current-system))
+ `((system . ,(%current-system))
(substitutes? . #t)
(graft? . #t)
(max-silent-time . 3600)
@@ -70,8 +63,6 @@ Export/import one or more packages from/to the store.\n"))
(display (_ "
--export export the specified files/packages to stdout"))
(display (_ "
- --format=FMT export files/packages in the specified format FMT"))
- (display (_ "
-r, --recursive combined with '--export', include dependencies"))
(display (_ "
--import import from the archive passed on stdin"))
@@ -126,9 +117,6 @@ Export/import one or more packages from/to the store.\n"))
(option '("export") #f #f
(lambda (opt name arg result)
(alist-cons 'export #t result)))
- (option '(#\f "format") #t #f
- (lambda (opt name arg result . rest)
- (alist-cons 'format arg result)))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'export-recursive? #t result)))
@@ -258,21 +246,8 @@ resulting archive to the standard output port."
(if (or (assoc-ref opts 'dry-run?)
(build-derivations store drv))
- (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))))
- (x
- ;; TODO: Remove this restriction.
- (leave (_ "only a single item can be exported to Docker~%")))))
- (format
- (leave (_ "~a: unknown archive format~%") format)))
+ (export-paths store files (current-output-port)
+ #:recursive? (assoc-ref opts 'export-recursive?))
(leave (_ "unable to export the given packages~%")))))
(define (generate-key-pair parameters)
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?