rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ricardo Wurmus 2017-01-03 16:20:15 +01:00 committed by Ricardo Wurmus
parent 3a3bf2f819
commit 03476a23ff
No known key found for this signature in database
GPG Key ID: 197A5888235FACAC
4 changed files with 161 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.am
View File

@ -160,6 +160,7 @@ MODULES = \
if HAVE_GUILE_JSON
MODULES += \
guix/docker.scm \
guix/import/github.scm \
guix/import/json.scm \
guix/import/crate.scm \

18
doc/guix.texi
View File

@ -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.
@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

127
guix/docker.scm Normal file
View File

@ -0,0 +1,127 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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 arch)
"Generate a minimal image configuration for the given LAYER file."
;; "architecture" must be values matching "platform.arch" in the
;; runtime-spec at
;; https://github.com/opencontainers/runtime-spec/blob/v1.0.0-rc2/config.md#platform
`((architecture . ,arch)
(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 #: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))
(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)))

17
guix/scripts/archive.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; 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)
@ -62,6 +64,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 (_ "
@ -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,15 @@ 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
#:system (assoc-ref opts 'system))))
(_ (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)