[bug#37401] [PATCH 0/2] 'guix pack -f docker' uses a meaningful "repository name"

[bug#37401] [PATCH 0/2] 'guix pack -f docker' uses a meaningful "repository name"

[Ludovic Courtès]

Hello!

This changes ‘guix pack -f docker’ so that the “repository name”
that shows up in the output of ‘docker images’ is more meaningful
than just “profile”, as it was until now (I think it was zimoun
who initially reported that this could be improved. :-)).

Namely, that name is now constructed using the names of the packages
available in the pack.

Thoughts?

Thanks,
Ludo’.

Ludovic Courtès (2):
  pack: Provide a meaningful "repository name" for Docker.
  pack: Add packages in the order in which they appear on the command
    line.

 guix/docker.scm       | 43 ++++++++++++++++++++++++++++++-------------
 guix/scripts/pack.scm | 16 +++++++++++++++-
 2 files changed, 45 insertions(+), 14 deletions(-)

-- 
2.23.0

[bug#37401] [PATCH 1/2] pack: Provide a meaningful "repository name" for Docker.

[Ludovic Courtès]

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

[bug#37401] [PATCH 2/2] pack: Add packages in the order in which they appear on the command line.

[Ludovic Courtès]

* guix/scripts/pack.scm (guix-pack)[manifest-from-args](packages):
Reverse order of packages taken fro OPTS.
---
 guix/scripts/pack.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index ed8c177055..2543f0c0b5 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -957,7 +957,8 @@ Create a bundle of PACKAGE.\n"))
                                   (list (transform store package) output))
                                  ((? package? package)
                                   (list (transform store package) "out")))
-                               (filter-map maybe-package-argument opts)))
+                               (reverse
+                                (filter-map maybe-package-argument opts))))
            (manifest-file (assoc-ref opts 'manifest)))
       (define properties
         (if (assoc-ref opts 'save-provenance?)
-- 
2.23.0

[bug#37401] [PATCH 2/2] pack: Add packages in the order in which they appear on the command line.

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> * guix/scripts/pack.scm (guix-pack)[manifest-from-args](packages):
> Reverse order of packages taken fro OPTS.

Typo: “from”.

> -                               (filter-map maybe-package-argument opts)))
> +                               (reverse
> +                                (filter-map maybe-package-argument opts))))

Why is this necessary?

-- 
Ricardo

[bug#37401] [PATCH 2/2] pack: Add packages in the order in which they appear on the command line.

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> * guix/scripts/pack.scm (guix-pack)[manifest-from-args](packages):
>> Reverse order of packages taken fro OPTS.
>
> Typo: “from”.
>
>> -                               (filter-map maybe-package-argument opts)))
>> +                               (reverse
>> +                                (filter-map maybe-package-argument opts))))
>
> Why is this necessary?

It’s mostly so that if you do ‘guix pack -f docker sed grep findutils’
the repo name is “sed-grep-findutils” and not “findutils-grep-sed”.

Ludo’.

[bug#37401] [PATCH 2/2] pack: Add packages in the order in which they appear on the command line.

[zimoun]

Hi,

That really nice!
Thank you.

On Sat, 14 Sep 2019 at 11:43, Ludovic Courtès <ludo@gnu.org> wrote:

> It’s mostly so that if you do ‘guix pack -f docker sed grep findutils’
> the repo name is “sed-grep-findutils” and not “findutils-grep-sed”.

It is not in the doc, right?
If I want to create a "profile" with a meaningful name, then the order
after '-f' becomes important. Maybe one line explaining, something
like:

(current doc)
The result is a tarball that can be passed to the ‘docker load’ command.
See the Docker documentation
(https://docs.docker.com/engine/reference/commandline/load/) for more
information.
(addition)
Note that the profile name is built using the package names.


Well, and what happens if there is 10 or more packages? Is the name trimmed?


All the best,
simon

[bug#37401] [PATCH 2/2] pack: Add packages in the order in which they appear on the command line.

[Ludovic Courtès]

Hi,

zimoun <zimon.toutoune@gmail.com> skribis:

> On Sat, 14 Sep 2019 at 11:43, Ludovic Courtès <ludo@gnu.org> wrote:
>
>> It’s mostly so that if you do ‘guix pack -f docker sed grep findutils’
>> the repo name is “sed-grep-findutils” and not “findutils-grep-sed”.
>
> It is not in the doc, right?
> If I want to create a "profile" with a meaningful name, then the order
> after '-f' becomes important. Maybe one line explaining, something
> like:
>
> (current doc)
> The result is a tarball that can be passed to the ‘docker load’ command.
> See the Docker documentation
> (https://docs.docker.com/engine/reference/commandline/load/) for more
> information.
> (addition)
> Note that the profile name is built using the package names.

Good idea, I’ve committed something along these lines.

> Well, and what happens if there is 10 or more packages? Is the name trimmed?

Yes, it’s trimmed (there are apparently no hard limits but the output of
“docker images” becomes hard to read if the first column is too wide.)

Ludo’.

[bug#37401] [PATCH 1/2] pack: Provide a meaningful "repository name" for Docker.

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> 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".

This looks good to me, thanks!

Just one thing to note: packages from other channels might have names
with characters outside of a-z.  All of those would show up as dots.

Also, a few package names include numbers, which are probably fine to
include.

--
Ricardo

[bug#37401] [PATCH 1/2] pack: Provide a meaningful "repository name" for Docker.

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> 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".
>
> This looks good to me, thanks!

Cool, thanks for checking!

> Just one thing to note: packages from other channels might have names
> with characters outside of a-z.  All of those would show up as dots.

Yes.

> Also, a few package names include numbers, which are probably fine to
> include.

‘canonical-repository-name’ lets digits through, that’s fine.

Ludo’.

bug#37401: [PATCH 1/2] pack: Provide a meaningful "repository name" for Docker.

[Ludovic Courtès]

Pushed as commit 0074844366381e3056d09492b8b437836c7adb61.

Ludo’.