From: "Ludovic Courtès" <ludo@gnu.org>
To: 37401@debbugs.gnu.org
Cc: "Ludovic Courtès" <ludovic.courtes@inria.fr>
Subject: [bug#37401] [PATCH 1/2] pack: Provide a meaningful "repository name" for Docker.
Date: Fri, 13 Sep 2019 17:51:15 +0200 [thread overview]
Message-ID: <20190913155116.19225-1-ludo@gnu.org> (raw)
In-Reply-To: <20190913154326.19020-1-ludo@gnu.org>
From: Ludovic Courtès <ludovic.courtes@inria.fr>
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'.
---
guix/docker.scm | 43 ++++++++++++++++++++++++++++++-------------
guix/scripts/pack.scm | 13 +++++++++++++
2 files changed, 43 insertions(+), 13 deletions(-)
diff --git a/guix/docker.scm b/guix/docker.scm
index 757bdeb458..97ac6d982b 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -57,22 +57,36 @@
(created . ,time)
(container_config . #nil)))
-(define (generate-tag path)
- "Generate an image tag for the given PATH."
- (match (string-split (basename path) #\-)
- ((hash name . rest) (string-append name ":" hash))))
+(define (canonicalize-repository-name name)
+ "\"Repository\" names are restricted to roughtl [a-z0-9_.-].
+Return a version of TAG that follows these rules."
+ (define ascii-letters
+ (string->char-set "abcdefghijklmnopqrstuvwxyz"))
-(define (manifest path id)
+ (define separators
+ (string->char-set "_-."))
+
+ (define repo-char-set
+ (char-set-union char-set:digit ascii-letters separators))
+
+ (string-map (lambda (chr)
+ (if (char-set-contains? repo-char-set chr)
+ chr
+ #\.))
+ (string-trim (string-downcase name) separators)))
+
+(define* (manifest path id #:optional (tag "guix"))
"Generate a simple image manifest."
- `#(((Config . "config.json")
- (RepoTags . #(,(generate-tag path)))
- (Layers . #(,(string-append id "/layer.tar"))))))
+ (let ((tag (canonicalize-repository-name tag)))
+ `#(((Config . "config.json")
+ (RepoTags . #(,(string-append tag ":latest")))
+ (Layers . #(,(string-append id "/layer.tar")))))))
;; According to the specifications this is required for backwards
;; compatibility. It duplicates information provided by the manifest.
-(define (repositories path id)
+(define* (repositories path id #:optional (tag "guix"))
"Generate a repositories file referencing PATH and the image ID."
- `((,(generate-tag path) . ((latest . ,id)))))
+ `((,(canonicalize-repository-name tag) . ((latest . ,id)))))
;; See https://github.com/opencontainers/image-spec/blob/master/config.md
(define* (config layer time arch #:key entry-point (environment '()))
@@ -112,6 +126,7 @@
(define* (build-docker-image image paths prefix
#:key
+ (repository "guix")
(extra-files '())
(transformations '())
(system (utsname:machine (uname)))
@@ -121,7 +136,9 @@
compressor
(creation-time (current-time time-utc)))
"Write to IMAGE a Docker image archive containing the given PATHS. PREFIX
-must be a store path that is a prefix of any store paths in PATHS.
+must be a store path that is a prefix of any store paths in PATHS. REPOSITORY
+is a descriptive name that will show up in \"REPOSITORY\" column of the output
+of \"docker images\".
When DATABASE is true, copy it to /var/guix/db in the image and create
/var/guix/gcroots and friends.
@@ -243,10 +260,10 @@ SRFI-19 time-utc object, as the creation time in metadata."
#:entry-point entry-point))))
(with-output-to-file "manifest.json"
(lambda ()
- (scm->json (manifest prefix id))))
+ (scm->json (manifest prefix id repository))))
(with-output-to-file "repositories"
(lambda ()
- (scm->json (repositories prefix id)))))
+ (scm->json (repositories prefix id repository)))))
(apply invoke "tar" "-cf" image "-C" directory
`(,@%tar-determinism-options
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index dd91a24284..ed8c177055 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
--
2.23.0
next prev parent reply other threads:[~2019-09-13 15:52 UTC|newest]
Thread overview: 10+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-09-13 15:43 [bug#37401] [PATCH 0/2] 'guix pack -f docker' uses a meaningful "repository name" Ludovic Courtès
2019-09-13 15:51 ` Ludovic Courtès [this message]
2019-09-13 15:51 ` [bug#37401] [PATCH 2/2] pack: Add packages in the order in which they appear on the command line Ludovic Courtès
2019-09-13 16:16 ` Ricardo Wurmus
2019-09-14 9:42 ` Ludovic Courtès
2019-09-18 16:27 ` zimoun
2019-09-18 20:48 ` Ludovic Courtès
2019-09-13 16:18 ` [bug#37401] [PATCH 1/2] pack: Provide a meaningful "repository name" for Docker Ricardo Wurmus
2019-09-14 9:45 ` Ludovic Courtès
2019-09-16 8:59 ` bug#37401: " Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20190913155116.19225-1-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=37401@debbugs.gnu.org \
--cc=ludovic.courtes@inria.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).