diff options
author | Ludovic Courtès <ludovic.courtes@inria.fr> | 2019-09-13 17:32:16 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-09-16 10:25:31 +0200 |
commit | 0074844366381e3056d09492b8b437836c7adb61 (patch) | |
tree | e8c52ffdf1be258555b26b85bcec6cce954053e9 /guix/scripts/pack.scm | |
parent | 9bbaf2ae72ce8457702f50277fee908d2c43d13c (diff) |
pack: Provide a meaningful "repository name" for Docker.
Previously, images produced by 'guix pack -f docker' would always show
up as "profile" in the output of 'docker images'. With this change,
'docker images' shows a name constructed from the packages found in the
image--e.g., "bash-coreutils-grep-sed".
* guix/docker.scm (canonicalize-repository-name): New procedure.
(generate-tag): Remove.
(manifest): Add optional 'tag' parameter and honor it.
(repositories): Likewise.
(build-docker-image): Add #:repository parameter and pass it to
'manifest' and 'repositories'.
* guix/scripts/pack.scm (docker-image)[build]: Compute 'tag' and pass it
as #:repository to 'build-docker-image'.
Diffstat (limited to 'guix/scripts/pack.scm')
-rw-r--r-- | guix/scripts/pack.scm | 13 |
1 files changed, 13 insertions, 0 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 055d6c95f5..2543f0c0b5 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -516,6 +516,18 @@ the image." `((directory "/tmp" ,(getuid) ,(getgid) #o1777) ,@(append-map symlink->directives '#$symlinks))) + (define tag + ;; Compute a meaningful "repository" name, which will show up in + ;; the output of "docker images". + (let ((manifest (profile-manifest #$profile))) + (let loop ((names (map manifest-entry-name + (manifest-entries manifest)))) + (define str (string-join names "-")) + (if (< (string-length str) 40) + str + (match names + ((_) str) + ((names ... _) (loop names))))))) ;drop one entry (setenv "PATH" (string-append #$archiver "/bin")) @@ -524,6 +536,7 @@ the image." (call-with-input-file "profile" read-reference-graph)) #$profile + #:repository tag #:database #+database #:system (or #$target (utsname:machine (uname))) #:environment environment |