TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2017-03-16 22:40:06 +01:00
parent 54241dc8e6
commit 9e84ea3673
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 38 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
guix/docker.scm
View File

@ -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" "--mtime=@1"
"--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 ()

3
guix/scripts/pack.scm
View File

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