From d600db91078f28d82324671e3d43acaddc9b9608 Mon Sep 17 00:00:00 2001 From: Ricardo Wurmus 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 "--export-docker-image". * doc/guix.texi (Invoking guix archive): Document it. --- Makefile.am | 1 + doc/guix.texi | 6 +++ guix/docker.scm | 120 +++++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/archive.scm | 11 +++++ 4 files changed, 138 insertions(+) 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 8c65f44da..1dd501261 100644 --- 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. +@item --export-docker-image=@var{directory} +@cindex 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 +@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 new file mode 100644 index 000000000..0f6c3bf90 --- /dev/null +++ b/guix/docker.scm @@ -0,0 +1,120 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ricardo Wurmus +;;; +;;; 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 . + +(define-module (guix docker) + #:use-module (guix hash) + #:use-module (guix store) + #:use-module ((guix build utils) + #:select (delete-file-recursively + with-directory-excursion)) + #:use-module (json) + #:use-module (rnrs bytevectors) + #:export (build-docker-image)) + +(define (hexencode bv) + "Return the hexadecimal representation of the bytevector BV." + (format #f "~{~2,'0x~}" (bytevector->u8-list bv))) + +(define (docker-id path) + "Generate a 256-bit identifier in hexadecimal encoding for the Docker image +containing the closure at PATH." + (hexencode (sha256 (string->utf8 path)))) + +(define (layer-diff-id layer) + "Generate a layer DiffID for the given LAYER archive." + (string-append "sha256:" (hexencode (file-sha256 layer)))) + +(define spec-version "1.0") + +(define (image-description id time) + "Generate a simple image description." + `((id . ,id) + (created . ,time) + (container_config . #nil))) + +(define (manifest id) + "Generate a simple image manifest." + `(((Config . "config.json") + (RepoTags . #nil) + (Layers . (,(string-append id "/layer.tar")))))) + +(define (repositories path id) + "Generate a repositories file referencing PATH and the image ID." + `((,(basename 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))))))) + +;; TODO: heroically copied from guix/script/pull.scm +(define (temporary-directory) + "Make a temporary directory and return its name." + (let ((name (tmpnam))) + (mkdir name) + (chmod name #o700) + name)) + +(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)) + (directory (temporary-directory)) + (time (strftime "%FT%TZ" (localtime (current-time))))) + (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 spec-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 id)))) + (with-output-to-file "repositories" + (lambda () + (scm->json (repositories path id))))) + + (let ((name (string-append (getcwd) + "/docker-image-" (basename path) ".tar"))) + (and (zero? (system* "tar" "-C" directory "-cf" name ".")) + (delete-file-recursively directory) + name)))) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 7e432351e..ffa6e9f44 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 +;;; Copyright © 2017 Ricardo Wurmus ;;; ;;; 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,9 @@ Export/import one or more packages from/to the store.\n")) (display (_ " --export export the specified files/packages to stdout")) (display (_ " + --export-docker-image=DIR + export the specified store item DIR as a Docker image")) + (display (_ " -r, --recursive combined with '--export', include dependencies")) (display (_ " --import import from the archive passed on stdin")) @@ -117,6 +122,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 '("export-docker-image") #t #f + (lambda (opt name arg result . rest) + (alist-cons 'export-docker-image arg result))) (option '(#\r "recursive") #f #f (lambda (opt name arg result) (alist-cons 'export-recursive? #t result))) @@ -328,6 +336,9 @@ the input port." generate-key-pair) ((assoc-ref opts 'authorize) (authorize-key)) + ((assoc-ref opts 'export-docker-image) + => (lambda (item) + (format #t "~a\n" (build-docker-image item)))) (else (with-store store (cond ((assoc-ref opts 'export) -- 2.11.0