diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-08-27 11:02:14 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-08-27 12:20:44 +0200 |
commit | 2b7c89f4fcc5e1607e153939d54d32aeaf494ca9 (patch) | |
tree | 5d3758c60f3c1a7590bab497ea146234d0d09beb /guix/scripts/pack.scm | |
parent | b29d6abc8f0aa7cb358954d7f7a8d7ca49c29eea (diff) |
docker: Take a list of directives instead of a list of symlinks.
* guix/docker.scm (symlink-source, topmost-component): Remove.
(directive-file): New procedure.
(build-docker-image): Remove #:symlinks and add #:extra-files.
Make a sub-directory "extra" and call 'evaluate-populate-directive' for
EXTRA-FILES in that directory.
* guix/scripts/pack.scm (docker-image)[build](symlink->directives,
directives): New procedures.
Pass #:extra-files instead of #:symlinks to 'build-docker-image'.
Diffstat (limited to 'guix/scripts/pack.scm')
-rw-r--r-- | guix/scripts/pack.scm | 20 |
1 files changed, 18 insertions, 2 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 794d2ee390..a15530ad70 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -490,7 +490,8 @@ the image." #~(begin (use-modules (guix docker) (guix build store-copy) (guix profiles) (guix search-paths) - (srfi srfi-19) (ice-9 match)) + (srfi srfi-1) (srfi srfi-19) + (ice-9 match)) (define environment (map (match-lambda @@ -499,6 +500,21 @@ the image." value))) (profile-search-paths #$profile))) + (define symlink->directives + ;; Return "populate directives" to make the given symlink and its + ;; parent directories. + (match-lambda + ((source '-> target) + (let ((target (string-append #$profile "/" target)) + (parent (dirname source))) + `((directory ,parent) + (,source -> ,target)))))) + + (define directives + ;; Fully-qualified symlinks. + (append-map symlink->directives '#$symlinks)) + + (setenv "PATH" (string-append #$archiver "/bin")) (build-docker-image #$output @@ -513,7 +529,7 @@ the image." #$(and entry-point #~(list (string-append #$profile "/" #$entry-point))) - #:symlinks '#$symlinks + #:extra-files directives #:compressor '#$(compressor-command compressor) #:creation-time (make-time time-utc 0 1)))))) |