From 2b7c89f4fcc5e1607e153939d54d32aeaf494ca9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 27 Aug 2019 11:02:14 +0200
Subject: 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'.
---
 guix/scripts/pack.scm | 20 ++++++++++++++++++--
 1 file changed, 18 insertions(+), 2 deletions(-)

(limited to 'guix/scripts/pack.scm')

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))))))
 
-- 
cgit v1.2.3