guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [PATCH] Creating a docker image with Guix


From: Ricardo Wurmus
Subject: Re: [PATCH] Creating a docker image with Guix
Date: Thu, 5 Jan 2017 17:13:44 +0100
User-agent: mu4e 0.9.16; emacs 25.1.1

Ludovic Courtès <address@hidden> writes:

>> --- a/doc/guix.texi
>> +++ b/doc/guix.texi
>> @@ -2438,6 +2438,12 @@ 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.
>>  
>> address@hidden address@hidden
>> address@hidden docker, export
>> +Recursively export the specified store directory as a Docker image in
>> +tar archive format.  The generated archive can be loaded by Docker using
>> address@hidden load}.
>
> Maybe “as a Docker image in tar archive format, as specified in
> @uref{http://…, version 1.0 of the Foo Bar Spec}.”

Okay.

> I would be in favor of --format=FMT, where FMT can be one of “nar” or
> “docker”.  Maybe there’ll be others in the future.  WDYT?

Sounds good.

> The paragraph that says “Archives are stored in the “normalized archive”
> or “nar” format,“ should be updated.
>
> Also, it seems that ‘-f docker’ would always imply ’-r’, right?  That’s
> reasonable but would be worth mentioning.

Okay.

>> +(define (hexencode bv)
>> +  "Return the hexadecimal representation of the bytevector BV."
>> +  (format #f "~{~2,'0x~}" (bytevector->u8-list bv)))
>
> Maybe use ‘bytevector->base16-string’ from (guix utils) instead.

Ah, didn’t know about this one.

>> +(define spec-version "1.0")
>
> Please add the URL to said spec as a comment.

I added a clarifying comment (because confusingly this is NOT the
version of the Docker image spec).

>> +;; TODO: heroically copied from guix/script/pull.scm
>> +(define (temporary-directory)
>
> Alternatively, there’s ‘call-with-temporary-directory’ in (guix utils).
> :-)

Neat!

>> +          (and (zero? (apply system* "tar" "-cf" "layer.tar"
>> +                             (cons "../bin" items)))
>> +               (delete-file "../bin"))))
>
> This reminds me we should steal this code of Mark’s sometime:
>
>   https://github.com/spk121/guile100/blob/master/code/tar2.scm

Yes, this would be nice.

Attached is a new patch with all requested changes and a couple of fixes
(generated images now have proper names and tags).

~~ Ricardo

>From fefd4f02d003dd35bd0ab459ec2ccc9f9ad62ffa Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <address@hidden>
Date: Tue, 3 Jan 2017 16:20:15 +0100
Subject: [PATCH] guix: Add Docker image export.

* guix/docker.scm: New file.
* Makefile.am (MODULES): Register it.
* guix/scripts/archive.scm (show-help, %options, guix-archive): Add
support for "--format".
* doc/guix.texi (Invoking guix archive): Document it.
---
 Makefile.am              |   1 +
 doc/guix.texi            |  18 +++++++-
 guix/docker.scm          | 117 +++++++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/archive.scm |  14 +++++-
 4 files changed, 148 insertions(+), 2 deletions(-)
 create mode 100644 guix/docker.scm

diff --git a/Makefile.am b/Makefile.am
index fb08a004b..4317b83a2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -158,6 +158,7 @@ MODULES =                                   \
 if HAVE_GUILE_JSON
 
 MODULES +=                                     \
+  guix/docker.scm                              \
   guix/import/github.scm                       \
   guix/import/json.scm                         \
   guix/import/crate.scm                                \
diff --git a/doc/guix.texi b/doc/guix.texi
index 3a9ebe8a6..93a56a2b0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2394,7 +2394,7 @@ what you should use in this case (@pxref{Invoking guix 
copy}).
 
 @cindex nar, archive format
 @cindex normalized archive (nar)
-Archives are stored in the ``normalized archive'' or ``nar'' format, which is
+By default 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
@@ -2410,6 +2410,9 @@ 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
@@ -2438,6 +2441,19 @@ 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.
 
address@hidden -f
address@hidden address@hidden
address@hidden docker, export
address@hidden export format
+Specify the export format.  Acceptable arguments are @code{nar} and
address@hidden  The default is the nar format.  When the format is
address@hidden, recursively export the specified store directory as a
+Docker image in tar archive format, as specified in
address@hidden://github.com/docker/docker/blob/master/image/spec/v1.2.md,
+version 1.2.0 of the Docker Image Specification}.  Using
address@hidden implies @code{--recursive}.  The generated
+archive can be loaded by Docker using @command{docker load}.
+
 @item address@hidden
 @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
