* guix/docker.scm (config): Add #:environment parameter and honor it.
(build-docker-image): Likewise, and pass it to 'config'.
* guix/scripts/pack.scm (docker-image): Import (guix profiles) and (guix
search-paths). Call 'profile-search-paths' and pass #:environment to
'build-docker-image'.
* gnu/tests/docker.scm (run-docker-test)["Load docker image and run it"]:
Add example that expects (json) to be available.
* gnu/tests/docker.scm (build-tarball&run-docker-test): Replace
%BOOTSTRAP-GUILE by GUILE-2.2 and GUILE-JSON in the environment.
---
gnu/tests/docker.scm | 16 ++++++++++------
guix/docker.scm | 17 +++++++++++++----
guix/scripts/pack.scm | 23 +++++++++++++++++++----
3 files changed, 42 insertions(+), 14 deletions(-)
Toggle diff (162 lines)
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index f2674cdbe8..27fde49e75 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -27,7 +27,6 @@
#:use-module (gnu services networking)
#:use-module (gnu services docker)
#:use-module (gnu services desktop)
- #:use-module (gnu packages bootstrap) ; %bootstrap-guile
#:use-module (gnu packages docker)
#:use-module (gnu packages guile)
#:use-module (guix gexp)
@@ -101,7 +100,7 @@ inside %DOCKER-OS."
marionette))
(test-equal "Load docker image and run it"
- '("hello world" "hi!")
+ '("hello world" "hi!" "JSON!")
(marionette-eval
`(begin
(define slurp
@@ -125,8 +124,13 @@ inside %DOCKER-OS."
(response2 (slurp ;default entry point
,(string-append #$docker-cli "/bin/docker")
"run" repository&tag
- "-c" "(display \"hi!\")")))
- (list response1 response2)))
+ "-c" "(display \"hi!\")"))
+ (response3 (slurp ;default entry point + environment
+ ,(string-append #$docker-cli "/bin/docker")
+ "run" repository&tag
+ "-c" "(use-modules (json))
+ (display (json-string->scm (scm->json-string \"JSON!\")))")))
+ (list response1 response2 response3)))
marionette))
(test-end)
@@ -144,7 +148,7 @@ inside %DOCKER-OS."
(version "0")
(source #f)
(build-system trivial-build-system)
- (arguments `(#:guile ,%bootstrap-guile
+ (arguments `(#:guile ,guile-2.2
#:builder
(let ((out (assoc-ref %outputs "out")))
(mkdir out)
@@ -158,7 +162,7 @@ standard output device and then enters a new line.")
(home-page #f)
(license license:public-domain)))
(profile (profile-derivation (packages->manifest
- (list %bootstrap-guile
+ (list guile-2.2 guile-json
guest-script-package))
#:hooks '()
#:locales? #f))
diff --git a/guix/docker.scm b/guix/docker.scm
index 7fe83d9797..b1bd226fa1 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -73,7 +73,7 @@
`((,(generate-tag path) . ((latest . ,id)))))
;; See https://github.com/opencontainers/image-spec/blob/master/config.md
-(define* (config layer time arch #:key entry-point)
+(define* (config layer time arch #:key entry-point (environment '()))
"Generate a minimal image configuration for the given LAYER file."
;; "architecture" must be values matching "platform.arch" in the
;; runtime-spec at
@@ -81,9 +81,13 @@
`((architecture . ,arch)
(comment . "Generated by GNU Guix")
(created . ,time)
- (config . ,(if entry-point
- `((entrypoint . ,entry-point))
- #nil))
+ (config . ,`((env . ,(map (match-lambda
+ ((name . value)
+ (string-append name "=" value)))
+ environment))
+ ,@(if entry-point
+ `((entrypoint . ,entry-point))
+ '())))
(container_config . #nil)
(os . "linux")
(rootfs . ((type . "layers")
@@ -113,6 +117,7 @@ return \"a\"."
(system (utsname:machine (uname)))
database
entry-point
+ (environment '())
compressor
(creation-time (current-time time-utc)))
"Write to IMAGE a Docker image archive containing the given PATHS. PREFIX
@@ -124,6 +129,9 @@ When DATABASE is true, copy it to /var/guix/db in the image and create
When ENTRY-POINT is true, it must be a list of strings; it is stored as the
entry point in the Docker image JSON structure.
+ENVIRONMENT must be a list of name/value pairs. It specifies the environment
+variables that must be defined in the resulting image.
+
SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be
created in the image, where each TARGET is relative to PREFIX.
TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to
@@ -234,6 +242,7 @@ SRFI-19 time-utc object, as the creation time in metadata."
(lambda ()
(scm->json (config (string-append id "/layer.tar")
time arch
+ #:environment environment
#:entry-point entry-point))))
(with-output-to-file "manifest.json"
(lambda ()
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index c90b777222..bb6a8cda1a 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -27,6 +27,7 @@
#:use-module (guix utils)
#:use-module (guix store)
#:use-module ((guix status) #:select (with-status-verbosity))
+ #:use-module ((guix self) #:select (make-config.scm))
#:use-module (guix grafts)
#:autoload (guix inferior) (inferior-package?)
#:use-module (guix monads)
@@ -440,11 +441,24 @@ the image."
(define build
;; Guile-JSON and Guile-Gcrypt are required by (guix docker).
(with-extensions (list guile-json guile-gcrypt)
- (with-imported-modules (source-module-closure '((guix docker)
- (guix build store-copy))
- #:select? not-config?)
+ (with-imported-modules `(((guix config) => ,(make-config.scm))
+ ,@(source-module-closure
+ `((guix docker)
+ (guix build store-copy)
+ (guix profiles)
+ (guix search-paths))
+ #:select? not-config?))
#~(begin
- (use-modules (guix docker) (srfi srfi-19) (guix build store-copy))
+ (use-modules (guix docker) (guix build store-copy)
+ (guix profiles) (guix search-paths)
+ (srfi srfi-19) (ice-9 match))
+
+ (define environment
+ (map (match-lambda
+ ((spec . value)
+ (cons (search-path-specification-variable spec)
+ value)))
+ (profile-search-paths #$profile)))
(setenv "PATH" (string-append #$archiver "/bin"))
@@ -455,6 +469,7 @@ the image."
#$profile
#:database #+database
#:system (or #$target (utsname:machine (uname)))
+ #:environment environment
#:entry-point #$(and entry-point
#~(string-append #$profile "/"
#$entry-point))
--
2.22.0
