[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
09/12: pack: Honor symlinks in the Docker back-end.
From: |
Ludovic Courtès |
Subject: |
09/12: pack: Honor symlinks in the Docker back-end. |
Date: |
Thu, 16 Mar 2017 18:04:24 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 9e84ea3673f77ebe5c5e9ce39fbcdb6d7bc8a06f
Author: Ludovic Courtès <address@hidden>
Date: Thu Mar 16 22:40:06 2017 +0100
pack: Honor symlinks in the Docker back-end.
* guix/docker.scm (symlink-source, topmost-component): New procedures.
(build-docker-image): Add #:symlinks parameter and honor it. Remove
hard-coded /bin symlink.
* guix/scripts/pack.scm (docker-image): Pass #:symlinks to
'build-docker-image'.
---
guix/docker.scm | 46 ++++++++++++++++++++++++++++++++++++----------
guix/scripts/pack.scm | 3 ++-
2 files changed, 38 insertions(+), 11 deletions(-)
diff --git a/guix/docker.scm b/guix/docker.scm
index 9b7a28f..290ad3d 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -21,7 +21,8 @@
#:use-module (guix hash)
#:use-module (guix base16)
#:use-module ((guix build utils)
- #:select (delete-file-recursively
+ #:select (mkdir-p
+ delete-file-recursively
with-directory-excursion))
#:use-module (guix build store-copy)
#:use-module (srfi srfi-19)
@@ -89,14 +90,30 @@
'("--sort=name" "address@hidden"
"--owner=root:0" "--group=root:0"))
+(define symlink-source
+ (match-lambda
+ ((source '-> target)
+ (string-trim source #\/))))
+
+(define (topmost-component file)
+ "Return the topmost component of FILE. For instance, if FILE is \"/a/b/c\",
+return \"a\"."
+ (match (string-tokenize file (char-set-complement (char-set #\/)))
+ ((first rest ...)
+ first)))
+
(define* (build-docker-image image path
#:key closure compressor
+ (symlinks '())
(creation-time (current-time time-utc)))
"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. Use CREATION-TIME, a SRFI-19 time-utc object, as the
-creation time in metadata."
+#:references-graphs). SYMLINKS must be a list of (SOURCE -> TARGET) tuples
+describing symlinks to be created in the image, where each TARGET is relative
+to PATH.
+
+Use COMPRESSOR, a command such as '(\"gzip\" \"-9n\"), to compress IMAGE. Use
+CREATION-TIME, a SRFI-19 time-utc object, as the creation time in metadata."
(let ((directory "/tmp/docker-image") ;temporary working directory
(closure (canonicalize-path closure))
(id (docker-id path))
@@ -110,9 +127,6 @@ creation time in metadata."
(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"
@@ -120,13 +134,25 @@ creation time in metadata."
(with-output-to-file "json"
(lambda () (scm->json (image-description id time))))
- ;; Wrap it up
+ ;; Wrap it up.
(let ((items (call-with-input-file closure
read-reference-graph)))
+ ;; Create SYMLINKS.
+ (for-each (match-lambda
+ ((source '-> target)
+ (let ((source (string-trim source #\/)))
+ (mkdir-p (dirname source))
+ (symlink (string-append path "/" target)
+ source))))
+ symlinks)
+
(and (zero? (apply system* "tar" "-cf" "layer.tar"
(append %tar-determinism-options
- (cons "../bin" items))))
- (delete-file "../bin"))))
+ items
+ (map symlink-source symlinks))))
+ (for-each delete-file-recursively
+ (map (compose topmost-component symlink-source)
+ symlinks)))))
(with-output-to-file "config.json"
(lambda ()
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 694b2f2..edeb82f 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -189,7 +189,7 @@ added to the pack."
"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?.
+ ;; FIXME: Honor LOCALSTATEDIR?.
(define not-config?
(match-lambda
(('guix 'config) #f)
@@ -227,6 +227,7 @@ with COMPRESSOR. It can be passed to 'docker load'."
(build-docker-image #$output #$profile
#:closure "profile"
+ #:symlinks '#$symlinks
#:compressor '#$(compressor-command compressor)
#:creation-time (make-time time-utc 0 1)))))
- branch master updated (2c715a9 -> ad172c4), Ludovic Courtès, 2017/03/16
- 05/12: pack: Honor command-line options related to the store., Ludovic Courtès, 2017/03/16
- 02/12: gexp: Add '=>' syntax to import computed modules., Ludovic Courtès, 2017/03/16
- 03/12: services: connman: Rework service., Ludovic Courtès, 2017/03/16
- 04/12: memoization: Micro-optimize code produced by 'define-cache-procedure'., Ludovic Courtès, 2017/03/16
- 07/12: pack: Use a fixed timestamp in Docker images., Ludovic Courtès, 2017/03/16
- 01/12: utils: Move base16 procedures to (guix base16)., Ludovic Courtès, 2017/03/16
- 09/12: pack: Honor symlinks in the Docker back-end.,
Ludovic Courtès <=
- 11/12: doc: Mention 'guix pack' reproducibility., Ludovic Courtès, 2017/03/16
- 10/12: pack: Allow for "-S /opt/foo="., Ludovic Courtès, 2017/03/16
- 12/12: doc: Reorganize categories., Ludovic Courtès, 2017/03/16
- 06/12: pack: Add '--format' option and Docker output support., Ludovic Courtès, 2017/03/16
- 08/12: docker: Build images in a reproducible fashion., Ludovic Courtès, 2017/03/16