new file mode 100644
index 000000000..0cc0f2af9
--- /dev/null
+++ b/guix/docker.scm
@@ -0,0 +1,117 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Ricardo Wurmus <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix docker)
+  #:use-module (guix hash)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module ((guix build utils)
+                #:select (delete-file-recursively
+                          with-directory-excursion))
+  #:use-module (json)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:export (build-docker-image))
+
+;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image
+;; containing the closure at PATH.
+(define docker-id
+  (compose bytevector->base16-string sha256 string->utf8))
+
+(define (layer-diff-id layer)
+  "Generate a layer DiffID for the given LAYER archive."
+  (string-append "sha256:" (bytevector->base16-string (file-sha256 layer))))
+
+;; This is the semantic version of the JSON metadata schema according to
+;; https://github.com/docker/docker/blob/master/image/spec/v1.2.md
+;; It is NOT the version of the image specification.
+(define schema-version "1.0")
+
+(define (image-description id time)
+  "Generate a simple image description."
+  `((id . ,id)
+    (created . ,time)
+    (container_config . #nil)))
+
+(define (generate-tag path)
+  "Generate an image tag for the given PATH."
+  (match (string-split (basename path) #\-)
+    ((hash name . rest) (string-append name ":" hash))))
+
+(define (manifest path id)
+  "Generate a simple image manifest."
+  `(((Config . "config.json")
+     (RepoTags . (,(generate-tag path)))
+     (Layers . (,(string-append id "/layer.tar"))))))
+
+;; According to the specifications this is required for backwards
+;; compatibility.  It duplicates information provided by the manifest.
+(define (repositories path id)
+  "Generate a repositories file referencing PATH and the image ID."
+  `((,(generate-tag path) . ((latest . ,id)))))
+
+;; See https://github.com/opencontainers/image-spec/blob/master/config.md
+(define (config layer time)
+  "Generate a minimal image configuratio for the given LAYER file."
+  `((architecture . "amd64")
+    (comment . "Generated by GNU Guix")
+    (created . ,time)
+    (config . #nil)
+    (container_config . #nil)
+    (os . "linux")
+    (rootfs . ((type . "layers")
+               (diff_ids . (,(layer-diff-id layer)))))))
+
+(define (build-docker-image path)
+  "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))
+        (time (strftime "%FT%TZ" (localtime (current-time))))
+        (name (string-append (getcwd)
+                             "/docker-image-" (basename path) ".tar")))
+    (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))))
+              (with-output-to-file "manifest.json"
+                (lambda ()
+                  (scm->json (manifest path id))))
+              (with-output-to-file "repositories"
+                (lambda ()
+                  (scm->json (repositories path id)))))
+            (zero? (system* "tar" "-C" directory "-cf" name "."))))
+         name)))
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 7e432351e..8ae233cd1 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2017 Ricardo Wurmus <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +31,7 @@
   #:use-module (guix ui)
   #:use-module (guix pki)
   #:use-module (guix pk-crypto)
+  #:use-module (guix docker)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:use-module (gnu packages)
@@ -63,6 +65,8 @@ 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"))
@@ -117,6 +121,9 @@ 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)))
@@ -331,7 +338,12 @@ the input port."
                 (else
                  (with-store store
                    (cond ((assoc-ref opts 'export)
-                          (export-from-store store opts))
+                          (cond ((equal? (assoc-ref opts 'format) "docker")
+                                 (match (car opts)
+                                   (('argument . (? store-path? item))
+                                    (format #t "~a\n" (build-docker-image 
item)))
+                                   (_ (leave (_ "argument must be a direct 
store path~%")))))
+                                (_ (export-from-store store opts))))
                          ((assoc-ref opts 'import)
                           (import-paths store (current-input-port)))
                          ((assoc-ref opts 'missing)
-- 
2.11.0


reply via email to

[Prev in Thread] Current Thread [Next in Thread]