From patchwork Fri Sep 13 15:51:15 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 15366 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id A67CA173C7; Fri, 13 Sep 2019 17:02:56 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 4F518173C5 for ; Fri, 13 Sep 2019 17:02:56 +0100 (BST) Received: from localhost ([::1]:45736 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i8o2B-0003hT-7N for patchwork@mira.cbaines.net; Fri, 13 Sep 2019 12:02:55 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:57386) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1i8nrh-0001Ag-D8 for guix-patches@gnu.org; Fri, 13 Sep 2019 11:52:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1i8nrf-0001kU-R2 for guix-patches@gnu.org; Fri, 13 Sep 2019 11:52:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:36697) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1i8nrf-0001kO-OI for guix-patches@gnu.org; Fri, 13 Sep 2019 11:52:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1i8nrd-00017f-J6 for guix-patches@gnu.org; Fri, 13 Sep 2019 11:52:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#37401] [PATCH 1/2] pack: Provide a meaningful "repository name" for Docker. References: <20190913154326.19020-1-ludo@gnu.org> In-Reply-To: <20190913154326.19020-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 13 Sep 2019 15:52:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 37401 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 37401@debbugs.gnu.org Received: via spool by 37401-submit@debbugs.gnu.org id=B37401.15683898974280 (code B ref 37401); Fri, 13 Sep 2019 15:52:01 +0000 Received: (at 37401) by debbugs.gnu.org; 13 Sep 2019 15:51:37 +0000 Received: from localhost ([127.0.0.1]:45516 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i8nrE-00016w-Js for submit@debbugs.gnu.org; Fri, 13 Sep 2019 11:51:37 -0400 Received: from eggs.gnu.org ([209.51.188.92]:48849) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1i8nrC-00016d-QQ for 37401@debbugs.gnu.org; Fri, 13 Sep 2019 11:51:35 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:38341) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1i8nr7-0001Wf-9F; Fri, 13 Sep 2019 11:51:29 -0400 Received: from [2001:660:6102:320:e120:2c8f:8909:cdfe] (port=36380 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1i8nr6-0004ew-LX; Fri, 13 Sep 2019 11:51:29 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Fri, 13 Sep 2019 17:51:15 +0200 Message-Id: <20190913155116.19225-1-ludo@gnu.org> X-Mailer: git-send-email 2.23.0 MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches From: Ludovic Courtès 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