GNU bug report logs - #62153
[PATCH 0/2] Add Docker layered image for pack and system

Previous Next

Package: guix-patches;

Reported by: Oleg Pykhalov <go.wigust <at> gmail.com>

Date: Mon, 13 Mar 2023 00:31:02 UTC

Severity: normal

Tags: patch

Done: Oleg Pykhalov <go.wigust <at> gmail.com>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 62153 in the body.
You can then email your comments to 62153 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 13 Mar 2023 00:31:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Oleg Pykhalov <go.wigust <at> gmail.com>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Mon, 13 Mar 2023 00:31:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: guix-patches <at> gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH 0/2] Add Docker layered image for pack and system
Date: Mon, 13 Mar 2023 03:30:12 +0300
Hi Guix,

This patch series add to 'guix pack' and 'guix system image' formats with a
layered Docker image, which dicreases images size by sharing same layers on a
host.

The folling commands show an example for new image formats:

./pre-inst-env guix system image --image-type=docker-layered config.scm
docker load -i result

./pre-inst-env guix pack -f docker --entry-point=bin/bash -S /bin=bin bash hello
docker load -i result

The folloing tests passed:

make check-channel-news
make check TESTS="tests/pack.scm"
make check-system TESTS="docker-system docker-layered-system"

The gnu/packages/aux-files/python/stream-layered-image.py Python script is a
copy of github.com/NixOS/nixpkgs/pkgs/build-support/docker/stream_layered_image.py
with only a simple replacement "/nix" to "/gnu" string.

Oleg Pykhalov (2):
  guix: docker: Build layered image.
  news: Add entry for the new 'docker-layered' distribution format.

 Makefile.am                                   |   3 +-
 doc/guix.texi                                 |  16 +-
 etc/news.scm                                  |  38 ++
 gnu/image.scm                                 |   3 +-
 .../aux-files/python/stream-layered-image.py  | 391 ++++++++++++++++++
 gnu/system/image.scm                          |  84 +++-
 gnu/tests/docker.scm                          |  20 +-
 guix/docker.scm                               | 182 ++++++--
 guix/scripts/pack.scm                         | 103 +++--
 guix/scripts/system.scm                       |  11 +-
 tests/pack.scm                                |  48 +++
 11 files changed, 813 insertions(+), 86 deletions(-)
 create mode 100644 gnu/packages/aux-files/python/stream-layered-image.py


base-commit: 60a211ec705ac98483d76da7f2523f2b8966343a
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 13 Mar 2023 00:34:02 GMT) Full text and rfc822 format available.

Message #8 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH 1/2] guix: docker: Build layered image.
Date: Mon, 13 Mar 2023 03:33:09 +0300
* gnu/packages/aux-files/python/stream-layered-image.py: New file.
* Makefile.am (AUX_FILES): Add this.
* guix/docker.scm (%docker-image-max-layers): New variable.
(build-docker-image)[stream-layered-image, root-system]: New arguments.
* guix/scripts/pack.scm (stream-layered-image.py): New variable.
(docker-image)[layered-image?]: New argument.
(docker-layered-image): New procedure.
(%formats)[docker-layered]: New format.
(show-formats): Document this.
* tests/pack.scm: Add docker-layered-image + localstatedir test.
* guix/scripts/system.scm
(system-derivation-for-action)[docker-layered-image]: New action.
(show-help): Document this.
(actions)[docker-layered-image]: New action.
(process-action): Add this.
* gnu/system/image.scm (docker-layered-image, docker-layered-image-type): New
variables.
(system-docker-image)[layered-image?]: New argument.
(stream-layered-image.py): New variable.
(system-docker-layered-image): New procedure.
(image->root-file-system)[docker-layered]: New image format.
* gnu/tests/docker.scm (%test-docker-layered-system): New test.
* gnu/image.scm (validate-image-format)[docker-layered]: New image format.
* doc/guix.texi (Invoking guix pack): Document docker-layered format.
(image-type Reference): Document docker-layered-image-type.
---
 Makefile.am                                   |   3 +-
 doc/guix.texi                                 |  16 +-
 gnu/image.scm                                 |   3 +-
 .../aux-files/python/stream-layered-image.py  | 391 ++++++++++++++++++
 gnu/system/image.scm                          |  84 +++-
 gnu/tests/docker.scm                          |  20 +-
 guix/docker.scm                               | 182 ++++++--
 guix/scripts/pack.scm                         | 103 +++--
 guix/scripts/system.scm                       |  11 +-
 tests/pack.scm                                |  48 +++
 10 files changed, 775 insertions(+), 86 deletions(-)
 create mode 100644 gnu/packages/aux-files/python/stream-layered-image.py

diff --git a/Makefile.am b/Makefile.am
index 23b939b674..9aca84f8f8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -11,7 +11,7 @@
 # Copyright © 2017 Arun Isaac <arunisaac <at> systemreboot.net>
 # Copyright © 2018 Nikita <nikita <at> n0.is>
 # Copyright © 2018 Julien Lepiller <julien <at> lepiller.eu>
-# Copyright © 2018 Oleg Pykhalov <go.wigust <at> gmail.com>
+# Copyright © 2018, 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 # Copyright © 2018 Alex Vong <alexvong1995 <at> gmail.com>
 # Copyright © 2019 Efraim Flashner <efraim <at> flashner.co.il>
 # Copyright © 2021 Chris Marusich <cmmarusich <at> gmail.com>
@@ -435,6 +435,7 @@ AUX_FILES =						\
   gnu/packages/aux-files/python/sanity-check.py		\
   gnu/packages/aux-files/python/sanity-check-next.py	\
   gnu/packages/aux-files/python/sitecustomize.py	\
+  gnu/packages/aux-files/python/stream-layered-image.py	\
   gnu/packages/aux-files/renpy/renpy.in	\
   gnu/packages/aux-files/run-in-namespace.c
 
diff --git a/doc/guix.texi b/doc/guix.texi
index b545751e1b..bd0ee126ee 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -56,7 +56,7 @@ Copyright @copyright{} 2017 Andy Wingo@*
 Copyright @copyright{} 2017, 2018, 2019, 2020 Arun Isaac@*
 Copyright @copyright{} 2017 nee@*
 Copyright @copyright{} 2018 Rutger Helling@*
-Copyright @copyright{} 2018, 2021 Oleg Pykhalov@*
+Copyright @copyright{} 2018, 2021, 2023 Oleg Pykhalov@*
 Copyright @copyright{} 2018 Mike Gerwitz@*
 Copyright @copyright{} 2018 Pierre-Antoine Rouby@*
 Copyright @copyright{} 2018, 2019 Gábor Boskovits@*
@@ -6840,9 +6840,15 @@ the following command:
 guix pack -f docker -S /bin=bin guile guile-readline
 @end example
 
+or
+
+@example
+guix pack -f docker-layered -S /bin=bin guile guile-readline
+@end example
+
 @noindent
-The result is a tarball that can be passed to the @command{docker load}
-command, followed by @code{docker run}:
+The result is a tarball with image or layered image that can be passed
+to the @command{docker load} command, followed by @code{docker run}:
 
 @example
 docker load < @var{file}
@@ -43631,6 +43637,10 @@ Build an image based on the @code{iso9660-image} image but with the
 Build an image based on the @code{docker-image} image.
 @end defvar
 
+@defvar docker-layered-image-type
+Build a layered image based on the @code{docker-layered-image} image.
+@end defvar
+
 @defvar raw-with-offset-image-type
 Build an MBR image with a single partition starting at a @code{1024KiB}
 offset.  This is useful to leave some room to install a bootloader in
diff --git a/gnu/image.scm b/gnu/image.scm
index 523653dd77..8a6a0d8479 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -152,7 +153,7 @@ (define-with-syntax-properties (name (value properties))
 
 ;; The supported image formats.
 (define-set-sanitizer validate-image-format format
-  (disk-image compressed-qcow2 docker iso9660 tarball wsl2))
+  (disk-image compressed-qcow2 docker docker-layered iso9660 tarball wsl2))
 
 ;; The supported partition table types.
 (define-set-sanitizer validate-partition-table-type partition-table-type
diff --git a/gnu/packages/aux-files/python/stream-layered-image.py b/gnu/packages/aux-files/python/stream-layered-image.py
new file mode 100644
index 0000000000..9ad2168c2d
--- /dev/null
+++ b/gnu/packages/aux-files/python/stream-layered-image.py
@@ -0,0 +1,391 @@
+"""
+This script generates a Docker image from a set of store paths. Uses
+Docker Image Specification v1.2 as reference [1].
+
+It expects a JSON file with the following properties and writes the
+image as an uncompressed tarball to stdout:
+
+* "architecture", "config", "os", "created", "repo_tag" correspond to
+  the fields with the same name on the image spec [2].
+* "created" can be "now".
+* "created" is also used as mtime for files added to the image.
+* "store_layers" is a list of layers in ascending order, where each
+  layer is the list of store paths to include in that layer.
+
+The main challenge for this script to create the final image in a
+streaming fashion, without dumping any intermediate data to disk
+for performance.
+
+A docker image has each layer contents archived as separate tarballs,
+and they later all get enveloped into a single big tarball in a
+content addressed fashion. However, because how "tar" format works,
+we have to know about the name (which includes the checksum in our
+case) and the size of the tarball before we can start adding it to the
+outer tarball.  We achieve that by creating the layer tarballs twice;
+on the first iteration we calculate the file size and the checksum,
+and on the second one we actually stream the contents. 'add_layer_dir'
+function does all this.
+
+[1]: https://github.com/moby/moby/blob/master/image/spec/v1.2.md
+[2]: https://github.com/moby/moby/blob/4fb59c20a4fb54f944fe170d0ff1d00eb4a24d6f/image/spec/v1.2.md#image-json-field-descriptions
+"""  # noqa: E501
+
+
+import io
+import os
+import re
+import sys
+import json
+import hashlib
+import pathlib
+import tarfile
+import itertools
+import threading
+from datetime import datetime, timezone
+from collections import namedtuple
+
+
+def archive_paths_to(obj, paths, mtime):
+    """
+    Writes the given store paths as a tar file to the given stream.
+
+    obj: Stream to write to. Should have a 'write' method.
+    paths: List of store paths.
+    """
+
+    # gettarinfo makes the paths relative, this makes them
+    # absolute again
+    def append_root(ti):
+        ti.name = "/" + ti.name
+        return ti
+
+    def apply_filters(ti):
+        ti.mtime = mtime
+        ti.uid = 0
+        ti.gid = 0
+        ti.uname = "root"
+        ti.gname = "root"
+        return ti
+
+    def nix_root(ti):
+        ti.mode = 0o0555  # r-xr-xr-x
+        return ti
+
+    def dir(path):
+        ti = tarfile.TarInfo(path)
+        ti.type = tarfile.DIRTYPE
+        return ti
+
+    with tarfile.open(fileobj=obj, mode="w|") as tar:
+        # To be consistent with the docker utilities, we need to have
+        # these directories first when building layer tarballs.
+        tar.addfile(apply_filters(nix_root(dir("/gnu"))))
+        tar.addfile(apply_filters(nix_root(dir("/gnu/store"))))
+
+        for path in paths:
+            path = pathlib.Path(path)
+            if path.is_symlink():
+                files = [path]
+            else:
+                files = itertools.chain([path], path.rglob("*"))
+
+            for filename in sorted(files):
+                ti = append_root(tar.gettarinfo(filename))
+
+                # copy hardlinks as regular files
+                if ti.islnk():
+                    ti.type = tarfile.REGTYPE
+                    ti.linkname = ""
+                    ti.size = filename.stat().st_size
+
+                ti = apply_filters(ti)
+                if ti.isfile():
+                    with open(filename, "rb") as f:
+                        tar.addfile(ti, f)
+                else:
+                    tar.addfile(ti)
+
+
+class ExtractChecksum:
+    """
+    A writable stream which only calculates the final file size and
+    sha256sum, while discarding the actual contents.
+    """
+
+    def __init__(self):
+        self._digest = hashlib.sha256()
+        self._size = 0
+
+    def write(self, data):
+        self._digest.update(data)
+        self._size += len(data)
+
+    def extract(self):
+        """
+        Returns: Hex-encoded sha256sum and size as a tuple.
+        """
+        return (self._digest.hexdigest(), self._size)
+
+
+FromImage = namedtuple("FromImage", ["tar", "manifest_json", "image_json"])
+# Some metadata for a layer
+LayerInfo = namedtuple("LayerInfo", ["size", "checksum", "path", "paths"])
+
+
+def load_from_image(from_image_str):
+    """
+    Loads the given base image, if any.
+
+    from_image_str: Path to the base image archive.
+
+    Returns: A 'FromImage' object with references to the loaded base image,
+             or 'None' if no base image was provided.
+    """
+    if from_image_str is None:
+        return None
+
+    base_tar = tarfile.open(from_image_str)
+
+    manifest_json_tarinfo = base_tar.getmember("manifest.json")
+    with base_tar.extractfile(manifest_json_tarinfo) as f:
+        manifest_json = json.load(f)
+
+    image_json_tarinfo = base_tar.getmember(manifest_json[0]["Config"])
+    with base_tar.extractfile(image_json_tarinfo) as f:
+        image_json = json.load(f)
+
+    return FromImage(base_tar, manifest_json, image_json)
+
+
+def add_base_layers(tar, from_image):
+    """
+    Adds the layers from the given base image to the final image.
+
+    tar: 'tarfile.TarFile' object for new layers to be added to.
+    from_image: 'FromImage' object with references to the loaded base image.
+    """
+    if from_image is None:
+        print("No 'fromImage' provided", file=sys.stderr)
+        return []
+
+    layers = from_image.manifest_json[0]["Layers"]
+    checksums = from_image.image_json["rootfs"]["diff_ids"]
+    layers_checksums = zip(layers, checksums)
+
+    for num, (layer, checksum) in enumerate(layers_checksums, start=1):
+        layer_tarinfo = from_image.tar.getmember(layer)
+        checksum = re.sub(r"^sha256:", "", checksum)
+
+        tar.addfile(layer_tarinfo, from_image.tar.extractfile(layer_tarinfo))
+        path = layer_tarinfo.path
+        size = layer_tarinfo.size
+
+        print("Adding base layer", num, "from", path, file=sys.stderr)
+        yield LayerInfo(size=size, checksum=checksum, path=path, paths=[path])
+
+    from_image.tar.close()
+
+
+def overlay_base_config(from_image, final_config):
+    """
+    Overlays the final image 'config' JSON on top of selected defaults from the
+    base image 'config' JSON.
+
+    from_image: 'FromImage' object with references to the loaded base image.
+    final_config: 'dict' object of the final image 'config' JSON.
+    """
+    if from_image is None:
+        return final_config
+
+    base_config = from_image.image_json["config"]
+
+    # Preserve environment from base image
+    final_env = base_config.get("Env", []) + final_config.get("Env", [])
+    if final_env:
+        # Resolve duplicates (last one wins) and format back as list
+        resolved_env = {entry.split("=", 1)[0]: entry for entry in final_env}
+        final_config["Env"] = list(resolved_env.values())
+    return final_config
+
+
+def add_layer_dir(tar, paths, store_dir, mtime):
+    """
+    Appends given store paths to a TarFile object as a new layer.
+
+    tar: 'tarfile.TarFile' object for the new layer to be added to.
+    paths: List of store paths.
+    store_dir: the root directory of the nix store
+    mtime: 'mtime' of the added files and the layer tarball.
+           Should be an integer representing a POSIX time.
+
+    Returns: A 'LayerInfo' object containing some metadata of
+             the layer added.
+    """
+
+    invalid_paths = [i for i in paths if not i.startswith(store_dir)]
+    assert len(invalid_paths) == 0, \
+        f"Expecting absolute paths from {store_dir}, but got: {invalid_paths}"
+
+    # First, calculate the tarball checksum and the size.
+    extract_checksum = ExtractChecksum()
+    archive_paths_to(
+        extract_checksum,
+        paths,
+        mtime=mtime,
+    )
+    (checksum, size) = extract_checksum.extract()
+
+    path = f"{checksum}/layer.tar"
+    layer_tarinfo = tarfile.TarInfo(path)
+    layer_tarinfo.size = size
+    layer_tarinfo.mtime = mtime
+
+    # Then actually stream the contents to the outer tarball.
+    read_fd, write_fd = os.pipe()
+    with open(read_fd, "rb") as read, open(write_fd, "wb") as write:
+        def producer():
+            archive_paths_to(
+                write,
+                paths,
+                mtime=mtime,
+            )
+            write.close()
+
+        # Closing the write end of the fifo also closes the read end,
+        # so we don't need to wait until this thread is finished.
+        #
+        # Any exception from the thread will get printed by the default
+        # exception handler, and the 'addfile' call will fail since it
+        # won't be able to read required amount of bytes.
+        threading.Thread(target=producer).start()
+        tar.addfile(layer_tarinfo, read)
+
+    return LayerInfo(size=size, checksum=checksum, path=path, paths=paths)
+
+
+def add_customisation_layer(target_tar, customisation_layer, mtime):
+    """
+    Adds the customisation layer as a new layer. This is layer is structured
+    differently; given store path has the 'layer.tar' and corresponding
+    sha256sum ready.
+
+    tar: 'tarfile.TarFile' object for the new layer to be added to.
+    customisation_layer: Path containing the layer archive.
+    mtime: 'mtime' of the added layer tarball.
+    """
+
+    checksum_path = os.path.join(customisation_layer, "checksum")
+    with open(checksum_path) as f:
+        checksum = f.read().strip()
+    assert len(checksum) == 64, f"Invalid sha256 at ${checksum_path}."
+
+    layer_path = os.path.join(customisation_layer, "layer.tar")
+
+    path = f"{checksum}/layer.tar"
+    tarinfo = target_tar.gettarinfo(layer_path)
+    tarinfo.name = path
+    tarinfo.mtime = mtime
+
+    with open(layer_path, "rb") as f:
+        target_tar.addfile(tarinfo, f)
+
+    return LayerInfo(
+      size=None,
+      checksum=checksum,
+      path=path,
+      paths=[customisation_layer]
+    )
+
+
+def add_bytes(tar, path, content, mtime):
+    """
+    Adds a file to the tarball with given path and contents.
+
+    tar: 'tarfile.TarFile' object.
+    path: Path of the file as a string.
+    content: Contents of the file.
+    mtime: 'mtime' of the file. Should be an integer representing a POSIX time.
+    """
+    assert type(content) is bytes
+
+    ti = tarfile.TarInfo(path)
+    ti.size = len(content)
+    ti.mtime = mtime
+    tar.addfile(ti, io.BytesIO(content))
+
+
+def main():
+    with open(sys.argv[1], "r") as f:
+        conf = json.load(f)
+
+    created = (
+      datetime.now(tz=timezone.utc)
+      if conf["created"] == "now"
+      else datetime.fromisoformat(conf["created"])
+    )
+    mtime = int(created.timestamp())
+    store_dir = conf["store_dir"]
+
+    from_image = load_from_image(conf["from_image"])
+
+    with tarfile.open(mode="w|", fileobj=sys.stdout.buffer) as tar:
+        layers = []
+        layers.extend(add_base_layers(tar, from_image))
+
+        start = len(layers) + 1
+        for num, store_layer in enumerate(conf["store_layers"], start=start):
+            print("Creating layer", num, "from paths:", store_layer,
+                  file=sys.stderr)
+            info = add_layer_dir(tar, store_layer, store_dir, mtime=mtime)
+            layers.append(info)
+
+        print("Creating layer", len(layers) + 1, "with customisation...",
+              file=sys.stderr)
+        layers.append(
+          add_customisation_layer(
+            tar,
+            conf["customisation_layer"],
+            mtime=mtime
+          )
+        )
+
+        print("Adding manifests...", file=sys.stderr)
+
+        image_json = {
+            "created": datetime.isoformat(created),
+            "architecture": conf["architecture"],
+            "os": "linux",
+            "config": overlay_base_config(from_image, conf["config"]),
+            "rootfs": {
+                "diff_ids": [f"sha256:{layer.checksum}" for layer in layers],
+                "type": "layers",
+            },
+            "history": [
+                {
+                  "created": datetime.isoformat(created),
+                  "comment": f"store paths: {layer.paths}"
+                }
+                for layer in layers
+            ],
+        }
+
+        image_json = json.dumps(image_json, indent=4).encode("utf-8")
+        image_json_checksum = hashlib.sha256(image_json).hexdigest()
+        image_json_path = f"{image_json_checksum}.json"
+        add_bytes(tar, image_json_path, image_json, mtime=mtime)
+
+        manifest_json = [
+            {
+                "Config": image_json_path,
+                "RepoTags": [conf["repo_tag"]],
+                "Layers": [layer.path for layer in layers],
+            }
+        ]
+        manifest_json = json.dumps(manifest_json, indent=4).encode("utf-8")
+        add_bytes(tar, "manifest.json", manifest_json, mtime=mtime)
+
+        print("Done.", file=sys.stderr)
+
+
+if __name__ == "__main__":
+    main()
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index afef79185f..0bfd011ad4 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2022 Pavel Shlyak <p.shlyak <at> pantherx.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo <at> cyberdimension.org>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -45,6 +46,7 @@ (define-module (gnu system image)
   #:use-module (gnu system uuid)
   #:use-module (gnu system vm)
   #:use-module (guix packages)
+  #:use-module ((gnu packages) #:select (search-auxiliary-file))
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages bootloaders)
@@ -58,6 +60,7 @@ (define-module (gnu system image)
   #:use-module (gnu packages hurd)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages mtools)
+  #:use-module (gnu packages python)
   #:use-module (gnu packages virtualization)
   #:use-module ((srfi srfi-1) #:prefix srfi-1:)
   #:use-module (srfi srfi-11)
@@ -78,6 +81,7 @@ (define-module (gnu system image)
             efi-disk-image
             iso9660-image
             docker-image
+            docker-layered-image
             tarball-image
             wsl2-image
             raw-with-offset-disk-image
@@ -89,6 +93,7 @@ (define-module (gnu system image)
             iso-image-type
             uncompressed-iso-image-type
             docker-image-type
+            docker-layered-image-type
             tarball-image-type
             wsl2-image-type
             raw-with-offset-image-type
@@ -167,6 +172,10 @@ (define docker-image
   (image-without-os
    (format 'docker)))
 
+(define docker-layered-image
+  (image-without-os
+   (format 'docker-layered)))
+
 (define tarball-image
   (image-without-os
    (format 'tarball)))
@@ -237,6 +246,11 @@ (define docker-image-type
    (name 'docker)
    (constructor (cut image-with-os docker-image <>))))
 
+(define docker-layered-image-type
+  (image-type
+   (name 'docker-layered)
+   (constructor (cut image-with-os docker-layered-image <>))))
+
 (define tarball-image-type
   (image-type
    (name 'tarball)
@@ -633,9 +647,12 @@ (define (image-with-label base-image label)
 
 (define* (system-docker-image image
                               #:key
-                              (name "docker-image"))
+                              (name "docker-image")
+                              (archiver tar)
+                              layered-image?)
   "Build a docker image for IMAGE.  NAME is the base name to use for the
-output file."
+output file.  If LAYERED-IMAGE? is true, the image will with many of the store
+paths being on their own layer to improve sharing between images."
   (define boot-program
     ;; Program that runs the boot script of OS, which in turn starts shepherd.
     (program-file "boot-program"
@@ -678,9 +695,11 @@ (define builder
               (use-modules (guix docker)
                            (guix build utils)
                            (gnu build image)
+                           (srfi srfi-1)
                            (srfi srfi-19)
                            (guix build store-copy)
-                           (guix store database))
+                           (guix store database)
+                           (ice-9 receive))
 
               ;; Set the SQL schema location.
               (sql-schema #$schema)
@@ -700,18 +719,34 @@ (define builder
                                            #:register-closures? #$register-closures?
                                            #:deduplicate? #f
                                            #:system-directory #$os)
-                (build-docker-image
-                 #$output
-                 (cons* image-root
-                        (map store-info-item
-                             (call-with-input-file #$graph
-                               read-reference-graph)))
-                 #$os
-                 #:entry-point '(#$boot-program #$os)
-                 #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
-                 #:creation-time (make-time time-utc 0 1)
-                 #:system #$image-target
-                 #:transformations `((,image-root -> ""))))))))
+                (when #$layered-image?
+                  (setenv "PATH"
+                          (string-join (list #+(file-append archiver "/bin")
+                                             #+(file-append coreutils "/bin")
+                                             #+(file-append gzip "/bin")
+                                             #+(file-append python "/bin"))
+                                       ":")))
+                (apply build-docker-image
+                       (append (list #$output
+                                     (append (if #$layered-image?
+                                                 '()
+                                                 (list image-root))
+                                             (map store-info-item
+                                                  (call-with-input-file #$graph
+                                                    read-reference-graph)))
+                                     #$os
+                                     #:entry-point '(#$boot-program #$os)
+                                     #:compressor
+                                     '(#+(file-append gzip "/bin/gzip") "-9n")
+                                     #:creation-time (make-time time-utc 0 1)
+                                     #:system #$image-target
+                                     #:transformations `((,image-root -> "")))
+                               (if #$layered-image?
+                                   (list #:root-system
+                                         image-root
+                                         #:stream-layered-image
+                                         #$stream-layered-image.py)
+                                   '()))))))))
 
     (computed-file name builder
                    ;; Allow offloading so that this I/O-intensive process
@@ -720,6 +755,21 @@ (define builder
                    #:options `(#:references-graphs ((,graph ,os))
                                #:substitutable? ,substitutable?))))
 
+(define stream-layered-image.py
+  (local-file (search-auxiliary-file "python/stream-layered-image.py")))
+
+(define* (system-docker-layered-image image
+                                      #:key
+                                      (name "docker-image")
+                                      (archiver tar)
+                                      (layered-image? #t))
+  "Build a docker image for IMAGE.  NAME is the base name to use for the
+output file."
+  (system-docker-image image
+                       #:name name
+                       #:archiver archiver
+                       #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Tarball image.
@@ -811,7 +861,7 @@ (define (image->root-file-system image)
   "Return the IMAGE root partition file-system type."
   (case (image-format image)
     ((iso9660) "iso9660")
-    ((docker tarball wsl2) "dummy")
+    ((docker docker-layered tarball wsl2) "dummy")
     (else
      (partition-file-system (find-root-partition image)))))
 
@@ -948,6 +998,8 @@ (define target (cond
                                        ("bootcfg" ,bootcfg))))
        ((memq image-format '(docker))
         (system-docker-image image*))
+       ((memq image-format '(docker-layered))
+        (system-docker-layered-image image*))
        ((memq image-format '(tarball))
         (system-tarball-image image*))
        ((memq image-format '(wsl2))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 0276e398a7..85c5f178b5 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
 ;;; Copyright © 2019-2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,7 +44,8 @@ (define-module (gnu tests docker)
   #:use-module (guix build-system trivial)
   #:use-module ((guix licenses) #:prefix license:)
   #:export (%test-docker
-            %test-docker-system))
+            %test-docker-system
+            %test-docker-layered-system))
 
 (define %docker-os
   (simple-operating-system
@@ -309,3 +311,19 @@ (define %test-docker-system
                                    (locale-libcs (list glibc)))
                                  #:type docker-image-type)))
                  run-docker-system-test)))))
+
+(define %test-docker-layered-system
+  (system-test
+   (name "docker-layered-system")
+   (description "Run a system image as produced by @command{guix system
+docker-layered-image} inside Docker.")
+   (value (with-monad %store-monad
+            (>>= (lower-object
+                  (system-image (os->image
+                                 (operating-system
+                                   (inherit (simple-operating-system))
+                                   ;; Use locales for a single libc to
+                                   ;; reduce space requirements.
+                                   (locale-libcs (list glibc)))
+                                 #:type docker-layered-image-type)))
+                 run-docker-system-test)))))
diff --git a/guix/docker.scm b/guix/docker.scm
index 5e6460f43f..f1adad26dc 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich <at> gmail.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,10 +25,14 @@ (define-module (guix docker)
   #:use-module (guix base16)
   #:use-module (guix build pack)
   #:use-module ((guix build utils)
-                #:select (mkdir-p
+                #:select (%store-directory
+                          mkdir-p
                           delete-file-recursively
+                          dump-port
                           with-directory-excursion
                           invoke))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (gnu build install)
   #:use-module (json)                             ;guile-json
   #:use-module (srfi srfi-1)
@@ -38,6 +43,9 @@ (define-module (guix docker)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
   #:export (build-docker-image))
 
 ;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image.
@@ -136,6 +144,9 @@ (define directive-file
     (('directory name _ ...)
      (string-trim name #\/))))
 
+(define %docker-image-max-layers
+  100)
+
 (define* (build-docker-image image paths prefix
                              #:key
                              (repository "guix")
@@ -146,11 +157,13 @@ (define* (build-docker-image image paths prefix
                              entry-point
                              (environment '())
                              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.  REPOSITORY
-is a descriptive name that will show up in \"REPOSITORY\" column of the output
-of \"docker images\".
+                             (creation-time (current-time time-utc))
+                             stream-layered-image
+                             root-system)
+  "Write to IMAGE a layerer Docker image archive containing the given PATHS.
+PREFIX 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.
@@ -172,7 +185,13 @@ (define* (build-docker-image image paths prefix
 SYSTEM is a GNU triplet (or prefix thereof) of the system the binaries in
 PATHS are for; it is used to produce metadata in the image.  Use COMPRESSOR, a
 command such as '(\"gzip\" \"-9n\"), to compress IMAGE.  Use CREATION-TIME, a
-SRFI-19 time-utc object, as the creation time in metadata."
+SRFI-19 time-utc object, as the creation time in metadata.
+
+STREAM-LAYERED-IMAGE is a Python script which accepts a JSON configuration
+file and prints archive to STDOUT.
+
+ROOT-SYSTEM is a directory with a provisioned root file system, which will be
+added to image as a layer."
   (define (sanitize path-fragment)
     (escape-special-chars
      ;; GNU tar strips the leading slash off of absolute paths before applying
@@ -183,6 +202,39 @@ (define (sanitize path-fragment)
      ;; We also need to escape "/" because we use it as a delimiter.
      "/*.^$[]\\"
      #\\))
+  (define (file-sha256 file-name)
+    "Calculate the hexdigest of the sha256 checksum of FILE-NAME and return it."
+    (let ((port (open-pipe* OPEN_READ
+                            "sha256sum"
+                            "--"
+                            file-name)))
+      (let ((result (read-delimited " " port)))
+        (close-pipe port)
+        result)))
+  (define (paths-split-sort paths)
+    "Split list of PATHS at %DOCKER-IMAGE-MAX-LAYERS and sort by disk usage."
+    (let* ((paths-length (length paths))
+           (port (apply open-pipe* OPEN_READ
+                        (append '("du" "--summarize") paths)))
+           (output (read-string port)))
+      (close-port port)
+      (receive (head tail)
+          (split-at
+           (map (match-lambda ((size . path) path))
+                (sort (map (lambda (line)
+                             (match (string-split line #\tab)
+                               ((size path)
+                                (cons (string->number size) path))))
+                           (string-split
+                            (string-trim-right output #\newline)
+                            #\newline))
+                      (lambda (path1 path2)
+                        (< (match path2 ((size . _) size))
+                           (match path1 ((size . _) size))))))
+           (if (>= paths-length %docker-image-max-layers)
+               (- %docker-image-max-layers 2)
+               (1- paths-length)))
+        (list head tail))))
   (define transformation->replacement
     (match-lambda
       ((old '-> new)
@@ -205,7 +257,9 @@ (define transformation-options
         `("--transform" ,(transformations->expression transformations))))
   (let* ((directory "/tmp/docker-image") ;temporary working directory
          (id (docker-id prefix))
-         (time (date->string (time-utc->date creation-time) "~4"))
+         (time ;Workaround for Python datetime.fromisoformat does not parse Z.
+          (string-append (date->string (time-utc->date creation-time) "~5")
+                         "+00:00"))
          (arch (let-syntax ((cond* (syntax-rules ()
                                      ((_ (pattern clause) ...)
                                       (cond ((string-prefix? pattern system)
@@ -218,7 +272,8 @@ (define transformation-options
                         ("i686"    "386")
                         ("arm"     "arm")
                         ("aarch64" "arm64")
-                        ("mips64"  "mips64le")))))
+                        ("mips64"  "mips64le"))))
+         (paths (if stream-layered-image (paths-split-sort paths) paths)))
     ;; Make sure we start with a fresh, empty working directory.
     (mkdir directory)
     (with-directory-excursion directory
@@ -229,26 +284,38 @@ (define transformation-options
         (with-output-to-file "json"
           (lambda () (scm->json (image-description id time))))
 
-        ;; Create a directory for the non-store files that need to go into the
-        ;; archive.
-        (mkdir "extra")
+        (if root-system
+            (let ((directory (getcwd)))
+              (with-directory-excursion root-system
+                (apply invoke "tar"
+                       "-cf" (string-append directory "/layer.tar")
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." "..")))))))))
+            (begin
+              ;; Create a directory for the non-store files that need to go
+              ;; into the archive.
+              (mkdir "extra")
 
-        (with-directory-excursion "extra"
-          ;; Create non-store files.
-          (for-each (cut evaluate-populate-directive <> "./")
-                    extra-files)
+              (with-directory-excursion "extra"
+                ;; Create non-store files.
+                (for-each (cut evaluate-populate-directive <> "./")
+                          extra-files)
 
-          (when database
-            ;; Initialize /var/guix, assuming PREFIX points to a profile.
-            (install-database-and-gc-roots "." database prefix))
+                (when database
+                  ;; Initialize /var/guix, assuming PREFIX points to a profile.
+                  (install-database-and-gc-roots "." database prefix))
 
-          (apply invoke "tar" "-cf" "../layer.tar"
-                 `(,@transformation-options
-                   ,@(tar-base-options)
-                   ,@paths
-                   ,@(scandir "."
-                              (lambda (file)
-                                (not (member file '("." ".."))))))))
+                (apply invoke "tar" "-cf" "../layer.tar"
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(if stream-layered-image '() paths)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." ".."))))))))
+              (delete-file-recursively "extra")))
 
         ;; It is possible for "/" to show up in the archive, especially when
         ;; applying transformations.  For example, the transformation
@@ -263,22 +330,65 @@ (define transformation-options
           (lambda ()
             (system* "tar" "--delete" "/" "-f" "layer.tar")))
 
-        (delete-file-recursively "extra"))
+        (when stream-layered-image
+          (call-with-output-file "checksum"
+            (lambda (port)
+              (display (file-sha256 "layer.tar") port)))))
 
       (with-output-to-file "config.json"
         (lambda ()
-          (scm->json (config (string-append id "/layer.tar")
-                             time arch
-                             #:environment environment
-                             #:entry-point entry-point))))
+          (scm->json
+           (if stream-layered-image
+               `(("created" . ,time)
+                 ("repo_tag" . "guix:latest")
+                 ("customisation_layer" . ,id)
+                 ("store_layers" . ,(match paths
+                                      (((head ...) (tail ...))
+                                       (list->vector
+                                        (reverse
+                                         (cons (list->vector tail)
+                                               (fold (lambda (path paths)
+                                                       (cons (vector path) paths))
+                                                     '()
+                                                     head)))))))
+                 ("store_dir" . ,(%store-directory))
+                 ("from_image" . #nil)
+                 ("os" . "linux")
+                 ("config"
+                  (env . ,(list->vector (map (match-lambda
+                                               ((name . value)
+                                                (string-append name "=" value)))
+                                             environment)))
+                  ,@(if entry-point
+                        `((entrypoint . ,(list->vector entry-point)))
+                        '()))
+                 ("architecture" . ,arch))
+               (config (string-append id "/layer.tar")
+                       time arch
+                       #:environment environment
+                       #:entry-point entry-point)))))
       (with-output-to-file "manifest.json"
         (lambda ()
           (scm->json (manifest prefix id repository))))
       (with-output-to-file "repositories"
         (lambda ()
-          (scm->json (repositories prefix id repository)))))
-
-    (apply invoke "tar" "-cf" image "-C" directory
-           `(,@(tar-base-options #:compressor compressor)
-             "."))
+          (scm->json (repositories prefix id repository))))
+      (if stream-layered-image
+          (let ((input (open-pipe* OPEN_READ "python3"
+                                   stream-layered-image
+                                   "config.json")))
+            (call-with-output-file "image.tar"
+              (lambda (output)
+                (dump-port input output)))
+            (if (eqv? 0 (status:exit-val (close-pipe input)))
+                (begin
+                  (invoke "gzip" "image.tar")
+                  (copy-file "image.tar.gz" image))
+                (error
+                 (formatted-message
+                  (G_ "failed to create ~a image tarball")
+                  image))))
+          (apply invoke "tar" "-cf" image
+                 `(,@(tar-base-options #:compressor compressor)
+                   "."))))
     (delete-file-recursively directory)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index eb41eb5563..3a8f87e850 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2020 Eric Bavier <bavier <at> posteo.net>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,6 +55,7 @@ (define-module (guix scripts pack)
   #:use-module ((gnu packages compression) #:hide (zip))
   #:use-module (gnu packages guile)
   #:use-module (gnu packages base)
+  #:use-module (gnu packages python)
   #:autoload   (gnu packages package-management) (guix)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:autoload   (gnu packages guile) (guile2.0-json guile-json)
@@ -69,6 +71,7 @@ (define-module (guix scripts pack)
             debian-archive
             rpm-archive
             docker-image
+            docker-layered-image
             squashfs-image
 
             %formats
@@ -591,6 +594,10 @@ (define (mksquashfs args)
 ;;;
 ;;; Docker image format.
 ;;;
+
+(define stream-layered-image.py
+  (local-file (search-auxiliary-file "python/stream-layered-image.py")))
+
 (define* (docker-image name profile
                        #:key target
                        (profile-name "guix-profile")
@@ -599,12 +606,14 @@ (define* (docker-image name profile
                        localstatedir?
                        (symlinks '())
                        (archiver tar)
-                       (extra-options '()))
+                       (extra-options '())
+                       layered-image?)
   "Return a derivation to construct a Docker image of PROFILE.  The
 image is a tarball conforming to the Docker Image Specification, compressed
 with COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it
 must a be a GNU triplet and it is used to derive the architecture metadata in
-the image."
+the image.  If LAYERED-IMAGE? is true, the image will with many of the
+store paths being on their own layer to improve sharing between images."
   (define database
     (and localstatedir?
          (file-append (store-database (list profile))
@@ -655,25 +664,37 @@ (define directives
               `((directory "/tmp" ,(getuid) ,(getgid) #o1777)
                 ,@(append-map symlink->directives '#$symlinks)))
 
-            (setenv "PATH" #+(file-append archiver "/bin"))
-
-            (build-docker-image #$output
-                                (map store-info-item
-                                     (call-with-input-file "profile"
-                                       read-reference-graph))
-                                #$profile
-                                #:repository (manifest->friendly-name
-                                              (profile-manifest #$profile))
-                                #:database #+database
-                                #:system (or #$target %host-type)
-                                #:environment environment
-                                #:entry-point
-                                #$(and entry-point
-                                       #~(list (string-append #$profile "/"
-                                                              #$entry-point)))
-                                #:extra-files directives
-                                #:compressor #+(compressor-command compressor)
-                                #:creation-time (make-time time-utc 0 1))))))
+            (setenv "PATH"
+                    (string-join `(#+(file-append archiver "/bin")
+                                   #+@(if layered-image?
+                                          (list (file-append coreutils "/bin")
+                                                (file-append gzip "/bin")
+                                                (file-append python "/bin"))
+                                          '()))
+                                 ":"))
+
+            (apply build-docker-image
+                   (append (list #$output
+                                 (map store-info-item
+                                      (call-with-input-file "profile"
+                                        read-reference-graph))
+                                 #$profile
+                                 #:repository (manifest->friendly-name
+                                               (profile-manifest #$profile))
+                                 #:database #+database
+                                 #:system (or #$target %host-type)
+                                 #:environment environment
+                                 #:entry-point
+                                 #$(and entry-point
+                                        #~(list (string-append #$profile "/"
+                                                               #$entry-point)))
+                                 #:extra-files directives
+                                 #:compressor #+(compressor-command compressor)
+                                 #:creation-time (make-time time-utc 0 1))
+                           (if #$layered-image?
+                               (list #:stream-layered-image
+                                     #$stream-layered-image.py)
+                               '())))))))
 
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
@@ -681,6 +702,33 @@ (define directives
                     #:target target
                     #:references-graphs `(("profile" ,profile))))
 
+(define* (docker-layered-image name profile
+                               #:key target
+                               (profile-name "guix-profile")
+                               (compressor (first %compressors))
+                               entry-point
+                               localstatedir?
+                               (symlinks '())
+                               (archiver tar)
+                               (extra-options '())
+                               (layered-image? #t))
+  "Return a derivation to construct a Docker image of PROFILE.  The image is a
+tarball conforming to the Docker Image Specification, compressed with
+COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it must a
+be a GNU triplet and it is used to derive the architecture metadata in the
+image.  If LAYERED-IMAGE? is true, the image will with many of the store paths
+being on their own layer to improve sharing between images."
+  (docker-image name profile
+                #:target target
+                #:profile-name profile-name
+                #:compressor compressor
+                #:entry-point entry-point
+                #:localstatedir? localstatedir?
+                #:symlinks symlinks
+                #:archiver archiver
+                #:extra-options extra-options
+                #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Debian archive format.
@@ -1357,6 +1405,7 @@ (define %formats
   `((tarball . ,self-contained-tarball)
     (squashfs . ,squashfs-image)
     (docker  . ,docker-image)
+    (docker-layered  . ,docker-layered-image)
     (deb . ,debian-archive)
     (rpm . ,rpm-archive)))
 
@@ -1365,15 +1414,17 @@ (define (show-formats)
   (display (G_ "The supported formats for 'guix pack' are:"))
   (newline)
   (display (G_ "
-  tarball       Self-contained tarball, ready to run on another machine"))
+  tarball        Self-contained tarball, ready to run on another machine"))
+  (display (G_ "
+  squashfs       Squashfs image suitable for Singularity"))
   (display (G_ "
-  squashfs      Squashfs image suitable for Singularity"))
+  docker         Tarball ready for 'docker load'"))
   (display (G_ "
-  docker        Tarball ready for 'docker load'"))
+  docker-layered Tarball with a layered image ready for 'docker load'"))
   (display (G_ "
-  deb           Debian archive installable via dpkg/apt"))
+  deb            Debian archive installable via dpkg/apt"))
   (display (G_ "
-  rpm           RPM archive installable via rpm/yum"))
+  rpm            RPM archive installable via rpm/yum"))
   (newline))
 
 (define (required-option symbol)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index c0bc295c00..e9123e679a 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2022 Tobias Geerinckx-Rice <me <at> tobias.gr>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -734,13 +735,15 @@ (define* (system-derivation-for-action image action
                                               #:graphic? graphic?
                                               #:disk-image-size image-size
                                               #:mappings mappings))
-      ((image disk-image vm-image docker-image)
+      ((image disk-image vm-image docker-image docker-layered-image)
        (when (eq? action 'disk-image)
          (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'vm-image)
          (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'docker-image)
          (warning (G_ "'docker-image' is deprecated: use 'image' instead~%")))
+       (when (eq? action 'docker-layered-image)
+         (warning (G_ "'docker-layered-image' is deprecated: use 'image' instead~%")))
        (lower-object (system-image image))))))
 
 (define (maybe-suggest-running-guix-pull)
@@ -987,6 +990,8 @@ (define (show-help)
    image            build a Guix System image\n"))
   (display (G_ "\
    docker-image     build a Docker image\n"))
+  (display (G_ "\
+   docker-layered-image build a Docker layered image\n"))
   (display (G_ "\
    init             initialize a root file system to run GNU\n"))
   (display (G_ "\
@@ -1200,7 +1205,7 @@ (define actions '("build" "container" "vm" "vm-image" "image" "disk-image"
                   "list-generations" "describe"
                   "delete-generations" "roll-back"
                   "switch-generation" "search" "edit"
-                  "docker-image"))
+                  "docker-image" "docker-layered-image"))
 
 (define (process-action action args opts)
   "Process ACTION, a sub-command, with the arguments are listed in ARGS.
@@ -1249,6 +1254,8 @@ (define save-provenance?
          (image       (let* ((image-type (case action
                                            ((vm-image) qcow2-image-type)
                                            ((docker-image) docker-image-type)
+                                           ((docker-layered-image)
+                                            docker-layered-image-type)
                                            (else image-type)))
                             (image-size (assoc-ref opts 'image-size))
                             (volatile?
diff --git a/tests/pack.scm b/tests/pack.scm
index 87187bb62c..db2208d91c 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@ (define-module (test-pack)
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix utils)
+  #:use-module ((guix build utils) #:select (%store-directory))
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (glibc-utf8-locales))
   #:use-module (gnu packages bootstrap)
@@ -246,6 +248,52 @@ (define bin
                             (mkdir #$output)))))))
       (built-derivations (list check))))
 
+  (unless store (test-skip 1))
+  (test-assertm "docker-layered-image + localstatedir" store
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile -> (profile
+                      (content (packages->manifest (list %bootstrap-guile)))
+                      (hooks '())
+                      (locales? #f)))
+         (tarball (docker-layered-image "docker-pack" profile
+                                #:symlinks '(("/bin/Guile" -> "bin/guile"))
+                                #:localstatedir? #t))
+         (check   (gexp->derivation "check-tarball"
+                    (with-imported-modules '((guix build utils))
+                      #~(begin
+                          (use-modules (guix build utils)
+                                       (ice-9 match))
+
+                          (define bin
+                            (string-append "." #$profile "/bin"))
+
+                          (define store
+                            (string-append "." #$(%store-directory)))
+
+                          (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+                          (mkdir "base")
+                          (with-directory-excursion "base"
+                            (invoke "tar" "xvf" #$tarball))
+
+                          (match (find-files "base" "layer.tar")
+                            ((layers ...)
+                             (for-each (lambda (layer)
+                                         (invoke "tar" "xvf" layer)
+                                         (invoke "chmod" "--recursive" "u+w" store))
+                                       layers)))
+
+                          (when
+                              (and (file-exists? (string-append bin "/guile"))
+                                   (file-exists? "var/guix/db/db.sqlite")
+                                   (file-is-directory? "tmp")
+                                   (string=? (string-append #$%bootstrap-guile "/bin")
+                                             (pk 'binlink (readlink bin)))
+                                   (string=? (string-append #$profile "/bin/guile")
+                                             (pk 'guilelink (readlink "bin/Guile"))))
+                            (mkdir #$output)))))))
+      (built-derivations (list check))))
+
   (unless store (test-skip 1))
   (test-assertm "squashfs-image + localstatedir" store
     (mlet* %store-monad
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 13 Mar 2023 00:35:01 GMT) Full text and rfc822 format available.

Message #11 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH 2/2] news: Add entry for the new 'docker-layered' distribution
 format.
Date: Mon, 13 Mar 2023 03:33:10 +0300
* etc/news.scm: Add entry.
---
 etc/news.scm | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index 924c2b35b4..98fb7f536c 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -18,6 +18,7 @@
 ;; Copyright © 2021 Andrew Tropin <andrew <at> trop.in>
 ;; Copyright © 2021 Jonathan Brielmaier <jonathan.brielmaier <at> web.de>
 ;; Copyright © 2022 Thiago Jung Bauermann <bauermann <at> kolabnow.com>
+;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -26,6 +27,43 @@
 (channel-news
  (version 0)
 
+ (entry (commit "45777c5b753ce330ad007d4e71189cf3fc627ccc")
+        (title
+         (en "New @samp{docker-layered} format for the @command{guix pack} command")
+         (ru "Новый @samp{docker-layered} формат для @command{guix pack} команды"))
+        (body
+         (en "Docker layered image can now be produced via the @command{guix
+pack --format=docker-layered} command, providing a Docker image with many of
+the store paths being on their own layer to improve sharing between images.
+The image is realized into the GNU store as a gzipped tarball.  Here is a
+simple example that generates a layered Docker image for the @code{hello}
+package:
+
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+See @command{info \"(guix) Invoking guix pack\"} for more information.
+
+@command{guix system image} can now produce layered Docker image by passing
+@code{docker-layered} to @option{--image-type} option.
+")
+         (ru "Появилась команда создания многослойных Docker образов с помощью
+@command{guix pack --format=docker-layered}, которая соберет Docker образ с
+путями в store расположенными на отдельных слоях, ускоряя таким образом
+передачу образов.  Образ будет создан в GNU store в качестве gzipped tarball.
+
+Пример создания Docker layered image с @code{hello} пакетом:
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+Смотрите @command{info \"(guix) Invoking guix pack\"} для получения более
+детальных сведений.
+
+@command{guix system image} теперь может создавать layered Docker image путем
+указания в опции @option{--image-type} параметра @code{docker-layered}.")))
+
  (entry (commit "598f4c509bbfec2b983a8ee246cce0a0fe45ec7f")
         (title
          (de "Neues Format @samp{rpm} für den Befehl @command{guix pack}")
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 13 Mar 2023 00:44:02 GMT) Full text and rfc822 format available.

Message #14 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Subject: Cover lever typo in guix pack format example
Date: Mon, 13 Mar 2023 03:43:11 +0300
[Message part 1 (text/plain, inline)]
The cover lever guix pack example should be:

    ./pre-inst-env guix pack -f docker-layered --entry-point=bin/bash -S /bin=bin bash hello

instead of

    ./pre-inst-env guix pack -f docker --entry-point=bin/bash -S /bin=bin bash hello

Apologies,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 13 Mar 2023 15:03:03 GMT) Full text and rfc822 format available.

Message #17 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: Oleg Pykhalov <go.wigust <at> gmail.com>, 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: Re: [bug#62153] [PATCH 1/2] guix: docker: Build layered image.
Date: Mon, 13 Mar 2023 16:01:04 +0100
Hi,

Oh cool!  Awesome!  Thanks for pushing forward.

On lun., 13 mars 2023 at 03:33, Oleg Pykhalov <go.wigust <at> gmail.com> wrote:

> diff --git a/gnu/packages/aux-files/python/stream-layered-image.py b/gnu/packages/aux-files/python/stream-layered-image.py
> new file mode 100644
> index 0000000000..9ad2168c2d
> --- /dev/null
> +++ b/gnu/packages/aux-files/python/stream-layered-image.py
> @@ -0,0 +1,391 @@
> +"""
> +This script generates a Docker image from a set of store paths. Uses
> +Docker Image Specification v1.2 as reference [1].

Instead of Python, would it possible to implement in Guile?  I mean,
does Python have something that is missing in Guile?

The facility for manipulating Tar?  Something else?


Because then, if I understand correctly…

> diff --git a/guix/docker.scm b/guix/docker.scm
> index 5e6460f43f..f1adad26dc 100644
> --- a/guix/docker.scm
> +++ b/guix/docker.scm

[...]

> +      (if stream-layered-image
> +          (let ((input (open-pipe* OPEN_READ "python3"
> +                                   stream-layered-image
> +                                   "config.json")))

…it requires to drag Python for building/packing layered Docker.


Well, I have not really look yet to the Python script which does most of
the job.  Do you use a similar strategy as [1]?

And I remember something in that direction by Chris but I am unable to
find back the patch. )-:

1: https://grahamc.com/blog/nix-and-layered-docker-images/

Cheers,
simon




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 13 Mar 2023 21:10:02 GMT) Full text and rfc822 format available.

Message #20 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: "pelzflorian (Florian Pelz)" <pelzflorian <at> pelzflorian.de>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 2/2] news: Add entry for the new
 'docker-layered' distribution format.
Date: Mon, 13 Mar 2023 22:09:06 +0100
Thank you Oleg for this feature.

Could you change the following three things in the news:

Change the beginning of the English translation from
"Docker layered image can now be produced" to
"Docker layered images can now be produced".

And at the end, also in Russian, switch around these two paragraphs
and add a “the” and reference the System Images chapter:
> @command{guix system image} can now produce layered Docker image by passing
> @code{docker-layered} to the @option{--image-type} option.
> 
> See @command{info \"(guix) Invoking guix pack\"} and
> @command{info \"(guix) System Images\"} for more information.


Lastly, could you then also add a German translation:

(title
 …
 (de "Neues Format @samp{docker-layered} für den Befehl @command{guix pack}")

(body
 …
 (de "Sie können jetzt auch mehrschichtige Docker-Abbilder mit dem Befehl
@command{guix pack --format=docker-layered} erzeugen. Damit bekommen Sie ein
Docker-Abbild, bei dem Store-Pfade auf getrennten Schichten („Layer“)
untergebracht sind, die sich mehrere Abbilder teilen können.  Das Abbild wird
im Store als gzip-komprimierter Tarball erzeugt.  Hier ist ein einfaches
Beispiel, wo ein mehrschichtiges Docker-Abbild für das Paket @code{hello}
angelegt wird:

@example
guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
@end example

@command{guix system image} kann jetzt geschichtete Docker-Abbilder erzeugen,
indem Sie @code{docker-layered} an die Befehlszeilenoption @option{--image-type}
übergeben.

Siehe @command{info \"(guix.de) Aufruf von guix pack\"} und
@command{info \"(guix.de) Systemabbilder\"} für weitere Informationen.")

Regards,
Florian




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 13 Mar 2023 21:12:02 GMT) Full text and rfc822 format available.

Message #23 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: Simon Tournier <zimon.toutoune <at> gmail.com>
Cc: 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/2] guix: docker: Build layered image.
Date: Tue, 14 Mar 2023 00:10:56 +0300
[Message part 1 (text/plain, inline)]
Hi Simon,

Thank you for the review.

Simon Tournier <zimon.toutoune <at> gmail.com> writes:

> On lun., 13 mars 2023 at 03:33, Oleg Pykhalov <go.wigust <at> gmail.com> wrote:
>
>> diff --git a/gnu/packages/aux-files/python/stream-layered-image.py b/gnu/packages/aux-files/python/stream-layered-image.py
>> new file mode 100644
>> index 0000000000..9ad2168c2d
>> --- /dev/null
>> +++ b/gnu/packages/aux-files/python/stream-layered-image.py
>> @@ -0,0 +1,391 @@
>> +"""
>> +This script generates a Docker image from a set of store paths. Uses
>> +Docker Image Specification v1.2 as reference [1].
>
> Instead of Python, would it possible to implement in Guile?  I mean,
> does Python have something that is missing in Guile?
>
> The facility for manipulating Tar?  Something else?

I think nothing else.  As I understand Python implemented Tar inside the
language itself in 2500 lines of code by manipulating binary data.

    /gnu/store/...-python-3.9.9/lib/python3.9/tarfile.py

Technically it's probably possible to use tar utility with --append flag
instead of opening a new file and streaming to it as the Python script
does.  To be honest I would like not to write it in this way if the
Python script does not block current patch for merge.

Also I don't see myself writing Tar implementation in Guile, yet.  ;-)

The Nix project uses this script heavily to build layered images, so it
should be robust in terms of up to date to current Tar and Python
implementations.

> Because then, if I understand correctly…
>
>> diff --git a/guix/docker.scm b/guix/docker.scm
>> index 5e6460f43f..f1adad26dc 100644
>> --- a/guix/docker.scm
>> +++ b/guix/docker.scm
>
> [...]
>
>> +      (if stream-layered-image
>> +          (let ((input (open-pipe* OPEN_READ "python3"
>> +                                   stream-layered-image
>> +                                   "config.json")))
>
> …it requires to drag Python for building/packing layered Docker.

Correct.

> Well, I have not really look yet to the Python script which does most of
> the job.  Do you use a similar strategy as [1]?
>
> And I remember something in that direction by Chris but I am unable to
> find back the patch. )-:
>
> 1: https://grahamc.com/blog/nix-and-layered-docker-images/

Not similar.  My patch implements a very simple sorting by size, no
complex sorting by reference popularity as in [1], which is probably
implemented in the following file

   github.com/NixOS/nixpkgs/pkgs/build-support/references-by-popularity/closure-graph.py

From https://grahamc.com/blog/nix-and-layered-docker-images/ article:

> How Docker really represents an Image
>
> Docker’s layers are content addressable and aren’t required to
> explicitly reference a parent layer. This means a layer for
> readline-7.0p5 doesn’t have to mention that it has any relationship to
> ncurses-6.1 or glibc-2.27 at all.
>
> Instead each image has a manifest which defines the order:
>
> {
>   "Layers": [
>     "bash-interactive-4.4-p23",
>     "bash-4.4p23",
>     "readline-7.0p5",
>      ...
>   ]
> }
>
> If you have only built Docker images using a Dockerfile, then you
> would expect the way we flatten our graph to be critically
> important. If we sometimes picked readline-7.0p5 to come first and
> other times picked bash-4.4p23 then we may never make cache hits.
>
> However since the Image defines the order, we don’t have to solve this
> impossible problem: we can order the layers in any way we want and the
> layer cache will always hit.

In case of sorting by size, bigest layers will be on top of a container
image, which will produce a cache hit for bigest directories in the GNU
store during images transfer with same layers.

I would like to say this sorting could binifit more than sorting by
popularity during transfer but let's assume I didn't write it.  ;-)

The following example shows common layers between images, which will be
not tranfered if you load image inside Docker as well as pull and push:

    ./pre-inst-env guix pack -f docker-layered --entry-point=bin/bash -S /bin=bin bash hello

and

    ./pre-inst-env guix pack -f docker-layered --entry-point=bin/bash -S /bin=bin bash hello emacs

share 6 layers in total

--8<---------------cut here---------------start------------->8---
$ f() { docker image inspect "$1" | jq --raw-output '.[0].RootFS.Layers[] | .' | sort ; }
$ comm -1 -2 --total <(f sha256:fb43b32380a5e6a867410721f4ce2917db14d4ae943c433983afbaf84416c421) <(f sha256:0ce4a11973d1071aeec5441db228d6148dfd09fea3ae77b731c750ebfcc2fe1d)
sha256:3b3daa2a00f1acd12eeb16698bf1caeb6ba6c436e3dbca6259c3a9c622664e00
sha256:5c2be7469293854257221cb6aa8aa4af1e10e2c550935390dbcfeede3d3fbacd
sha256:60317981d94928659389f299e4b86703e5ded420a53537d67627952187fbd3f9
sha256:6d7c8ce5441d4c4c74e0ecff6c203a7b265b37137cca3b0a0ccf10526cfaa6e2
sha256:c2ded2ffe3f46fa7a64a62e0fc6b9d28cb7d4f8d9c64d5a52d137a508cba11fc
sha256:fbcad85d7d3c25bd2aa6d95bb3bf3d02c499ee3b3e443ddd3e5b679c2b33c139
5       94      6       total
--8<---------------cut here---------------end--------------->8---

Regards,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 00:26:01 GMT) Full text and rfc822 format available.

Message #26 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: pelzflorian <at> pelzflorian.de
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, 62153 <at> debbugs.gnu.org
Subject: [PATCH 0/2] Add Docker layered image for pack and system (v2)
Date: Tue, 14 Mar 2023 03:24:51 +0300
Hi, Florian.

Thank you for the review.

This patch series applies your suggestions.  Also it's rebased on
origin/master and added a missing documentation for ‘docker-layered’ format in
‘guix system image’ command in doc/guix.texi file (following diff).

<#part type="text/x-patch" buffer=m1.txt disposition=inline description="Add missing docker-layered format documentation for guix system image command">
<#/part>

The folloing tests passed:

make check-channel-news
make check TESTS="tests/pack.scm"
make check-system TESTS="docker-system docker-layered-system"

Oleg Pykhalov (2):
  guix: docker: Build layered image.
  news: Add entry for the new 'docker-layered' distribution format.

 Makefile.am                                   |   3 +-
 doc/guix.texi                                 |  18 +-
 etc/news.scm                                  |  58 +++
 gnu/image.scm                                 |   3 +-
 .../aux-files/python/stream-layered-image.py  | 391 ++++++++++++++++++
 gnu/system/image.scm                          |  84 +++-
 gnu/tests/docker.scm                          |  20 +-
 guix/docker.scm                               | 182 ++++++--
 guix/scripts/pack.scm                         | 105 +++--
 guix/scripts/system.scm                       |  11 +-
 tests/pack.scm                                |  48 +++
 11 files changed, 837 insertions(+), 86 deletions(-)
 create mode 100644 gnu/packages/aux-files/python/stream-layered-image.py


base-commit: 5312d798ac36a72d8a977325a7c6ff7647be670a
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 00:27:02 GMT) Full text and rfc822 format available.

Message #29 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: pelzflorian <at> pelzflorian.de
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, 62153 <at> debbugs.gnu.org
Subject: [PATCH 1/2] guix: docker: Build layered image.
Date: Tue, 14 Mar 2023 03:24:52 +0300
* gnu/packages/aux-files/python/stream-layered-image.py: New file.
* Makefile.am (AUX_FILES): Add this.
* guix/docker.scm (%docker-image-max-layers): New variable.
(build-docker-image)[stream-layered-image, root-system]: New arguments.
* guix/scripts/pack.scm (stream-layered-image.py): New variable.
(docker-image)[layered-image?]: New argument.
(docker-layered-image): New procedure.
(%formats)[docker-layered]: New format.
(show-formats): Document this.
* tests/pack.scm: Add docker-layered-image + localstatedir test.
* guix/scripts/system.scm
(system-derivation-for-action)[docker-layered-image]: New action.
(show-help): Document this.
(actions)[docker-layered-image]: New action.
(process-action): Add this.
* gnu/system/image.scm (docker-layered-image, docker-layered-image-type): New
variables.
(system-docker-image)[layered-image?]: New argument.
(stream-layered-image.py): New variable.
(system-docker-layered-image): New procedure.
(image->root-file-system)[docker-layered]: New image format.
* gnu/tests/docker.scm (%test-docker-layered-system): New test.
* gnu/image.scm (validate-image-format)[docker-layered]: New image format.
* doc/guix.texi (Invoking guix pack): Document docker-layered format.
(image Reference): Same.
(image-type Reference): Document docker-layered-image-type.
---
 Makefile.am                                   |   3 +-
 doc/guix.texi                                 |  18 +-
 gnu/image.scm                                 |   3 +-
 .../aux-files/python/stream-layered-image.py  | 391 ++++++++++++++++++
 gnu/system/image.scm                          |  84 +++-
 gnu/tests/docker.scm                          |  20 +-
 guix/docker.scm                               | 182 ++++++--
 guix/scripts/pack.scm                         | 105 +++--
 guix/scripts/system.scm                       |  11 +-
 tests/pack.scm                                |  48 +++
 10 files changed, 779 insertions(+), 86 deletions(-)
 create mode 100644 gnu/packages/aux-files/python/stream-layered-image.py

diff --git a/Makefile.am b/Makefile.am
index 23b939b674..9aca84f8f8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -11,7 +11,7 @@
 # Copyright © 2017 Arun Isaac <arunisaac <at> systemreboot.net>
 # Copyright © 2018 Nikita <nikita <at> n0.is>
 # Copyright © 2018 Julien Lepiller <julien <at> lepiller.eu>
-# Copyright © 2018 Oleg Pykhalov <go.wigust <at> gmail.com>
+# Copyright © 2018, 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 # Copyright © 2018 Alex Vong <alexvong1995 <at> gmail.com>
 # Copyright © 2019 Efraim Flashner <efraim <at> flashner.co.il>
 # Copyright © 2021 Chris Marusich <cmmarusich <at> gmail.com>
@@ -435,6 +435,7 @@ AUX_FILES =						\
   gnu/packages/aux-files/python/sanity-check.py		\
   gnu/packages/aux-files/python/sanity-check-next.py	\
   gnu/packages/aux-files/python/sitecustomize.py	\
+  gnu/packages/aux-files/python/stream-layered-image.py	\
   gnu/packages/aux-files/renpy/renpy.in	\
   gnu/packages/aux-files/run-in-namespace.c
 
diff --git a/doc/guix.texi b/doc/guix.texi
index 39932d5aad..fa4b7586c9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -56,7 +56,7 @@ Copyright @copyright{} 2017 Andy Wingo@*
 Copyright @copyright{} 2017, 2018, 2019, 2020 Arun Isaac@*
 Copyright @copyright{} 2017 nee@*
 Copyright @copyright{} 2018 Rutger Helling@*
-Copyright @copyright{} 2018, 2021 Oleg Pykhalov@*
+Copyright @copyright{} 2018, 2021, 2023 Oleg Pykhalov@*
 Copyright @copyright{} 2018 Mike Gerwitz@*
 Copyright @copyright{} 2018 Pierre-Antoine Rouby@*
 Copyright @copyright{} 2018, 2019 Gábor Boskovits@*
@@ -6837,9 +6837,15 @@ the following command:
 guix pack -f docker -S /bin=bin guile guile-readline
 @end example
 
+or
+
+@example
+guix pack -f docker-layered -S /bin=bin guile guile-readline
+@end example
+
 @noindent
-The result is a tarball that can be passed to the @command{docker load}
-command, followed by @code{docker run}:
+The result is a tarball with image or layered image that can be passed
+to the @command{docker load} command, followed by @code{docker run}:
 
 @example
 docker load < @var{file}
@@ -43274,6 +43280,8 @@ one or multiple partitions.
 
 @item @code{docker}, a Docker image.
 
+@item @code{docker-layered}, a layered Docker image.
+
 @item @code{iso9660}, an ISO-9660 image.
 
 @item @code{tarball}, a tar.gz image archive.
@@ -43605,6 +43613,10 @@ Build an image based on the @code{iso9660-image} image but with the
 Build an image based on the @code{docker-image} image.
 @end defvar
 
+@defvar docker-layered-image-type
+Build a layered image based on the @code{docker-layered-image} image.
+@end defvar
+
 @defvar raw-with-offset-image-type
 Build an MBR image with a single partition starting at a @code{1024KiB}
 offset.  This is useful to leave some room to install a bootloader in
diff --git a/gnu/image.scm b/gnu/image.scm
index 523653dd77..8a6a0d8479 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -152,7 +153,7 @@ (define-with-syntax-properties (name (value properties))
 
 ;; The supported image formats.
 (define-set-sanitizer validate-image-format format
-  (disk-image compressed-qcow2 docker iso9660 tarball wsl2))
+  (disk-image compressed-qcow2 docker docker-layered iso9660 tarball wsl2))
 
 ;; The supported partition table types.
 (define-set-sanitizer validate-partition-table-type partition-table-type
diff --git a/gnu/packages/aux-files/python/stream-layered-image.py b/gnu/packages/aux-files/python/stream-layered-image.py
new file mode 100644
index 0000000000..9ad2168c2d
--- /dev/null
+++ b/gnu/packages/aux-files/python/stream-layered-image.py
@@ -0,0 +1,391 @@
+"""
+This script generates a Docker image from a set of store paths. Uses
+Docker Image Specification v1.2 as reference [1].
+
+It expects a JSON file with the following properties and writes the
+image as an uncompressed tarball to stdout:
+
+* "architecture", "config", "os", "created", "repo_tag" correspond to
+  the fields with the same name on the image spec [2].
+* "created" can be "now".
+* "created" is also used as mtime for files added to the image.
+* "store_layers" is a list of layers in ascending order, where each
+  layer is the list of store paths to include in that layer.
+
+The main challenge for this script to create the final image in a
+streaming fashion, without dumping any intermediate data to disk
+for performance.
+
+A docker image has each layer contents archived as separate tarballs,
+and they later all get enveloped into a single big tarball in a
+content addressed fashion. However, because how "tar" format works,
+we have to know about the name (which includes the checksum in our
+case) and the size of the tarball before we can start adding it to the
+outer tarball.  We achieve that by creating the layer tarballs twice;
+on the first iteration we calculate the file size and the checksum,
+and on the second one we actually stream the contents. 'add_layer_dir'
+function does all this.
+
+[1]: https://github.com/moby/moby/blob/master/image/spec/v1.2.md
+[2]: https://github.com/moby/moby/blob/4fb59c20a4fb54f944fe170d0ff1d00eb4a24d6f/image/spec/v1.2.md#image-json-field-descriptions
+"""  # noqa: E501
+
+
+import io
+import os
+import re
+import sys
+import json
+import hashlib
+import pathlib
+import tarfile
+import itertools
+import threading
+from datetime import datetime, timezone
+from collections import namedtuple
+
+
+def archive_paths_to(obj, paths, mtime):
+    """
+    Writes the given store paths as a tar file to the given stream.
+
+    obj: Stream to write to. Should have a 'write' method.
+    paths: List of store paths.
+    """
+
+    # gettarinfo makes the paths relative, this makes them
+    # absolute again
+    def append_root(ti):
+        ti.name = "/" + ti.name
+        return ti
+
+    def apply_filters(ti):
+        ti.mtime = mtime
+        ti.uid = 0
+        ti.gid = 0
+        ti.uname = "root"
+        ti.gname = "root"
+        return ti
+
+    def nix_root(ti):
+        ti.mode = 0o0555  # r-xr-xr-x
+        return ti
+
+    def dir(path):
+        ti = tarfile.TarInfo(path)
+        ti.type = tarfile.DIRTYPE
+        return ti
+
+    with tarfile.open(fileobj=obj, mode="w|") as tar:
+        # To be consistent with the docker utilities, we need to have
+        # these directories first when building layer tarballs.
+        tar.addfile(apply_filters(nix_root(dir("/gnu"))))
+        tar.addfile(apply_filters(nix_root(dir("/gnu/store"))))
+
+        for path in paths:
+            path = pathlib.Path(path)
+            if path.is_symlink():
+                files = [path]
+            else:
+                files = itertools.chain([path], path.rglob("*"))
+
+            for filename in sorted(files):
+                ti = append_root(tar.gettarinfo(filename))
+
+                # copy hardlinks as regular files
+                if ti.islnk():
+                    ti.type = tarfile.REGTYPE
+                    ti.linkname = ""
+                    ti.size = filename.stat().st_size
+
+                ti = apply_filters(ti)
+                if ti.isfile():
+                    with open(filename, "rb") as f:
+                        tar.addfile(ti, f)
+                else:
+                    tar.addfile(ti)
+
+
+class ExtractChecksum:
+    """
+    A writable stream which only calculates the final file size and
+    sha256sum, while discarding the actual contents.
+    """
+
+    def __init__(self):
+        self._digest = hashlib.sha256()
+        self._size = 0
+
+    def write(self, data):
+        self._digest.update(data)
+        self._size += len(data)
+
+    def extract(self):
+        """
+        Returns: Hex-encoded sha256sum and size as a tuple.
+        """
+        return (self._digest.hexdigest(), self._size)
+
+
+FromImage = namedtuple("FromImage", ["tar", "manifest_json", "image_json"])
+# Some metadata for a layer
+LayerInfo = namedtuple("LayerInfo", ["size", "checksum", "path", "paths"])
+
+
+def load_from_image(from_image_str):
+    """
+    Loads the given base image, if any.
+
+    from_image_str: Path to the base image archive.
+
+    Returns: A 'FromImage' object with references to the loaded base image,
+             or 'None' if no base image was provided.
+    """
+    if from_image_str is None:
+        return None
+
+    base_tar = tarfile.open(from_image_str)
+
+    manifest_json_tarinfo = base_tar.getmember("manifest.json")
+    with base_tar.extractfile(manifest_json_tarinfo) as f:
+        manifest_json = json.load(f)
+
+    image_json_tarinfo = base_tar.getmember(manifest_json[0]["Config"])
+    with base_tar.extractfile(image_json_tarinfo) as f:
+        image_json = json.load(f)
+
+    return FromImage(base_tar, manifest_json, image_json)
+
+
+def add_base_layers(tar, from_image):
+    """
+    Adds the layers from the given base image to the final image.
+
+    tar: 'tarfile.TarFile' object for new layers to be added to.
+    from_image: 'FromImage' object with references to the loaded base image.
+    """
+    if from_image is None:
+        print("No 'fromImage' provided", file=sys.stderr)
+        return []
+
+    layers = from_image.manifest_json[0]["Layers"]
+    checksums = from_image.image_json["rootfs"]["diff_ids"]
+    layers_checksums = zip(layers, checksums)
+
+    for num, (layer, checksum) in enumerate(layers_checksums, start=1):
+        layer_tarinfo = from_image.tar.getmember(layer)
+        checksum = re.sub(r"^sha256:", "", checksum)
+
+        tar.addfile(layer_tarinfo, from_image.tar.extractfile(layer_tarinfo))
+        path = layer_tarinfo.path
+        size = layer_tarinfo.size
+
+        print("Adding base layer", num, "from", path, file=sys.stderr)
+        yield LayerInfo(size=size, checksum=checksum, path=path, paths=[path])
+
+    from_image.tar.close()
+
+
+def overlay_base_config(from_image, final_config):
+    """
+    Overlays the final image 'config' JSON on top of selected defaults from the
+    base image 'config' JSON.
+
+    from_image: 'FromImage' object with references to the loaded base image.
+    final_config: 'dict' object of the final image 'config' JSON.
+    """
+    if from_image is None:
+        return final_config
+
+    base_config = from_image.image_json["config"]
+
+    # Preserve environment from base image
+    final_env = base_config.get("Env", []) + final_config.get("Env", [])
+    if final_env:
+        # Resolve duplicates (last one wins) and format back as list
+        resolved_env = {entry.split("=", 1)[0]: entry for entry in final_env}
+        final_config["Env"] = list(resolved_env.values())
+    return final_config
+
+
+def add_layer_dir(tar, paths, store_dir, mtime):
+    """
+    Appends given store paths to a TarFile object as a new layer.
+
+    tar: 'tarfile.TarFile' object for the new layer to be added to.
+    paths: List of store paths.
+    store_dir: the root directory of the nix store
+    mtime: 'mtime' of the added files and the layer tarball.
+           Should be an integer representing a POSIX time.
+
+    Returns: A 'LayerInfo' object containing some metadata of
+             the layer added.
+    """
+
+    invalid_paths = [i for i in paths if not i.startswith(store_dir)]
+    assert len(invalid_paths) == 0, \
+        f"Expecting absolute paths from {store_dir}, but got: {invalid_paths}"
+
+    # First, calculate the tarball checksum and the size.
+    extract_checksum = ExtractChecksum()
+    archive_paths_to(
+        extract_checksum,
+        paths,
+        mtime=mtime,
+    )
+    (checksum, size) = extract_checksum.extract()
+
+    path = f"{checksum}/layer.tar"
+    layer_tarinfo = tarfile.TarInfo(path)
+    layer_tarinfo.size = size
+    layer_tarinfo.mtime = mtime
+
+    # Then actually stream the contents to the outer tarball.
+    read_fd, write_fd = os.pipe()
+    with open(read_fd, "rb") as read, open(write_fd, "wb") as write:
+        def producer():
+            archive_paths_to(
+                write,
+                paths,
+                mtime=mtime,
+            )
+            write.close()
+
+        # Closing the write end of the fifo also closes the read end,
+        # so we don't need to wait until this thread is finished.
+        #
+        # Any exception from the thread will get printed by the default
+        # exception handler, and the 'addfile' call will fail since it
+        # won't be able to read required amount of bytes.
+        threading.Thread(target=producer).start()
+        tar.addfile(layer_tarinfo, read)
+
+    return LayerInfo(size=size, checksum=checksum, path=path, paths=paths)
+
+
+def add_customisation_layer(target_tar, customisation_layer, mtime):
+    """
+    Adds the customisation layer as a new layer. This is layer is structured
+    differently; given store path has the 'layer.tar' and corresponding
+    sha256sum ready.
+
+    tar: 'tarfile.TarFile' object for the new layer to be added to.
+    customisation_layer: Path containing the layer archive.
+    mtime: 'mtime' of the added layer tarball.
+    """
+
+    checksum_path = os.path.join(customisation_layer, "checksum")
+    with open(checksum_path) as f:
+        checksum = f.read().strip()
+    assert len(checksum) == 64, f"Invalid sha256 at ${checksum_path}."
+
+    layer_path = os.path.join(customisation_layer, "layer.tar")
+
+    path = f"{checksum}/layer.tar"
+    tarinfo = target_tar.gettarinfo(layer_path)
+    tarinfo.name = path
+    tarinfo.mtime = mtime
+
+    with open(layer_path, "rb") as f:
+        target_tar.addfile(tarinfo, f)
+
+    return LayerInfo(
+      size=None,
+      checksum=checksum,
+      path=path,
+      paths=[customisation_layer]
+    )
+
+
+def add_bytes(tar, path, content, mtime):
+    """
+    Adds a file to the tarball with given path and contents.
+
+    tar: 'tarfile.TarFile' object.
+    path: Path of the file as a string.
+    content: Contents of the file.
+    mtime: 'mtime' of the file. Should be an integer representing a POSIX time.
+    """
+    assert type(content) is bytes
+
+    ti = tarfile.TarInfo(path)
+    ti.size = len(content)
+    ti.mtime = mtime
+    tar.addfile(ti, io.BytesIO(content))
+
+
+def main():
+    with open(sys.argv[1], "r") as f:
+        conf = json.load(f)
+
+    created = (
+      datetime.now(tz=timezone.utc)
+      if conf["created"] == "now"
+      else datetime.fromisoformat(conf["created"])
+    )
+    mtime = int(created.timestamp())
+    store_dir = conf["store_dir"]
+
+    from_image = load_from_image(conf["from_image"])
+
+    with tarfile.open(mode="w|", fileobj=sys.stdout.buffer) as tar:
+        layers = []
+        layers.extend(add_base_layers(tar, from_image))
+
+        start = len(layers) + 1
+        for num, store_layer in enumerate(conf["store_layers"], start=start):
+            print("Creating layer", num, "from paths:", store_layer,
+                  file=sys.stderr)
+            info = add_layer_dir(tar, store_layer, store_dir, mtime=mtime)
+            layers.append(info)
+
+        print("Creating layer", len(layers) + 1, "with customisation...",
+              file=sys.stderr)
+        layers.append(
+          add_customisation_layer(
+            tar,
+            conf["customisation_layer"],
+            mtime=mtime
+          )
+        )
+
+        print("Adding manifests...", file=sys.stderr)
+
+        image_json = {
+            "created": datetime.isoformat(created),
+            "architecture": conf["architecture"],
+            "os": "linux",
+            "config": overlay_base_config(from_image, conf["config"]),
+            "rootfs": {
+                "diff_ids": [f"sha256:{layer.checksum}" for layer in layers],
+                "type": "layers",
+            },
+            "history": [
+                {
+                  "created": datetime.isoformat(created),
+                  "comment": f"store paths: {layer.paths}"
+                }
+                for layer in layers
+            ],
+        }
+
+        image_json = json.dumps(image_json, indent=4).encode("utf-8")
+        image_json_checksum = hashlib.sha256(image_json).hexdigest()
+        image_json_path = f"{image_json_checksum}.json"
+        add_bytes(tar, image_json_path, image_json, mtime=mtime)
+
+        manifest_json = [
+            {
+                "Config": image_json_path,
+                "RepoTags": [conf["repo_tag"]],
+                "Layers": [layer.path for layer in layers],
+            }
+        ]
+        manifest_json = json.dumps(manifest_json, indent=4).encode("utf-8")
+        add_bytes(tar, "manifest.json", manifest_json, mtime=mtime)
+
+        print("Done.", file=sys.stderr)
+
+
+if __name__ == "__main__":
+    main()
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index afef79185f..0bfd011ad4 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2022 Pavel Shlyak <p.shlyak <at> pantherx.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo <at> cyberdimension.org>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -45,6 +46,7 @@ (define-module (gnu system image)
   #:use-module (gnu system uuid)
   #:use-module (gnu system vm)
   #:use-module (guix packages)
+  #:use-module ((gnu packages) #:select (search-auxiliary-file))
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
   #:use-module (gnu packages bootloaders)
@@ -58,6 +60,7 @@ (define-module (gnu system image)
   #:use-module (gnu packages hurd)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages mtools)
+  #:use-module (gnu packages python)
   #:use-module (gnu packages virtualization)
   #:use-module ((srfi srfi-1) #:prefix srfi-1:)
   #:use-module (srfi srfi-11)
@@ -78,6 +81,7 @@ (define-module (gnu system image)
             efi-disk-image
             iso9660-image
             docker-image
+            docker-layered-image
             tarball-image
             wsl2-image
             raw-with-offset-disk-image
@@ -89,6 +93,7 @@ (define-module (gnu system image)
             iso-image-type
             uncompressed-iso-image-type
             docker-image-type
+            docker-layered-image-type
             tarball-image-type
             wsl2-image-type
             raw-with-offset-image-type
@@ -167,6 +172,10 @@ (define docker-image
   (image-without-os
    (format 'docker)))
 
+(define docker-layered-image
+  (image-without-os
+   (format 'docker-layered)))
+
 (define tarball-image
   (image-without-os
    (format 'tarball)))
@@ -237,6 +246,11 @@ (define docker-image-type
    (name 'docker)
    (constructor (cut image-with-os docker-image <>))))
 
+(define docker-layered-image-type
+  (image-type
+   (name 'docker-layered)
+   (constructor (cut image-with-os docker-layered-image <>))))
+
 (define tarball-image-type
   (image-type
    (name 'tarball)
@@ -633,9 +647,12 @@ (define (image-with-label base-image label)
 
 (define* (system-docker-image image
                               #:key
-                              (name "docker-image"))
+                              (name "docker-image")
+                              (archiver tar)
+                              layered-image?)
   "Build a docker image for IMAGE.  NAME is the base name to use for the
-output file."
+output file.  If LAYERED-IMAGE? is true, the image will with many of the store
+paths being on their own layer to improve sharing between images."
   (define boot-program
     ;; Program that runs the boot script of OS, which in turn starts shepherd.
     (program-file "boot-program"
@@ -678,9 +695,11 @@ (define builder
               (use-modules (guix docker)
                            (guix build utils)
                            (gnu build image)
+                           (srfi srfi-1)
                            (srfi srfi-19)
                            (guix build store-copy)
-                           (guix store database))
+                           (guix store database)
+                           (ice-9 receive))
 
               ;; Set the SQL schema location.
               (sql-schema #$schema)
@@ -700,18 +719,34 @@ (define builder
                                            #:register-closures? #$register-closures?
                                            #:deduplicate? #f
                                            #:system-directory #$os)
-                (build-docker-image
-                 #$output
-                 (cons* image-root
-                        (map store-info-item
-                             (call-with-input-file #$graph
-                               read-reference-graph)))
-                 #$os
-                 #:entry-point '(#$boot-program #$os)
-                 #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
-                 #:creation-time (make-time time-utc 0 1)
-                 #:system #$image-target
-                 #:transformations `((,image-root -> ""))))))))
+                (when #$layered-image?
+                  (setenv "PATH"
+                          (string-join (list #+(file-append archiver "/bin")
+                                             #+(file-append coreutils "/bin")
+                                             #+(file-append gzip "/bin")
+                                             #+(file-append python "/bin"))
+                                       ":")))
+                (apply build-docker-image
+                       (append (list #$output
+                                     (append (if #$layered-image?
+                                                 '()
+                                                 (list image-root))
+                                             (map store-info-item
+                                                  (call-with-input-file #$graph
+                                                    read-reference-graph)))
+                                     #$os
+                                     #:entry-point '(#$boot-program #$os)
+                                     #:compressor
+                                     '(#+(file-append gzip "/bin/gzip") "-9n")
+                                     #:creation-time (make-time time-utc 0 1)
+                                     #:system #$image-target
+                                     #:transformations `((,image-root -> "")))
+                               (if #$layered-image?
+                                   (list #:root-system
+                                         image-root
+                                         #:stream-layered-image
+                                         #$stream-layered-image.py)
+                                   '()))))))))
 
     (computed-file name builder
                    ;; Allow offloading so that this I/O-intensive process
@@ -720,6 +755,21 @@ (define builder
                    #:options `(#:references-graphs ((,graph ,os))
                                #:substitutable? ,substitutable?))))
 
+(define stream-layered-image.py
+  (local-file (search-auxiliary-file "python/stream-layered-image.py")))
+
+(define* (system-docker-layered-image image
+                                      #:key
+                                      (name "docker-image")
+                                      (archiver tar)
+                                      (layered-image? #t))
+  "Build a docker image for IMAGE.  NAME is the base name to use for the
+output file."
+  (system-docker-image image
+                       #:name name
+                       #:archiver archiver
+                       #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Tarball image.
@@ -811,7 +861,7 @@ (define (image->root-file-system image)
   "Return the IMAGE root partition file-system type."
   (case (image-format image)
     ((iso9660) "iso9660")
-    ((docker tarball wsl2) "dummy")
+    ((docker docker-layered tarball wsl2) "dummy")
     (else
      (partition-file-system (find-root-partition image)))))
 
@@ -948,6 +998,8 @@ (define target (cond
                                        ("bootcfg" ,bootcfg))))
        ((memq image-format '(docker))
         (system-docker-image image*))
+       ((memq image-format '(docker-layered))
+        (system-docker-layered-image image*))
        ((memq image-format '(tarball))
         (system-tarball-image image*))
        ((memq image-format '(wsl2))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 0276e398a7..85c5f178b5 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
 ;;; Copyright © 2019-2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,7 +44,8 @@ (define-module (gnu tests docker)
   #:use-module (guix build-system trivial)
   #:use-module ((guix licenses) #:prefix license:)
   #:export (%test-docker
-            %test-docker-system))
+            %test-docker-system
+            %test-docker-layered-system))
 
 (define %docker-os
   (simple-operating-system
@@ -309,3 +311,19 @@ (define %test-docker-system
                                    (locale-libcs (list glibc)))
                                  #:type docker-image-type)))
                  run-docker-system-test)))))
+
+(define %test-docker-layered-system
+  (system-test
+   (name "docker-layered-system")
+   (description "Run a system image as produced by @command{guix system
+docker-layered-image} inside Docker.")
+   (value (with-monad %store-monad
+            (>>= (lower-object
+                  (system-image (os->image
+                                 (operating-system
+                                   (inherit (simple-operating-system))
+                                   ;; Use locales for a single libc to
+                                   ;; reduce space requirements.
+                                   (locale-libcs (list glibc)))
+                                 #:type docker-layered-image-type)))
+                 run-docker-system-test)))))
diff --git a/guix/docker.scm b/guix/docker.scm
index 5e6460f43f..f1adad26dc 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich <at> gmail.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,10 +25,14 @@ (define-module (guix docker)
   #:use-module (guix base16)
   #:use-module (guix build pack)
   #:use-module ((guix build utils)
-                #:select (mkdir-p
+                #:select (%store-directory
+                          mkdir-p
                           delete-file-recursively
+                          dump-port
                           with-directory-excursion
                           invoke))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (gnu build install)
   #:use-module (json)                             ;guile-json
   #:use-module (srfi srfi-1)
@@ -38,6 +43,9 @@ (define-module (guix docker)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
   #:export (build-docker-image))
 
 ;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image.
@@ -136,6 +144,9 @@ (define directive-file
     (('directory name _ ...)
      (string-trim name #\/))))
 
+(define %docker-image-max-layers
+  100)
+
 (define* (build-docker-image image paths prefix
                              #:key
                              (repository "guix")
@@ -146,11 +157,13 @@ (define* (build-docker-image image paths prefix
                              entry-point
                              (environment '())
                              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.  REPOSITORY
-is a descriptive name that will show up in \"REPOSITORY\" column of the output
-of \"docker images\".
+                             (creation-time (current-time time-utc))
+                             stream-layered-image
+                             root-system)
+  "Write to IMAGE a layerer Docker image archive containing the given PATHS.
+PREFIX 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.
@@ -172,7 +185,13 @@ (define* (build-docker-image image paths prefix
 SYSTEM is a GNU triplet (or prefix thereof) of the system the binaries in
 PATHS are for; it is used to produce metadata in the image.  Use COMPRESSOR, a
 command such as '(\"gzip\" \"-9n\"), to compress IMAGE.  Use CREATION-TIME, a
-SRFI-19 time-utc object, as the creation time in metadata."
+SRFI-19 time-utc object, as the creation time in metadata.
+
+STREAM-LAYERED-IMAGE is a Python script which accepts a JSON configuration
+file and prints archive to STDOUT.
+
+ROOT-SYSTEM is a directory with a provisioned root file system, which will be
+added to image as a layer."
   (define (sanitize path-fragment)
     (escape-special-chars
      ;; GNU tar strips the leading slash off of absolute paths before applying
@@ -183,6 +202,39 @@ (define (sanitize path-fragment)
      ;; We also need to escape "/" because we use it as a delimiter.
      "/*.^$[]\\"
      #\\))
+  (define (file-sha256 file-name)
+    "Calculate the hexdigest of the sha256 checksum of FILE-NAME and return it."
+    (let ((port (open-pipe* OPEN_READ
+                            "sha256sum"
+                            "--"
+                            file-name)))
+      (let ((result (read-delimited " " port)))
+        (close-pipe port)
+        result)))
+  (define (paths-split-sort paths)
+    "Split list of PATHS at %DOCKER-IMAGE-MAX-LAYERS and sort by disk usage."
+    (let* ((paths-length (length paths))
+           (port (apply open-pipe* OPEN_READ
+                        (append '("du" "--summarize") paths)))
+           (output (read-string port)))
+      (close-port port)
+      (receive (head tail)
+          (split-at
+           (map (match-lambda ((size . path) path))
+                (sort (map (lambda (line)
+                             (match (string-split line #\tab)
+                               ((size path)
+                                (cons (string->number size) path))))
+                           (string-split
+                            (string-trim-right output #\newline)
+                            #\newline))
+                      (lambda (path1 path2)
+                        (< (match path2 ((size . _) size))
+                           (match path1 ((size . _) size))))))
+           (if (>= paths-length %docker-image-max-layers)
+               (- %docker-image-max-layers 2)
+               (1- paths-length)))
+        (list head tail))))
   (define transformation->replacement
     (match-lambda
       ((old '-> new)
@@ -205,7 +257,9 @@ (define transformation-options
         `("--transform" ,(transformations->expression transformations))))
   (let* ((directory "/tmp/docker-image") ;temporary working directory
          (id (docker-id prefix))
-         (time (date->string (time-utc->date creation-time) "~4"))
+         (time ;Workaround for Python datetime.fromisoformat does not parse Z.
+          (string-append (date->string (time-utc->date creation-time) "~5")
+                         "+00:00"))
          (arch (let-syntax ((cond* (syntax-rules ()
                                      ((_ (pattern clause) ...)
                                       (cond ((string-prefix? pattern system)
@@ -218,7 +272,8 @@ (define transformation-options
                         ("i686"    "386")
                         ("arm"     "arm")
                         ("aarch64" "arm64")
-                        ("mips64"  "mips64le")))))
+                        ("mips64"  "mips64le"))))
+         (paths (if stream-layered-image (paths-split-sort paths) paths)))
     ;; Make sure we start with a fresh, empty working directory.
     (mkdir directory)
     (with-directory-excursion directory
@@ -229,26 +284,38 @@ (define transformation-options
         (with-output-to-file "json"
           (lambda () (scm->json (image-description id time))))
 
-        ;; Create a directory for the non-store files that need to go into the
-        ;; archive.
-        (mkdir "extra")
+        (if root-system
+            (let ((directory (getcwd)))
+              (with-directory-excursion root-system
+                (apply invoke "tar"
+                       "-cf" (string-append directory "/layer.tar")
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." "..")))))))))
+            (begin
+              ;; Create a directory for the non-store files that need to go
+              ;; into the archive.
+              (mkdir "extra")
 
-        (with-directory-excursion "extra"
-          ;; Create non-store files.
-          (for-each (cut evaluate-populate-directive <> "./")
-                    extra-files)
+              (with-directory-excursion "extra"
+                ;; Create non-store files.
+                (for-each (cut evaluate-populate-directive <> "./")
+                          extra-files)
 
-          (when database
-            ;; Initialize /var/guix, assuming PREFIX points to a profile.
-            (install-database-and-gc-roots "." database prefix))
+                (when database
+                  ;; Initialize /var/guix, assuming PREFIX points to a profile.
+                  (install-database-and-gc-roots "." database prefix))
 
-          (apply invoke "tar" "-cf" "../layer.tar"
-                 `(,@transformation-options
-                   ,@(tar-base-options)
-                   ,@paths
-                   ,@(scandir "."
-                              (lambda (file)
-                                (not (member file '("." ".."))))))))
+                (apply invoke "tar" "-cf" "../layer.tar"
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(if stream-layered-image '() paths)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." ".."))))))))
+              (delete-file-recursively "extra")))
 
         ;; It is possible for "/" to show up in the archive, especially when
         ;; applying transformations.  For example, the transformation
@@ -263,22 +330,65 @@ (define transformation-options
           (lambda ()
             (system* "tar" "--delete" "/" "-f" "layer.tar")))
 
-        (delete-file-recursively "extra"))
+        (when stream-layered-image
+          (call-with-output-file "checksum"
+            (lambda (port)
+              (display (file-sha256 "layer.tar") port)))))
 
       (with-output-to-file "config.json"
         (lambda ()
-          (scm->json (config (string-append id "/layer.tar")
-                             time arch
-                             #:environment environment
-                             #:entry-point entry-point))))
+          (scm->json
+           (if stream-layered-image
+               `(("created" . ,time)
+                 ("repo_tag" . "guix:latest")
+                 ("customisation_layer" . ,id)
+                 ("store_layers" . ,(match paths
+                                      (((head ...) (tail ...))
+                                       (list->vector
+                                        (reverse
+                                         (cons (list->vector tail)
+                                               (fold (lambda (path paths)
+                                                       (cons (vector path) paths))
+                                                     '()
+                                                     head)))))))
+                 ("store_dir" . ,(%store-directory))
+                 ("from_image" . #nil)
+                 ("os" . "linux")
+                 ("config"
+                  (env . ,(list->vector (map (match-lambda
+                                               ((name . value)
+                                                (string-append name "=" value)))
+                                             environment)))
+                  ,@(if entry-point
+                        `((entrypoint . ,(list->vector entry-point)))
+                        '()))
+                 ("architecture" . ,arch))
+               (config (string-append id "/layer.tar")
+                       time arch
+                       #:environment environment
+                       #:entry-point entry-point)))))
       (with-output-to-file "manifest.json"
         (lambda ()
           (scm->json (manifest prefix id repository))))
       (with-output-to-file "repositories"
         (lambda ()
-          (scm->json (repositories prefix id repository)))))
-
-    (apply invoke "tar" "-cf" image "-C" directory
-           `(,@(tar-base-options #:compressor compressor)
-             "."))
+          (scm->json (repositories prefix id repository))))
+      (if stream-layered-image
+          (let ((input (open-pipe* OPEN_READ "python3"
+                                   stream-layered-image
+                                   "config.json")))
+            (call-with-output-file "image.tar"
+              (lambda (output)
+                (dump-port input output)))
+            (if (eqv? 0 (status:exit-val (close-pipe input)))
+                (begin
+                  (invoke "gzip" "image.tar")
+                  (copy-file "image.tar.gz" image))
+                (error
+                 (formatted-message
+                  (G_ "failed to create ~a image tarball")
+                  image))))
+          (apply invoke "tar" "-cf" image
+                 `(,@(tar-base-options #:compressor compressor)
+                   "."))))
     (delete-file-recursively directory)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 25ac9d29d0..3a8f87e850 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2020 Eric Bavier <bavier <at> posteo.net>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@ (define-module (guix scripts pack)
   #:use-module (guix scripts)
   #:use-module (guix ui)
   #:use-module (guix gexp)
+  #:use-module ((guix build utils) #:select (%xz-parallel-args))
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
@@ -53,6 +55,8 @@ (define-module (guix scripts pack)
   #:use-module ((gnu packages compression) #:hide (zip))
   #:use-module (gnu packages guile)
   #:use-module (gnu packages base)
+  #:use-module (gnu packages python)
+  #:autoload   (gnu packages package-management) (guix)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:autoload   (gnu packages guile) (guile2.0-json guile-json)
   #:use-module (srfi srfi-1)
@@ -67,6 +71,7 @@ (define-module (guix scripts pack)
             debian-archive
             rpm-archive
             docker-image
+            docker-layered-image
             squashfs-image
 
             %formats
@@ -589,6 +594,10 @@ (define (mksquashfs args)
 ;;;
 ;;; Docker image format.
 ;;;
+
+(define stream-layered-image.py
+  (local-file (search-auxiliary-file "python/stream-layered-image.py")))
+
 (define* (docker-image name profile
                        #:key target
                        (profile-name "guix-profile")
@@ -597,12 +606,14 @@ (define* (docker-image name profile
                        localstatedir?
                        (symlinks '())
                        (archiver tar)
-                       (extra-options '()))
+                       (extra-options '())
+                       layered-image?)
   "Return a derivation to construct a Docker image of PROFILE.  The
 image is a tarball conforming to the Docker Image Specification, compressed
 with COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it
 must a be a GNU triplet and it is used to derive the architecture metadata in
-the image."
+the image.  If LAYERED-IMAGE? is true, the image will with many of the
+store paths being on their own layer to improve sharing between images."
   (define database
     (and localstatedir?
          (file-append (store-database (list profile))
@@ -653,25 +664,37 @@ (define directives
               `((directory "/tmp" ,(getuid) ,(getgid) #o1777)
                 ,@(append-map symlink->directives '#$symlinks)))
 
-            (setenv "PATH" #+(file-append archiver "/bin"))
-
-            (build-docker-image #$output
-                                (map store-info-item
-                                     (call-with-input-file "profile"
-                                       read-reference-graph))
-                                #$profile
-                                #:repository (manifest->friendly-name
-                                              (profile-manifest #$profile))
-                                #:database #+database
-                                #:system (or #$target %host-type)
-                                #:environment environment
-                                #:entry-point
-                                #$(and entry-point
-                                       #~(list (string-append #$profile "/"
-                                                              #$entry-point)))
-                                #:extra-files directives
-                                #:compressor #+(compressor-command compressor)
-                                #:creation-time (make-time time-utc 0 1))))))
+            (setenv "PATH"
+                    (string-join `(#+(file-append archiver "/bin")
+                                   #+@(if layered-image?
+                                          (list (file-append coreutils "/bin")
+                                                (file-append gzip "/bin")
+                                                (file-append python "/bin"))
+                                          '()))
+                                 ":"))
+
+            (apply build-docker-image
+                   (append (list #$output
+                                 (map store-info-item
+                                      (call-with-input-file "profile"
+                                        read-reference-graph))
+                                 #$profile
+                                 #:repository (manifest->friendly-name
+                                               (profile-manifest #$profile))
+                                 #:database #+database
+                                 #:system (or #$target %host-type)
+                                 #:environment environment
+                                 #:entry-point
+                                 #$(and entry-point
+                                        #~(list (string-append #$profile "/"
+                                                               #$entry-point)))
+                                 #:extra-files directives
+                                 #:compressor #+(compressor-command compressor)
+                                 #:creation-time (make-time time-utc 0 1))
+                           (if #$layered-image?
+                               (list #:stream-layered-image
+                                     #$stream-layered-image.py)
+                               '())))))))
 
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
@@ -679,6 +702,33 @@ (define directives
                     #:target target
                     #:references-graphs `(("profile" ,profile))))
 
+(define* (docker-layered-image name profile
+                               #:key target
+                               (profile-name "guix-profile")
+                               (compressor (first %compressors))
+                               entry-point
+                               localstatedir?
+                               (symlinks '())
+                               (archiver tar)
+                               (extra-options '())
+                               (layered-image? #t))
+  "Return a derivation to construct a Docker image of PROFILE.  The image is a
+tarball conforming to the Docker Image Specification, compressed with
+COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it must a
+be a GNU triplet and it is used to derive the architecture metadata in the
+image.  If LAYERED-IMAGE? is true, the image will with many of the store paths
+being on their own layer to improve sharing between images."
+  (docker-image name profile
+                #:target target
+                #:profile-name profile-name
+                #:compressor compressor
+                #:entry-point entry-point
+                #:localstatedir? localstatedir?
+                #:symlinks symlinks
+                #:archiver archiver
+                #:extra-options extra-options
+                #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Debian archive format.
@@ -1355,6 +1405,7 @@ (define %formats
   `((tarball . ,self-contained-tarball)
     (squashfs . ,squashfs-image)
     (docker  . ,docker-image)
+    (docker-layered  . ,docker-layered-image)
     (deb . ,debian-archive)
     (rpm . ,rpm-archive)))
 
@@ -1363,15 +1414,17 @@ (define (show-formats)
   (display (G_ "The supported formats for 'guix pack' are:"))
   (newline)
   (display (G_ "
-  tarball       Self-contained tarball, ready to run on another machine"))
+  tarball        Self-contained tarball, ready to run on another machine"))
+  (display (G_ "
+  squashfs       Squashfs image suitable for Singularity"))
   (display (G_ "
-  squashfs      Squashfs image suitable for Singularity"))
+  docker         Tarball ready for 'docker load'"))
   (display (G_ "
-  docker        Tarball ready for 'docker load'"))
+  docker-layered Tarball with a layered image ready for 'docker load'"))
   (display (G_ "
-  deb           Debian archive installable via dpkg/apt"))
+  deb            Debian archive installable via dpkg/apt"))
   (display (G_ "
-  rpm           RPM archive installable via rpm/yum"))
+  rpm            RPM archive installable via rpm/yum"))
   (newline))
 
 (define (required-option symbol)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d7163dd3eb..e4bf0347c7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2022 Tobias Geerinckx-Rice <me <at> tobias.gr>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -727,13 +728,15 @@ (define* (system-derivation-for-action image action
                                               #:graphic? graphic?
                                               #:disk-image-size image-size
                                               #:mappings mappings))
-      ((image disk-image vm-image docker-image)
+      ((image disk-image vm-image docker-image docker-layered-image)
        (when (eq? action 'disk-image)
          (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'vm-image)
          (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'docker-image)
          (warning (G_ "'docker-image' is deprecated: use 'image' instead~%")))
+       (when (eq? action 'docker-layered-image)
+         (warning (G_ "'docker-layered-image' is deprecated: use 'image' instead~%")))
        (lower-object (system-image image))))))
 
 (define (maybe-suggest-running-guix-pull)
@@ -980,6 +983,8 @@ (define (show-help)
    image            build a Guix System image\n"))
   (display (G_ "\
    docker-image     build a Docker image\n"))
+  (display (G_ "\
+   docker-layered-image build a Docker layered image\n"))
   (display (G_ "\
    init             initialize a root file system to run GNU\n"))
   (display (G_ "\
@@ -1193,7 +1198,7 @@ (define actions '("build" "container" "vm" "vm-image" "image" "disk-image"
                   "list-generations" "describe"
                   "delete-generations" "roll-back"
                   "switch-generation" "search" "edit"
-                  "docker-image"))
+                  "docker-image" "docker-layered-image"))
 
 (define (process-action action args opts)
   "Process ACTION, a sub-command, with the arguments are listed in ARGS.
@@ -1242,6 +1247,8 @@ (define save-provenance?
          (image       (let* ((image-type (case action
                                            ((vm-image) qcow2-image-type)
                                            ((docker-image) docker-image-type)
+                                           ((docker-layered-image)
+                                            docker-layered-image-type)
                                            (else image-type)))
                             (image-size (assoc-ref opts 'image-size))
                             (volatile?
diff --git a/tests/pack.scm b/tests/pack.scm
index 87187bb62c..db2208d91c 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@ (define-module (test-pack)
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix utils)
+  #:use-module ((guix build utils) #:select (%store-directory))
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (glibc-utf8-locales))
   #:use-module (gnu packages bootstrap)
@@ -246,6 +248,52 @@ (define bin
                             (mkdir #$output)))))))
       (built-derivations (list check))))
 
+  (unless store (test-skip 1))
+  (test-assertm "docker-layered-image + localstatedir" store
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile -> (profile
+                      (content (packages->manifest (list %bootstrap-guile)))
+                      (hooks '())
+                      (locales? #f)))
+         (tarball (docker-layered-image "docker-pack" profile
+                                #:symlinks '(("/bin/Guile" -> "bin/guile"))
+                                #:localstatedir? #t))
+         (check   (gexp->derivation "check-tarball"
+                    (with-imported-modules '((guix build utils))
+                      #~(begin
+                          (use-modules (guix build utils)
+                                       (ice-9 match))
+
+                          (define bin
+                            (string-append "." #$profile "/bin"))
+
+                          (define store
+                            (string-append "." #$(%store-directory)))
+
+                          (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+                          (mkdir "base")
+                          (with-directory-excursion "base"
+                            (invoke "tar" "xvf" #$tarball))
+
+                          (match (find-files "base" "layer.tar")
+                            ((layers ...)
+                             (for-each (lambda (layer)
+                                         (invoke "tar" "xvf" layer)
+                                         (invoke "chmod" "--recursive" "u+w" store))
+                                       layers)))
+
+                          (when
+                              (and (file-exists? (string-append bin "/guile"))
+                                   (file-exists? "var/guix/db/db.sqlite")
+                                   (file-is-directory? "tmp")
+                                   (string=? (string-append #$%bootstrap-guile "/bin")
+                                             (pk 'binlink (readlink bin)))
+                                   (string=? (string-append #$profile "/bin/guile")
+                                             (pk 'guilelink (readlink "bin/Guile"))))
+                            (mkdir #$output)))))))
+      (built-derivations (list check))))
+
   (unless store (test-skip 1))
   (test-assertm "squashfs-image + localstatedir" store
     (mlet* %store-monad
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 00:27:02 GMT) Full text and rfc822 format available.

Message #32 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: pelzflorian <at> pelzflorian.de
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, 62153 <at> debbugs.gnu.org
Subject: [PATCH 2/2] news: Add entry for the new 'docker-layered' distribution
 format.
Date: Tue, 14 Mar 2023 03:24:53 +0300
* etc/news.scm: Add entry.
---
 etc/news.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index 55d1218df5..4bbdfd2a59 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -18,6 +18,7 @@
 ;; Copyright © 2021 Andrew Tropin <andrew <at> trop.in>
 ;; Copyright © 2021 Jonathan Brielmaier <jonathan.brielmaier <at> web.de>
 ;; Copyright © 2022 Thiago Jung Bauermann <bauermann <at> kolabnow.com>
+;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -26,6 +27,63 @@
 (channel-news
  (version 0)
 
+ (entry (commit "a5c3baf510adab1f5b3bb855b1aa9cafe3cb66b9")
+        (title
+         (de "Neues Format @samp{docker-layered} für den Befehl @command{guix pack}")
+         (en "New @samp{docker-layered} format for the @command{guix pack} command")
+         (ru "Новый @samp{docker-layered} формат для @command{guix pack} команды"))
+        (body
+         (de "Sie können jetzt auch mehrschichtige Docker-Abbilder mit dem Befehl
+@command{guix pack --format=docker-layered} erzeugen. Damit bekommen Sie ein
+Docker-Abbild, bei dem Store-Pfade auf getrennten Schichten („Layer“)
+untergebracht sind, die sich mehrere Abbilder teilen können.  Das Abbild wird
+im Store als gzip-komprimierter Tarball erzeugt.  Hier ist ein einfaches
+Beispiel, wo ein mehrschichtiges Docker-Abbild für das Paket @code{hello}
+angelegt wird:
+
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+@command{guix system image} kann jetzt geschichtete Docker-Abbilder erzeugen,
+indem Sie @code{docker-layered} an die Befehlszeilenoption @option{--image-type}
+übergeben.
+
+Siehe @command{info \"(guix.de) Aufruf von guix pack\"} und
+@command{info \"(guix.de) Systemabbilder\"} für weitere Informationen.")
+         (en "Docker layered images can now be produced via the @command{guix
+pack --format=docker-layered} command, providing a Docker image with many of
+the store paths being on their own layer to improve sharing between images.
+The image is realized into the GNU store as a gzipped tarball.  Here is a
+simple example that generates a layered Docker image for the @code{hello}
+package:
+
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+The @command{guix system image} can now produce layered Docker image by passing
+@code{docker-layered} to @option{--image-type} option.
+
+See @command{info \"(guix) Invoking guix pack\"} and
+@command{info \"(guix) System Images\"} for more information.")
+         (ru "Появилась команда создания многослойных Docker образов с помощью
+@command{guix pack --format=docker-layered}, которая соберет Docker образ с
+путями в store расположенными на отдельных слоях, ускоряя таким образом
+передачу образов.  Образ будет создан в GNU store в качестве gzipped tarball.
+
+Пример создания Docker layered образ с @code{hello} пакетом:
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+@command{guix system image} теперь может создавать layered Docker образ путем
+указания в опции @option{--image-type} параметра @code{docker-layered}.
+
+Смотрите @command{info \"(guix) Invoking guix pack\"} и
+@command{info \"(guix) System Images\"} для получения более детальных
+сведений.")))
+
  (entry (commit "0e18c5e5bcb9204c278cfc75493d3b02b746d5c3")
         (title
          (en "Linux-libre kernel updated to 6.2")
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 00:41:01 GMT) Full text and rfc822 format available.

Message #35 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Subject: Missing diff in cover lever for v2 patch
Date: Tue, 14 Mar 2023 03:40:24 +0300
[Message part 1 (text/plain, inline)]
Missing diff in cover leter for v2 patch attached below.

> This patch series applies your suggestions.  Also it's rebased on
> origin/master and added a missing documentation for ‘docker-layered’ format in
> ‘guix system image’ command in doc/guix.texi file (following diff).

--8<---------------cut here---------------start------------->8---
diff --git a/doc/guix.texi b/doc/guix.texi
index bd0ee126ee..6938743154 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -43306,6 +43306,8 @@ one or multiple partitions.
 
 @item @code{docker}, a Docker image.
 
+@item @code{docker-layered}, a layered Docker image.
+
 @item @code{iso9660}, an ISO-9660 image.
 
 @item @code{tarball}, a tar.gz image archive.
--8<---------------cut here---------------end--------------->8---
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 08:47:02 GMT) Full text and rfc822 format available.

Message #38 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Tobias Geerinckx-Rice <me <at> tobias.gr>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Christopher Baines <mail <at> cbaines.net>, Ricardo Wurmus <rekado <at> elephly.net>,
 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/2] guix: docker: Build layered image.
Date: Tue, 14 Mar 2023 09:19:51 +0100
Hi Oleg,

CC: core teams

On Tue, 14 Mar 2023 at 00:10, Oleg Pykhalov <go.wigust <at> gmail.com> wrote:

>>> diff --git a/gnu/packages/aux-files/python/stream-layered-image.py b/gnu/packages/aux-files/python/stream-layered-image.py
>>> new file mode 100644
>>> index 0000000000..9ad2168c2d
>>> --- /dev/null
>>> +++ b/gnu/packages/aux-files/python/stream-layered-image.py
>>> @@ -0,0 +1,391 @@
>>> +"""
>>> +This script generates a Docker image from a set of store paths. Uses
>>> +Docker Image Specification v1.2 as reference [1].
>>
>> Instead of Python, would it possible to implement in Guile?  I mean,
>> does Python have something that is missing in Guile?
>>
>> The facility for manipulating Tar?  Something else?
>
> I think nothing else.  As I understand Python implemented Tar inside the
> language itself in 2500 lines of code by manipulating binary data.
>
>     /gnu/store/...-python-3.9.9/lib/python3.9/tarfile.py
>
> Technically it's probably possible to use tar utility with --append flag
> instead of opening a new file and streaming to it as the Python script
> does.  To be honest I would like not to write it in this way if the
> Python script does not block current patch for merge.

Ok, thanks for explaining.

> Also I don't see myself writing Tar implementation in Guile, yet.  ;-)

Maybe not reimplementing Tar in Guile, maybe just enough for working.
Or maybe some Guile bindings.  Or maybe something is already around for
the bootstrap story.

The use of external tools as Python for producing built-in Guix feature
will be the first time, no?

For what it is worth, I would prefer to consider the options before
emitting an opinion about dragging Python building/packing layered
Docker. :-)

> The Nix project uses this script heavily to build layered images, so it
> should be robust in terms of up to date to current Tar and Python
> implementations.

Do you mean this script is coming from Nix.  Well, in all cases, this
script is not trivial and so it requires Copyright for authorship.



[...]


> The following example shows common layers between images, which will be
> not tranfered if you load image inside Docker as well as pull and push:

Thanks for explaining.


Cheers,
simon

PS: I will be off-line these 2-3 next weeks.  So a lack of an answer
from me will not be a lack of interest. ;-)




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 09:13:02 GMT) Full text and rfc822 format available.

Message #41 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Christopher Baines <mail <at> cbaines.net>
To: Simon Tournier <zimon.toutoune <at> gmail.com>
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, guix-patches <at> gnu.org,
 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/2] guix: docker: Build layered image.
Date: Tue, 14 Mar 2023 09:11:36 +0000
[Message part 1 (text/plain, inline)]
Simon Tournier <zimon.toutoune <at> gmail.com> writes:

> And I remember something in that direction by Chris but I am unable to
> find back the patch. )-:

This is the thread
https://lists.gnu.org/archive/html/guix-devel/2020-03/msg00299.html
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 09:13:02 GMT) Full text and rfc822 format available.

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 14 Mar 2023 09:18:02 GMT) Full text and rfc822 format available.

Message #47 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <rekado <at> elephly.net>
To: Simon Tournier <zimon.toutoune <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Tobias Geerinckx-Rice <me <at> tobias.gr>,
 Oleg Pykhalov <go.wigust <at> gmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Christopher Baines <mail <at> cbaines.net>, Mathieu Othacehe <othacehe <at> gnu.org>,
 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/2] guix: docker: Build layered image.
Date: Tue, 14 Mar 2023 10:15:49 +0100
Simon Tournier <zimon.toutoune <at> gmail.com> writes:

>>> Instead of Python, would it possible to implement in Guile?  I mean,
>>> does Python have something that is missing in Guile?
>>>
>>> The facility for manipulating Tar?  Something else?
>>
>> I think nothing else.  As I understand Python implemented Tar inside the
>> language itself in 2500 lines of code by manipulating binary data.
>>
>>     /gnu/store/...-python-3.9.9/lib/python3.9/tarfile.py
>>
>> Technically it's probably possible to use tar utility with --append flag
>> instead of opening a new file and streaming to it as the Python script
>> does.  To be honest I would like not to write it in this way if the
>> Python script does not block current patch for merge.
>
> Ok, thanks for explaining.
>
>> Also I don't see myself writing Tar implementation in Guile, yet.  ;-)
>
> Maybe not reimplementing Tar in Guile, maybe just enough for working.
> Or maybe some Guile bindings.  Or maybe something is already around for
> the bootstrap story.

gash-utils has (gash ustar); it’s about 620 lines of code.

-- 
Ricardo




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Thu, 16 Mar 2023 10:39:02 GMT) Full text and rfc822 format available.

Message #50 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Ricardo Wurmus <rekado <at> elephly.net>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Tobias Geerinckx-Rice <me <at> tobias.gr>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Oleg Pykhalov <go.wigust <at> gmail.com>,
 Christopher Baines <mail <at> cbaines.net>, Mathieu Othacehe <othacehe <at> gnu.org>,
 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/2] guix: docker: Build layered image.
Date: Thu, 16 Mar 2023 11:37:58 +0100
Hi,

Ricardo Wurmus <rekado <at> elephly.net> skribis:

> Simon Tournier <zimon.toutoune <at> gmail.com> writes:
>
>>>> Instead of Python, would it possible to implement in Guile?  I mean,
>>>> does Python have something that is missing in Guile?
>>>>
>>>> The facility for manipulating Tar?  Something else?
>>>
>>> I think nothing else.  As I understand Python implemented Tar inside the
>>> language itself in 2500 lines of code by manipulating binary data.
>>>
>>>     /gnu/store/...-python-3.9.9/lib/python3.9/tarfile.py
>>>
>>> Technically it's probably possible to use tar utility with --append flag
>>> instead of opening a new file and streaming to it as the Python script
>>> does.  To be honest I would like not to write it in this way if the
>>> Python script does not block current patch for merge.
>>
>> Ok, thanks for explaining.
>>
>>> Also I don't see myself writing Tar implementation in Guile, yet.  ;-)
>>
>> Maybe not reimplementing Tar in Guile, maybe just enough for working.
>> Or maybe some Guile bindings.  Or maybe something is already around for
>> the bootstrap story.
>
> gash-utils has (gash ustar); it’s about 620 lines of code.

Disarchive also has a tar implementation.  No excuse!  :-)

Oleg, could you check which of these would satisfy your needs?  I had a
plan to improve the tar implementation in Gash-Utils, perhaps it’s a
good time to get my act together.

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 20 Mar 2023 06:39:02 GMT) Full text and rfc822 format available.

Message #53 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Tobias Geerinckx-Rice <me <at> tobias.gr>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Christopher Baines <mail <at> cbaines.net>, Ricardo Wurmus <rekado <at> elephly.net>,
 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/2] guix: docker: Build layered image.
Date: Mon, 20 Mar 2023 09:38:22 +0300
[Message part 1 (text/plain, inline)]
Hi Ludovic,

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

> Ricardo Wurmus <rekado <at> elephly.net> skribis:
>
>> Simon Tournier <zimon.toutoune <at> gmail.com> writes:
>>
>>>>> Instead of Python, would it possible to implement in Guile?  I mean,
>>>>> does Python have something that is missing in Guile?
>>>>>
>>>>> The facility for manipulating Tar?  Something else?
>>>>
>>>> I think nothing else.  As I understand Python implemented Tar inside the
>>>> language itself in 2500 lines of code by manipulating binary data.
>>>>
>>>>     /gnu/store/...-python-3.9.9/lib/python3.9/tarfile.py
>>>>
>>>> Technically it's probably possible to use tar utility with --append flag
>>>> instead of opening a new file and streaming to it as the Python script
>>>> does.  To be honest I would like not to write it in this way if the
>>>> Python script does not block current patch for merge.
>>>
>>> Ok, thanks for explaining.
>>>
>>>> Also I don't see myself writing Tar implementation in Guile, yet.  ;-)
>>>
>>> Maybe not reimplementing Tar in Guile, maybe just enough for working.
>>> Or maybe some Guile bindings.  Or maybe something is already around for
>>> the bootstrap story.
>>
>> gash-utils has (gash ustar); it’s about 620 lines of code.
>
> Disarchive also has a tar implementation.  No excuse!  :-)
>
> Oleg, could you check which of these would satisfy your needs?  I had a
> plan to improve the tar implementation in Gash-Utils, perhaps it’s a
> good time to get my act together.

Gash-Utils should work, e.g. [1] script.  It's already possible to
rewrite with Gash-Utils, but at least write-ustar-file and
write-ustar-footer should be exported in ustar.scm.

Disarchive requires to write a file specification in case of using
disarchive-assemble.  And disarchive-assemble does not work, if I don't
miss anything [2].  Also gzip compression does not work in a Guile REPL.

[1]:

--8<---------------cut here---------------start------------->8---
#!/usr/bin/env -S guile --no-auto-compile -e main -s
!#

(set! %load-path
      (append '("/gnu/store/...-gash-utils-0.1.0/share/guile/site/3.0"
                "/gnu/store/...-gash-0.2.0/share/guile/site/3.0")
              %load-path))

(set! %load-compiled-path
      (append '("/gnu/store/...-gash-utils-0.1.0/lib/guile/3.0/site-ccache"
                "/gnu/store/...-gash-0.2.0/lib/guile/3.0/site-ccache")
              %load-compiled-path))

(use-modules (gash ustar)
             (srfi srfi-26)
             (guix build utils))

(define write-ustar-file
  (@@ (gash ustar) write-ustar-file))

(define write-ustar-footer
  (@@ (gash ustar) write-ustar-footer))

(define (main . args)
  (call-with-port (open-file "out.tar.gz" "wb")
    (lambda (port)
      (with-directory-excursion "."
        (call-with-compressed-output-port 'gzip port
          (cut write-ustar-file <> "Makefile.am"
               #:verbosity 0)))
      (with-directory-excursion "doc"
        (call-with-compressed-output-port 'gzip port
          (cut write-ustar-file <> "."
               #:verbosity 0)))
      (write-ustar-footer port))))
--8<---------------cut here---------------end--------------->8---

[2]:

--8<---------------cut here---------------start------------->8---
$ guile
,m(disarchive assemblers tarball)
(assemble-tarball (disassemble-tarball "out.tar") "result/out.tar")

# Generated tarball:
$ tar tf result/out.tar/sha256/1e7100029373723df900712d1191be0bad5beadf752f367bb264fab891c36356
./
./images/
./images/bootstrap-graph.dot
./images/service-graph.pdf
./guix-cookbook.zh_Hans.texi
tar: Unexpected EOF in archive
tar: Error is not recoverable: exiting now

# Original tarball:
$ tar tf out.tar
./
./images/
./images/bootstrap-graph.dot
./images/bootstrap-graph.eps
./images/bootstrap-graph.pdf
./images/bootstrap-graph.png
./images/bootstrap-packages.dot
./images/bootstrap-packages.eps
./images/bootstrap-packages.pdf
./images/bootstrap-packages.png
./images/coreutils-bag-graph.dot
./images/coreutils-bag-graph.eps
./images/coreutils-bag-graph.pdf
./images/coreutils-bag-graph.png
./images/coreutils-graph.dot
./images/coreutils-graph.eps
./images/coreutils-graph.pdf
./images/coreutils-graph.png
./images/coreutils-size-map.eps
./images/coreutils-size-map.png
./images/gcc-core-mesboot0-graph.dot
./images/gcc-core-mesboot0-graph.eps
./images/gcc-core-mesboot0-graph.pdf
./images/gcc-core-mesboot0-graph.png
./images/installer-network.png
./images/installer-partitions.png
./images/installer-resume.png
./images/service-graph.dot
./images/service-graph.eps
./images/service-graph.pdf
./images/service-graph.png
./images/shepherd-graph.dot
./images/shepherd-graph.eps
./images/shepherd-graph.pdf
./images/shepherd-graph.png
./.dirstamp
./environment-gdb.scm
./fdl-1.3.texi
./os-config-bare-bones.texi
./os-config-desktop.texi
./os-config-lightweight-desktop.texi
./package-hello.json
./package-hello.scm
./stamp-1
./stamp-10
./stamp-11
./stamp-2
./stamp-3
./stamp-4
./stamp-5
./stamp-6
./stamp-7
./stamp-8
./stamp-9
./stamp-vti
./contributing.fa.texi
./guix.fa.texi
./contributing.fi.texi
./guix.fi.texi
./contributing.it.texi
./guix.it.texi
./contributing.ko.texi
./guix.ko.texi
./contributing.sk.texi
./guix.sk.texi
./guix-cookbook.es.texi
./guix-cookbook.fa.texi
./guix-cookbook.fi.texi
./guix-cookbook.pt_BR.texi
./guix-cookbook.ru.texi
./guix-cookbook.zh_Hans.texi
./version-fa.texi
./guix.fa.info-1
./guix.fa.info-2
./guix.fa.info-3
./guix.fa.info-4
./guix.fa.info-5
./guix.fa.info-6
./guix.fa.info
./version-fi.texi
./guix.fi.info-1
./guix.fi.info-2
./guix.fi.info-3
./guix.fi.info-4
./guix.fi.info-5
./guix.fi.info-6
./guix.fi.info
./version-it.texi
./guix.it.info-1
./guix.it.info-2
./guix.it.info-3
./guix.it.info-4
./guix.it.info-5
./guix.it.info-6
./guix.it.info
./version-ko.texi
./guix.ko.info-1
./guix.ko.info-2
./guix.ko.info-3
./guix.ko.info-4
./guix.ko.info-5
./guix.ko.info-6
./guix.ko.info
./version-sk.texi
./guix.sk.info-1
./guix.sk.info-2
./guix.sk.info-3
./guix.sk.info-4
./guix.sk.info-5
./guix.sk.info-6
./guix.sk.info
./guix-cookbook.es.info
./guix-cookbook.fa.info
./guix-cookbook.fi.info
./guix-cookbook.pt_BR.info
./guix-cookbook.ru.info
./guix-cookbook.zh_Hans.info
./he-config-bare-bones.scm
./guix-lint.1
./build.scm
./contributing.texi
./guix-cookbook.texi
./htmlxref.cnf
./local.mk
./guix-cookbook.info
./guix-gc.1
./guix-git.1
./guix-container.1
./guix-copy.1
./guix-describe.1
./guix-processes.1
./guix-size.1
./guix-weather.1
./guix-shell.1
./guix-cookbook.ko.texi
./guix-cookbook.fr.texi
./guix-cookbook.de.texi
./guix-cookbook.sk.texi
./contributing.zh_CN.texi
./contributing.ru.texi
./contributing.pt_BR.texi
./contributing.fr.texi
./contributing.es.texi
./contributing.de.texi
./guix.zh_CN.texi
./guix.ru.texi
./guix.pt_BR.texi
./guix.de.texi
./guix.es.texi
./guix.fr.texi
./guix-cookbook.sk.info
./guix-cookbook.de.info
./guix-cookbook.fr.info
./guix-cookbook.ko.info
./version-de.texi
./version-ru.texi
./version-fr.texi
./version-es.texi
./version-pt_BR.texi
./version-zh_CN.texi
./guix-daemon.1
./guix.pt_BR.info-1
./guix.pt_BR.info-2
./guix.fr.info-1
./guix.fr.info-2
./guix.de.info-1
./guix.de.info-2
./guix.pt_BR.info-3
./guix.ru.info-1
./guix.ru.info-2
./guix.fr.info-3
./guix.ru.info-3
./guix.zh_CN.info-1
./guix.zh_CN.info-2
./guix.es.info-1
./guix.es.info-2
./guix.de.info-3
./guix.pt_BR.info-4
./guix.fr.info-4
./guix.ru.info-4
./guix.zh_CN.info-3
./guix.de.info-4
./guix.es.info-3
./guix.ru.info-5
./guix.pt_BR.info-5
./guix.zh_CN.info-4
./guix.fr.info-5
./guix.es.info-4
./guix.de.info-5
./guix.pt_BR.info-6
./guix.ru.info-6
./guix.fr.info-6
./guix.pt_BR.info-7
./guix.es.info-5
./guix.zh_CN.info-5
./guix.de.info-6
./guix.pt_BR.info
./guix.ru.info-7
./guix.fr.info-7
./guix.ru.info-8
./guix.de.info-7
./guix.es.info-6
./guix.fr.info-8
./guix.zh_CN.info-6
./guix.ru.info
./guix.fr.info
./guix.de.info-8
./guix.zh_CN.info-7
./guix.es.info-7
./guix.de.info
./guix.zh_CN.info
./guix.es.info-8
./guix.es.info
./guix.texi
./version.texi
./guix.info-1
./guix.info-2
./guix.info-3
./guix.info-4
./guix.info-5
./guix.info-6
./guix.info-7
./guix.info
./guix-build.1
./guix-archive.1
./guix-import.1
./guix-offload.1
./guix-graph.1
./guix-hash.1
./guix-challenge.1
./guix-download.1
./guix-edit.1
./guix-repl.1
./guix-publish.1
./guix-package.1
./guix-style.1
./guix-pull.1
./guix-time-machine.1
./guix-environment.1
./guix-pack.1
./guix-deploy.1
./guix-refresh.1
./guix-home.1
./guix-system.1
./guix.1
--8<---------------cut here---------------end--------------->8---

Regards,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 20 Mar 2023 16:53:01 GMT) Full text and rfc822 format available.

Message #56 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Christopher Baines <mail <at> cbaines.net>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 62153 <at> debbugs.gnu.org
Subject: Re: bug#62153: [PATCH 0/2] Disarchive vs Gash-Utils for docker-layered
Date: Mon, 20 Mar 2023 19:51:52 +0300
[Message part 1 (text/plain, inline)]
Oleg Pykhalov <go.wigust <at> gmail.com> writes:

> […]
>
> And disarchive-assemble does not work, if I don't miss anything.

I forgot about that input tarball was generated with changing current
working directory, that's probably the reason of the broken archive.

According to "Assembles from stdin to file" test from
git.ngyro.com/disarchive/tests/cli.scm it is possible to generate a
tarball for docker-layered with Disarchive, but a file describing spec
like git.ngyro.com/disarchive/tests/data/test-archive.da is required.
Generation of this file without having a Tar archive beforehand is
complicated and because of that IMHO ustar.scm from Gash-Utils is
preferred for the task.

Regards,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 31 May 2023 08:46:01 GMT) Full text and rfc822 format available.

Message #59 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH] Add Docker layered image for pack and system (v3)
Date: Wed, 31 May 2023 11:45:29 +0300
Hi, Guix.

These patches series is rebased on origin/master. Also, the Python script is
replaced in favour of calls to GNU Tar and GNU Gzip programs.  Passed tests:
make check TESTS="tests/pack.scm"
make check-system TESTS="docker-system"
make check-system TESTS="docker-layered-system"
  

Oleg Pykhalov (2):
  guix: docker: Build layered image.
  news: Add entry for the new 'docker-layered' distribution format.

 doc/guix.texi           |  18 +++-
 etc/news.scm            |  58 ++++++++++++
 gnu/image.scm           |   3 +-
 gnu/system/image.scm    |  76 +++++++++++----
 gnu/tests/docker.scm    |  20 +++-
 guix/docker.scm         | 205 +++++++++++++++++++++++++++++++---------
 guix/scripts/pack.scm   |  62 ++++++++++--
 guix/scripts/system.scm |  11 ++-
 tests/pack.scm          |  48 ++++++++++
 9 files changed, 424 insertions(+), 77 deletions(-)


base-commit: 77f52db416a13e195d090cad4e9e7658feb2e86b
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 31 May 2023 08:49:02 GMT) Full text and rfc822 format available.

Message #62 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH] guix: docker: Build layered image.
Date: Wed, 31 May 2023 11:47:53 +0300
* doc/guix.texi (Invoking guix pack): Document docker-layered format.
(image Reference): Same.
(image-type Reference): Document docker-layered-image-type.
* gnu/image.scm
(validate-image-format)[docker-layered]: New image format.
* gnu/system/image.scm
(docker-layered-image, docker-layered-image-type): New variables.
(system-docker-image)[layered-image?]: New argument.
(system-docker-layered-image): New procedure.
(image->root-file-system)[docker-layered]: New image format.
* gnu/tests/docker.scm (%test-docker-layered-system): New test.
* guix/docker.scm (%docker-image-max-layers): New variable.
(build-docker-image)[stream-layered-image, root-system]: New arguments.
* guix/scripts/pack.scm (stream-layered-image.py): New variable.
(docker-image)[layered-image?]: New argument.
(docker-layered-image): New procedure.
(%formats)[docker-layered]: New format.
(show-formats): Document this.
* guix/scripts/system.scm
(system-derivation-for-action)[docker-layered-image]: New action.
(show-help): Document this.
(actions)[docker-layered-image]: New action.
(process-action): Add this.
* tests/pack.scm: Add "docker-layered-image + localstatedir" test.
---
 doc/guix.texi           |  18 +++-
 gnu/image.scm           |   3 +-
 gnu/system/image.scm    |  76 +++++++++++----
 gnu/tests/docker.scm    |  20 +++-
 guix/docker.scm         | 205 +++++++++++++++++++++++++++++++---------
 guix/scripts/pack.scm   |  62 ++++++++++--
 guix/scripts/system.scm |  11 ++-
 tests/pack.scm          |  48 ++++++++++
 8 files changed, 366 insertions(+), 77 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5fd2449ed5..1c95ec4320 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -56,7 +56,7 @@
 Copyright @copyright{} 2017, 2018, 2019, 2020 Arun Isaac@*
 Copyright @copyright{} 2017 nee@*
 Copyright @copyright{} 2018 Rutger Helling@*
-Copyright @copyright{} 2018, 2021 Oleg Pykhalov@*
+Copyright @copyright{} 2018, 2021, 2023 Oleg Pykhalov@*
 Copyright @copyright{} 2018 Mike Gerwitz@*
 Copyright @copyright{} 2018 Pierre-Antoine Rouby@*
 Copyright @copyright{} 2018, 2019 Gábor Boskovits@*
@@ -6984,9 +6984,15 @@ Invoking guix pack
 guix pack -f docker -S /bin=bin guile guile-readline
 @end example
 
+or
+
+@example
+guix pack -f docker-layered -S /bin=bin guile guile-readline
+@end example
+
 @noindent
-The result is a tarball that can be passed to the @command{docker load}
-command, followed by @code{docker run}:
+The result is a tarball with image or layered image that can be passed
+to the @command{docker load} command, followed by @code{docker run}:
 
 @example
 docker load < @var{file}
@@ -44309,6 +44315,8 @@ image Reference
 
 @item @code{docker}, a Docker image.
 
+@item @code{docker-layered}, a layered Docker image.
+
 @item @code{iso9660}, an ISO-9660 image.
 
 @item @code{tarball}, a tar.gz image archive.
@@ -44644,6 +44652,10 @@ image-type Reference
 Build an image based on the @code{docker-image} image.
 @end defvar
 
+@defvar docker-layered-image-type
+Build a layered image based on the @code{docker-layered-image} image.
+@end defvar
+
 @defvar raw-with-offset-image-type
 Build an MBR image with a single partition starting at a @code{1024KiB}
 offset.  This is useful to leave some room to install a bootloader in
diff --git a/gnu/image.scm b/gnu/image.scm
index 523653dd77..8a6a0d8479 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -152,7 +153,7 @@ (define-syntax-rule (define-set-sanitizer name field set)
 
 ;; The supported image formats.
 (define-set-sanitizer validate-image-format format
-  (disk-image compressed-qcow2 docker iso9660 tarball wsl2))
+  (disk-image compressed-qcow2 docker docker-layered iso9660 tarball wsl2))
 
 ;; The supported partition table types.
 (define-set-sanitizer validate-partition-table-type partition-table-type
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index afef79185f..3a502f19ec 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2022 Pavel Shlyak <p.shlyak <at> pantherx.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo <at> cyberdimension.org>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -78,6 +79,7 @@ (define-module (gnu system image)
             efi-disk-image
             iso9660-image
             docker-image
+            docker-layered-image
             tarball-image
             wsl2-image
             raw-with-offset-disk-image
@@ -89,6 +91,7 @@ (define-module (gnu system image)
             iso-image-type
             uncompressed-iso-image-type
             docker-image-type
+            docker-layered-image-type
             tarball-image-type
             wsl2-image-type
             raw-with-offset-image-type
@@ -167,6 +170,10 @@ (define docker-image
   (image-without-os
    (format 'docker)))
 
+(define docker-layered-image
+  (image-without-os
+   (format 'docker-layered)))
+
 (define tarball-image
   (image-without-os
    (format 'tarball)))
@@ -237,6 +244,11 @@ (define docker-image-type
    (name 'docker)
    (constructor (cut image-with-os docker-image <>))))
 
+(define docker-layered-image-type
+  (image-type
+   (name 'docker-layered)
+   (constructor (cut image-with-os docker-layered-image <>))))
+
 (define tarball-image-type
   (image-type
    (name 'tarball)
@@ -633,9 +645,12 @@ (define (image-with-label base-image label)
 
 (define* (system-docker-image image
                               #:key
-                              (name "docker-image"))
+                              (name "docker-image")
+                              (archiver tar)
+                              layered-image?)
   "Build a docker image for IMAGE.  NAME is the base name to use for the
-output file."
+output file.  If LAYERED-IMAGE? is true, the image will with many of the store
+paths being on their own layer to improve sharing between images."
   (define boot-program
     ;; Program that runs the boot script of OS, which in turn starts shepherd.
     (program-file "boot-program"
@@ -678,9 +693,11 @@ (define* (system-docker-image image
               (use-modules (guix docker)
                            (guix build utils)
                            (gnu build image)
+                           (srfi srfi-1)
                            (srfi srfi-19)
                            (guix build store-copy)
-                           (guix store database))
+                           (guix store database)
+                           (ice-9 receive))
 
               ;; Set the SQL schema location.
               (sql-schema #$schema)
@@ -700,18 +717,31 @@ (define* (system-docker-image image
                                            #:register-closures? #$register-closures?
                                            #:deduplicate? #f
                                            #:system-directory #$os)
-                (build-docker-image
-                 #$output
-                 (cons* image-root
-                        (map store-info-item
-                             (call-with-input-file #$graph
-                               read-reference-graph)))
-                 #$os
-                 #:entry-point '(#$boot-program #$os)
-                 #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
-                 #:creation-time (make-time time-utc 0 1)
-                 #:system #$image-target
-                 #:transformations `((,image-root -> ""))))))))
+                (when #$layered-image?
+                  (setenv "PATH"
+                          (string-join (list #+(file-append archiver "/bin")
+                                             #+(file-append coreutils "/bin")
+                                             #+(file-append gzip "/bin"))
+                                       ":")))
+                (apply build-docker-image
+                       (append (list #$output
+                                     (append (if #$layered-image?
+                                                 '()
+                                                 (list image-root))
+                                             (map store-info-item
+                                                  (call-with-input-file #$graph
+                                                    read-reference-graph)))
+                                     #$os
+                                     #:entry-point '(#$boot-program #$os)
+                                     #:compressor
+                                     '(#+(file-append gzip "/bin/gzip") "-9n")
+                                     #:creation-time (make-time time-utc 0 1)
+                                     #:system #$image-target
+                                     #:transformations `((,image-root -> "")))
+                               (if #$layered-image?
+                                   (list #:root-system image-root
+                                         #:layered-image? #$layered-image?)
+                                   '()))))))))
 
     (computed-file name builder
                    ;; Allow offloading so that this I/O-intensive process
@@ -720,6 +750,18 @@ (define* (system-docker-image image
                    #:options `(#:references-graphs ((,graph ,os))
                                #:substitutable? ,substitutable?))))
 
+(define* (system-docker-layered-image image
+                                      #:key
+                                      (name "docker-image")
+                                      (archiver tar)
+                                      (layered-image? #t))
+  "Build a docker image for IMAGE.  NAME is the base name to use for the
+output file."
+  (system-docker-image image
+                       #:name name
+                       #:archiver archiver
+                       #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Tarball image.
@@ -811,7 +853,7 @@ (define (image->root-file-system image)
   "Return the IMAGE root partition file-system type."
   (case (image-format image)
     ((iso9660) "iso9660")
-    ((docker tarball wsl2) "dummy")
+    ((docker docker-layered tarball wsl2) "dummy")
     (else
      (partition-file-system (find-root-partition image)))))
 
@@ -948,6 +990,8 @@ (define* (system-image image)
                                        ("bootcfg" ,bootcfg))))
        ((memq image-format '(docker))
         (system-docker-image image*))
+       ((memq image-format '(docker-layered))
+        (system-docker-layered-image image*))
        ((memq image-format '(tarball))
         (system-tarball-image image*))
        ((memq image-format '(wsl2))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index edc9804414..0cccc02ad2 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
 ;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,7 +44,8 @@ (define-module (gnu tests docker)
   #:use-module (guix build-system trivial)
   #:use-module ((guix licenses) #:prefix license:)
   #:export (%test-docker
-            %test-docker-system))
+            %test-docker-system
+            %test-docker-layered-system))
 
 (define %docker-os
   (simple-operating-system
@@ -316,3 +318,19 @@ (define %test-docker-system
                                    (locale-libcs (list glibc)))
                                  #:type docker-image-type)))
                  run-docker-system-test)))))
+
+(define %test-docker-layered-system
+  (system-test
+   (name "docker-layered-system")
+   (description "Run a system image as produced by @command{guix system
+docker-layered-image} inside Docker.")
+   (value (with-monad %store-monad
+            (>>= (lower-object
+                  (system-image (os->image
+                                 (operating-system
+                                   (inherit (simple-operating-system))
+                                   ;; Use locales for a single libc to
+                                   ;; reduce space requirements.
+                                   (locale-libcs (list glibc)))
+                                 #:type docker-layered-image-type)))
+                 run-docker-system-test)))))
diff --git a/guix/docker.scm b/guix/docker.scm
index 5e6460f43f..e10b940aa4 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich <at> gmail.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,8 @@ (define-module (guix docker)
                           delete-file-recursively
                           with-directory-excursion
                           invoke))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (gnu build install)
   #:use-module (json)                             ;guile-json
   #:use-module (srfi srfi-1)
@@ -38,6 +41,9 @@ (define-module (guix docker)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
   #:export (build-docker-image))
 
 ;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image.
@@ -92,12 +98,12 @@ (define (canonicalize-repository-name name)
                       (make-string (- min-length l) padding-character)))
       (_ normalized-name))))
 
-(define* (manifest path id #:optional (tag "guix"))
+(define* (manifest path layers #:optional (tag "guix"))
   "Generate a simple image manifest."
   (let ((tag (canonicalize-repository-name tag)))
     `#(((Config . "config.json")
         (RepoTags . #(,(string-append tag ":latest")))
-        (Layers . #(,(string-append id "/layer.tar")))))))
+        (Layers . ,(list->vector layers))))))
 
 ;; According to the specifications this is required for backwards
 ;; compatibility.  It duplicates information provided by the manifest.
@@ -106,8 +112,8 @@ (define* (repositories path id #:optional (tag "guix"))
   `((,(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 '()))
-  "Generate a minimal image configuration for the given LAYER file."
+(define* (config layers-diff-ids time arch #:key entry-point (environment '()))
+  "Generate a minimal image configuration for the given LAYERS files."
   ;; "architecture" must be values matching "platform.arch" in the
   ;; runtime-spec at
   ;; https://github.com/opencontainers/runtime-spec/blob/v1.0.0-rc2/config.md#platform
@@ -125,7 +131,7 @@ (define* (config layer time arch #:key entry-point (environment '()))
     (container_config . #nil)
     (os . "linux")
     (rootfs . ((type . "layers")
-               (diff_ids . #(,(layer-diff-id layer)))))))
+               (diff_ids . ,(list->vector layers-diff-ids))))))
 
 (define directive-file
   ;; Return the file or directory created by a 'evaluate-populate-directive'
@@ -136,6 +142,37 @@ (define directive-file
     (('directory name _ ...)
      (string-trim name #\/))))
 
+(define %docker-image-max-layers
+  100)
+
+(define (paths-split-sort paths)
+  "Split list of PATHS at %DOCKER-IMAGE-MAX-LAYERS and sort by disk usage."
+  (let* ((paths-length (length paths))
+         (port (apply open-pipe* OPEN_READ
+                      (append '("du" "--summarize") paths)))
+         (output (read-string port)))
+    (close-port port)
+    (receive (head tail)
+        (split-at
+         (map (match-lambda ((size . path) path))
+              (sort (map (lambda (line)
+                           (match (string-split line #\tab)
+                             ((size path)
+                              (cons (string->number size) path))))
+                         (string-split
+                          (string-trim-right output #\newline)
+                          #\newline))
+                    (lambda (path1 path2)
+                      (< (match path2 ((size . _) size))
+                         (match path1 ((size . _) size))))))
+         (if (>= paths-length %docker-image-max-layers)
+             (- %docker-image-max-layers 2)
+             (1- paths-length)))
+      (list head tail))))
+
+(define (create-empty-tar file)
+  (invoke "tar" "-cf" file "--files-from" "/dev/null"))
+
 (define* (build-docker-image image paths prefix
                              #:key
                              (repository "guix")
@@ -146,11 +183,13 @@ (define* (build-docker-image image paths prefix
                              entry-point
                              (environment '())
                              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.  REPOSITORY
-is a descriptive name that will show up in \"REPOSITORY\" column of the output
-of \"docker images\".
+                             (creation-time (current-time time-utc))
+                             layered-image?
+                             root-system)
+  "Write to IMAGE a layerer Docker image archive containing the given PATHS.
+PREFIX 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.
@@ -172,7 +211,14 @@ (define* (build-docker-image image paths prefix
 SYSTEM is a GNU triplet (or prefix thereof) of the system the binaries in
 PATHS are for; it is used to produce metadata in the image.  Use COMPRESSOR, a
 command such as '(\"gzip\" \"-9n\"), to compress IMAGE.  Use CREATION-TIME, a
-SRFI-19 time-utc object, as the creation time in metadata."
+SRFI-19 time-utc object, as the creation time in metadata.
+
+When LAYERED-IMAGE? is true build layered image, providing a Docker
+image with many of the store paths being on their own layer to improve sharing
+between images.
+
+ROOT-SYSTEM is a directory with a provisioned root file system, which will be
+added to image as a layer."
   (define (sanitize path-fragment)
     (escape-special-chars
      ;; GNU tar strips the leading slash off of absolute paths before applying
@@ -203,6 +249,53 @@ (define* (build-docker-image image paths prefix
     (if (eq? '() transformations)
         '()
         `("--transform" ,(transformations->expression transformations))))
+  (define layers-hashes
+    (match-lambda
+      (((head ...) (tail ...) id)
+       (create-empty-tar "image.tar")
+       (let* ((head-layers
+               (map
+                (lambda (file)
+                  (invoke "tar" "cf" "layer.tar" file)
+                  (let* ((file-hash (layer-diff-id "layer.tar"))
+                         (file-name (string-append file-hash "/layer.tar")))
+                    (mkdir file-hash)
+                    (rename-file "layer.tar" file-name)
+                    (invoke "tar" "-rf" "image.tar" file-name)
+                    (delete-file file-name)
+                    file-hash))
+                head))
+              (tail-layer
+               (begin
+                 (create-empty-tar "layer.tar")
+                 (for-each (lambda (file)
+                             (invoke "tar" "-rf" "layer.tar" file))
+                           tail)
+                 (let* ((file-hash (layer-diff-id "layer.tar"))
+                        (file-name (string-append file-hash "/layer.tar")))
+                   (mkdir file-hash)
+                   (rename-file "layer.tar" file-name)
+                   (invoke "tar" "-rf" "image.tar" file-name)
+                   (delete-file file-name)
+                   file-hash)))
+              (customization-layer
+               (let* ((file-id (string-append id "/layer.tar"))
+                      (file-hash (layer-diff-id file-id))
+                      (file-name (string-append file-hash "/layer.tar")))
+                 (mkdir file-hash)
+                 (rename-file file-id file-name)
+                 (invoke "tar" "-rf" "image.tar" file-name)
+                 file-hash))
+              (all-layers
+               (append head-layers (list tail-layer customization-layer))))
+         (with-output-to-file "manifest.json"
+           (lambda ()
+             (scm->json (manifest prefix
+                                  (map (cut string-append <> "/layer.tar")
+                                       all-layers)
+                                  repository))))
+         (invoke "tar" "-rf" "image.tar" "manifest.json")
+         all-layers))))
   (let* ((directory "/tmp/docker-image") ;temporary working directory
          (id (docker-id prefix))
          (time (date->string (time-utc->date creation-time) "~4"))
@@ -229,26 +322,39 @@ (define* (build-docker-image image paths prefix
         (with-output-to-file "json"
           (lambda () (scm->json (image-description id time))))
 
-        ;; Create a directory for the non-store files that need to go into the
-        ;; archive.
-        (mkdir "extra")
+        (if root-system
+            (let ((directory (getcwd)))
+              (with-directory-excursion root-system
+                (apply invoke "tar"
+                       "-cf" (string-append directory "/layer.tar")
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." "..")))))))))
+            (begin
+              ;; Create a directory for the non-store files that need to go
+              ;; into the archive.
+              (mkdir "extra")
 
-        (with-directory-excursion "extra"
-          ;; Create non-store files.
-          (for-each (cut evaluate-populate-directive <> "./")
-                    extra-files)
+              (with-directory-excursion "extra"
+                ;; Create non-store files.
+                (for-each (cut evaluate-populate-directive <> "./")
+                          extra-files)
 
-          (when database
-            ;; Initialize /var/guix, assuming PREFIX points to a profile.
-            (install-database-and-gc-roots "." database prefix))
+                (when database
+                  ;; Initialize /var/guix, assuming PREFIX points to a
+                  ;; profile.
+                  (install-database-and-gc-roots "." database prefix))
 
-          (apply invoke "tar" "-cf" "../layer.tar"
-                 `(,@transformation-options
-                   ,@(tar-base-options)
-                   ,@paths
-                   ,@(scandir "."
-                              (lambda (file)
-                                (not (member file '("." ".."))))))))
+                (apply invoke "tar" "-cf" "../layer.tar"
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(if layered-image? '() paths)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." ".."))))))))
+              (delete-file-recursively "extra")))
 
         ;; It is possible for "/" to show up in the archive, especially when
         ;; applying transformations.  For example, the transformation
@@ -261,24 +367,33 @@ (define* (build-docker-image image paths prefix
         ;; error messages.
         (with-error-to-port (%make-void-port "w")
           (lambda ()
-            (system* "tar" "--delete" "/" "-f" "layer.tar")))
-
-        (delete-file-recursively "extra"))
+            (system* "tar" "--delete" "/" "-f" "layer.tar"))))
 
       (with-output-to-file "config.json"
         (lambda ()
-          (scm->json (config (string-append id "/layer.tar")
-                             time arch
-                             #:environment environment
-                             #:entry-point entry-point))))
-      (with-output-to-file "manifest.json"
-        (lambda ()
-          (scm->json (manifest prefix id repository))))
-      (with-output-to-file "repositories"
-        (lambda ()
-          (scm->json (repositories prefix id repository)))))
-
-    (apply invoke "tar" "-cf" image "-C" directory
-           `(,@(tar-base-options #:compressor compressor)
-             "."))
+          (scm->json
+           (config (if layered-image?
+                       (layers-hashes (append (paths-split-sort paths)
+                                              (list id)))
+                       (list (layer-diff-id (string-append id "/layer.tar"))))
+                   time arch
+                   #:environment environment
+                   #:entry-point entry-point))))
+      (if layered-image?
+          (begin
+            (invoke "tar" "-rf" "image.tar" "config.json")
+            (apply invoke `(,@compressor "image.tar"))
+            (copy-file "image.tar.gz" image))
+          (begin
+            (with-output-to-file "manifest.json"
+              (lambda ()
+                (scm->json (manifest prefix
+                                     (list (string-append id "/layer.tar"))
+                                     repository))))
+            (with-output-to-file "repositories"
+              (lambda ()
+                (scm->json (repositories prefix id repository))))
+            (apply invoke "tar" "-cf" image
+                   `(,@(tar-base-options #:compressor compressor)
+                     ".")))))
     (delete-file-recursively directory)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 0dc9979194..3fefd2eac3 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2020 Eric Bavier <bavier <at> posteo.net>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@ (define-module (guix scripts pack)
   #:use-module (guix scripts)
   #:use-module (guix ui)
   #:use-module (guix gexp)
+  #:use-module ((guix build utils) #:select (%xz-parallel-args))
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
@@ -53,6 +55,8 @@ (define-module (guix scripts pack)
   #:use-module ((gnu packages compression) #:hide (zip))
   #:use-module (gnu packages guile)
   #:use-module (gnu packages base)
+  #:use-module (gnu packages shells)
+  #:autoload   (gnu packages package-management) (guix)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:autoload   (gnu packages guile) (guile2.0-json guile-json)
   #:use-module (srfi srfi-1)
@@ -67,6 +71,7 @@ (define-module (guix scripts pack)
             debian-archive
             rpm-archive
             docker-image
+            docker-layered-image
             squashfs-image
 
             %formats
@@ -597,12 +602,14 @@ (define* (docker-image name profile
                        localstatedir?
                        (symlinks '())
                        (archiver tar)
-                       (extra-options '()))
+                       (extra-options '())
+                       layered-image?)
   "Return a derivation to construct a Docker image of PROFILE.  The
 image is a tarball conforming to the Docker Image Specification, compressed
 with COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it
 must a be a GNU triplet and it is used to derive the architecture metadata in
-the image."
+the image.  If LAYERED-IMAGE? is true, the image will with many of the
+store paths being on their own layer to improve sharing between images."
   (define database
     (and localstatedir?
          (file-append (store-database (list profile))
@@ -653,7 +660,13 @@ (define* (docker-image name profile
               `((directory "/tmp" ,(getuid) ,(getgid) #o1777)
                 ,@(append-map symlink->directives '#$symlinks)))
 
-            (setenv "PATH" #+(file-append archiver "/bin"))
+            (setenv "PATH"
+                    (string-join `(#+(file-append archiver "/bin")
+                                   #+@(if layered-image?
+                                          (list (file-append coreutils "/bin")
+                                                (file-append gzip "/bin"))
+                                          '()))
+                                 ":"))
 
             (build-docker-image #$output
                                 (map store-info-item
@@ -671,7 +684,8 @@ (define* (docker-image name profile
                                                               #$entry-point)))
                                 #:extra-files directives
                                 #:compressor #+(compressor-command compressor)
-                                #:creation-time (make-time time-utc 0 1))))))
+                                #:creation-time (make-time time-utc 0 1)
+                                #:layered-image? #$layered-image?)))))
 
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
@@ -679,6 +693,33 @@ (define* (docker-image name profile
                     #:target target
                     #:references-graphs `(("profile" ,profile))))
 
+(define* (docker-layered-image name profile
+                               #:key target
+                               (profile-name "guix-profile")
+                               (compressor (first %compressors))
+                               entry-point
+                               localstatedir?
+                               (symlinks '())
+                               (archiver tar)
+                               (extra-options '())
+                               (layered-image? #t))
+  "Return a derivation to construct a Docker image of PROFILE.  The image is a
+tarball conforming to the Docker Image Specification, compressed with
+COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it must a
+be a GNU triplet and it is used to derive the architecture metadata in the
+image.  If LAYERED-IMAGE? is true, the image will with many of the store paths
+being on their own layer to improve sharing between images."
+  (docker-image name profile
+                #:target target
+                #:profile-name profile-name
+                #:compressor compressor
+                #:entry-point entry-point
+                #:localstatedir? localstatedir?
+                #:symlinks symlinks
+                #:archiver archiver
+                #:extra-options extra-options
+                #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Debian archive format.
@@ -1353,6 +1394,7 @@ (define %formats
   `((tarball . ,self-contained-tarball)
     (squashfs . ,squashfs-image)
     (docker  . ,docker-image)
+    (docker-layered  . ,docker-layered-image)
     (deb . ,debian-archive)
     (rpm . ,rpm-archive)))
 
@@ -1361,15 +1403,17 @@ (define (show-formats)
   (display (G_ "The supported formats for 'guix pack' are:"))
   (newline)
   (display (G_ "
-  tarball       Self-contained tarball, ready to run on another machine"))
+  tarball        Self-contained tarball, ready to run on another machine"))
+  (display (G_ "
+  squashfs       Squashfs image suitable for Singularity"))
   (display (G_ "
-  squashfs      Squashfs image suitable for Singularity"))
+  docker         Tarball ready for 'docker load'"))
   (display (G_ "
-  docker        Tarball ready for 'docker load'"))
+  docker-layered Tarball with a layered image ready for 'docker load'"))
   (display (G_ "
-  deb           Debian archive installable via dpkg/apt"))
+  deb            Debian archive installable via dpkg/apt"))
   (display (G_ "
-  rpm           RPM archive installable via rpm/yum"))
+  rpm            RPM archive installable via rpm/yum"))
   (newline))
 
 (define (required-option symbol)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d7163dd3eb..e4bf0347c7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2022 Tobias Geerinckx-Rice <me <at> tobias.gr>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -727,13 +728,15 @@ (define* (system-derivation-for-action image action
                                               #:graphic? graphic?
                                               #:disk-image-size image-size
                                               #:mappings mappings))
-      ((image disk-image vm-image docker-image)
+      ((image disk-image vm-image docker-image docker-layered-image)
        (when (eq? action 'disk-image)
          (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'vm-image)
          (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'docker-image)
          (warning (G_ "'docker-image' is deprecated: use 'image' instead~%")))
+       (when (eq? action 'docker-layered-image)
+         (warning (G_ "'docker-layered-image' is deprecated: use 'image' instead~%")))
        (lower-object (system-image image))))))
 
 (define (maybe-suggest-running-guix-pull)
@@ -980,6 +983,8 @@ (define (show-help)
    image            build a Guix System image\n"))
   (display (G_ "\
    docker-image     build a Docker image\n"))
+  (display (G_ "\
+   docker-layered-image build a Docker layered image\n"))
   (display (G_ "\
    init             initialize a root file system to run GNU\n"))
   (display (G_ "\
@@ -1193,7 +1198,7 @@ (define actions '("build" "container" "vm" "vm-image" "image" "disk-image"
                   "list-generations" "describe"
                   "delete-generations" "roll-back"
                   "switch-generation" "search" "edit"
-                  "docker-image"))
+                  "docker-image" "docker-layered-image"))
 
 (define (process-action action args opts)
   "Process ACTION, a sub-command, with the arguments are listed in ARGS.
@@ -1242,6 +1247,8 @@ (define (process-action action args opts)
          (image       (let* ((image-type (case action
                                            ((vm-image) qcow2-image-type)
                                            ((docker-image) docker-image-type)
+                                           ((docker-layered-image)
+                                            docker-layered-image-type)
                                            (else image-type)))
                             (image-size (assoc-ref opts 'image-size))
                             (volatile?
diff --git a/tests/pack.scm b/tests/pack.scm
index ce5a2f8a53..432ab1b2ea 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@ (define-module (test-pack)
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix utils)
+  #:use-module ((guix build utils) #:select (%store-directory))
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (glibc-utf8-locales))
   #:use-module (gnu packages bootstrap)
@@ -250,6 +252,52 @@ (define rpm-for-tests
                           (mkdir #$output)))))))
       (built-derivations (list check))))
 
+  (unless store (test-skip 1))
+  (test-assertm "docker-layered-image + localstatedir" store
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile -> (profile
+                      (content (packages->manifest (list %bootstrap-guile)))
+                      (hooks '())
+                      (locales? #f)))
+         (tarball (docker-layered-image "docker-pack" profile
+                                #:symlinks '(("/bin/Guile" -> "bin/guile"))
+                                #:localstatedir? #t))
+         (check   (gexp->derivation "check-tarball"
+                    (with-imported-modules '((guix build utils))
+                      #~(begin
+                          (use-modules (guix build utils)
+                                       (ice-9 match))
+
+                          (define bin
+                            (string-append "." #$profile "/bin"))
+
+                          (define store
+                            (string-append "." #$(%store-directory)))
+
+                          (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+                          (mkdir "base")
+                          (with-directory-excursion "base"
+                            (invoke "tar" "xvf" #$tarball))
+
+                          (match (find-files "base" "layer.tar")
+                            ((layers ...)
+                             (for-each (lambda (layer)
+                                         (invoke "tar" "xvf" layer)
+                                         (invoke "chmod" "--recursive" "u+w" store))
+                                       layers)))
+
+                          (when
+                              (and (file-exists? (string-append bin "/guile"))
+                                   (file-exists? "var/guix/db/db.sqlite")
+                                   (file-is-directory? "tmp")
+                                   (string=? (string-append #$%bootstrap-guile "/bin")
+                                             (pk 'binlink (readlink bin)))
+                                   (string=? (string-append #$profile "/bin/guile")
+                                             (pk 'guilelink (readlink "bin/Guile"))))
+                            (mkdir #$output)))))))
+      (built-derivations (list check))))
+
   (unless store (test-skip 1))
   (test-assertm "squashfs-image + localstatedir" store
     (mlet* %store-monad
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 31 May 2023 08:49:02 GMT) Full text and rfc822 format available.

Message #65 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH] news: Add entry for the new 'docker-layered' distribution
 format.
Date: Wed, 31 May 2023 11:47:54 +0300
* etc/news.scm: Add entry.
---
 etc/news.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index 314f0ab352..cb2dc34876 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -18,6 +18,7 @@
 ;; Copyright © 2021 Andrew Tropin <andrew <at> trop.in>
 ;; Copyright © 2021, 2023 Jonathan Brielmaier <jonathan.brielmaier <at> web.de>
 ;; Copyright © 2022 Thiago Jung Bauermann <bauermann <at> kolabnow.com>
+;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -26,6 +27,63 @@
 (channel-news
  (version 0)
 
+ (entry (commit "dd6c7c816bcb414682e1006d7e83b45e8ac6c575")
+        (title
+         (de "Neues Format @samp{docker-layered} für den Befehl @command{guix pack}")
+         (en "New @samp{docker-layered} format for the @command{guix pack} command")
+         (ru "Новый @samp{docker-layered} формат для @command{guix pack} команды"))
+        (body
+         (de "Sie können jetzt auch mehrschichtige Docker-Abbilder mit dem Befehl
+@command{guix pack --format=docker-layered} erzeugen. Damit bekommen Sie ein
+Docker-Abbild, bei dem Store-Pfade auf getrennten Schichten („Layer“)
+untergebracht sind, die sich mehrere Abbilder teilen können.  Das Abbild wird
+im Store als gzip-komprimierter Tarball erzeugt.  Hier ist ein einfaches
+Beispiel, wo ein mehrschichtiges Docker-Abbild für das Paket @code{hello}
+angelegt wird:
+
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+@command{guix system image} kann jetzt geschichtete Docker-Abbilder erzeugen,
+indem Sie @code{docker-layered} an die Befehlszeilenoption @option{--image-type}
+übergeben.
+
+Siehe @command{info \"(guix.de) Aufruf von guix pack\"} und
+@command{info \"(guix.de) Systemabbilder\"} für weitere Informationen.")
+         (en "Docker layered images can now be produced via the @command{guix
+pack --format=docker-layered} command, providing a Docker image with many of
+the store paths being on their own layer to improve sharing between images.
+The image is realized into the GNU store as a gzipped tarball.  Here is a
+simple example that generates a layered Docker image for the @code{hello}
+package:
+
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+The @command{guix system image} can now produce layered Docker image by passing
+@code{docker-layered} to @option{--image-type} option.
+
+See @command{info \"(guix) Invoking guix pack\"} and
+@command{info \"(guix) System Images\"} for more information.")
+         (ru "Появилась команда создания многослойных Docker образов с помощью
+@command{guix pack --format=docker-layered}, которая соберет Docker образ с
+путями в store расположенными на отдельных слоях, ускоряя таким образом
+передачу образов.  Образ будет создан в GNU store в качестве gzipped tarball.
+
+Пример создания Docker layered образ с @code{hello} пакетом:
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+@command{guix system image} теперь может создавать layered Docker образ путем
+указания в опции @option{--image-type} параметра @code{docker-layered}.
+
+Смотрите @command{info \"(guix) Invoking guix pack\"} и
+@command{info \"(guix) System Images\"} для получения более детальных
+сведений.")))
+
  (entry (commit "ba5da5125a81307500982517e2f458d57b024668")
         (title
          (en "New @code{arguments} rule for @command{guix style}")
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 31 May 2023 12:55:02 GMT) Full text and rfc822 format available.

Message #68 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Greg Hogan <code <at> greghogan.com>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH] Add Docker layered image for pack and system
 (v3)
Date: Wed, 31 May 2023 08:53:46 -0400
On Wed, May 31, 2023 at 4:46 AM Oleg Pykhalov <go.wigust <at> gmail.com> wrote:
>
> Hi, Guix.
>
> These patches series is rebased on origin/master. Also, the Python script is
> replaced in favour of calls to GNU Tar and GNU Gzip programs.  Passed tests:
> make check TESTS="tests/pack.scm"
> make check-system TESTS="docker-system"
> make check-system TESTS="docker-layered-system"
>
>
> Oleg Pykhalov (2):
>   guix: docker: Build layered image.
>   news: Add entry for the new 'docker-layered' distribution format.

Why not use layered images for all docker packs?




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 31 May 2023 13:16:02 GMT) Full text and rfc822 format available.

Message #71 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: Greg Hogan <code <at> greghogan.com>
Cc: 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH] Add Docker layered image for pack and
 system (v3)
Date: Wed, 31 May 2023 16:14:57 +0300
[Message part 1 (text/plain, inline)]
Greg Hogan <code <at> greghogan.com> writes:

> On Wed, May 31, 2023 at 4:46 AM Oleg Pykhalov <go.wigust <at> gmail.com> wrote:
>>
>> Hi, Guix.
>>
>> These patches series is rebased on origin/master. Also, the Python script is
>> replaced in favour of calls to GNU Tar and GNU Gzip programs.  Passed tests:
>> make check TESTS="tests/pack.scm"
>> make check-system TESTS="docker-system"
>> make check-system TESTS="docker-layered-system"
>>
>>
>> Oleg Pykhalov (2):
>>   guix: docker: Build layered image.
>>   news: Add entry for the new 'docker-layered' distribution format.
>
> Why not use layered images for all docker packs?

Do you mean use layered images by default without ability to build all
in a single layer?  Current layered implementation is slow to build
because it needs to calculate a size of each layer, pack, and compress.
So if user wants a faster build, a non-layered image is still an option.

Regards,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Fri, 02 Jun 2023 17:03:02 GMT) Full text and rfc822 format available.

Message #74 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Greg Hogan <code <at> greghogan.com>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH] Add Docker layered image for pack and system
 (v3)
Date: Fri, 2 Jun 2023 13:02:38 -0400
On Wed, May 31, 2023 at 9:14 AM Oleg Pykhalov <go.wigust <at> gmail.com> wrote:
[...]
> Do you mean use layered images by default without ability to build all
> in a single layer?  Current layered implementation is slow to build
> because it needs to calculate a size of each layer, pack, and compress.
> So if user wants a faster build, a non-layered image is still an option.
>
> Regards,
> Oleg.

I am trying out your patch, and wanted to benchmark the runtime
difference between docker and docker-layered packs, but the latter
looks to be failing with any compression other than the default gzip.
In particular, I was looking to disable compression with
'--compression=none'.




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Sat, 03 Jun 2023 19:11:01 GMT) Full text and rfc822 format available.

Message #77 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: Greg Hogan <code <at> greghogan.com>
Cc: 62153 <at> debbugs.gnu.org
Subject: Re: bug#62153: [PATCH 0/2] Add Docker layered image for pack and
 system
Date: Sat, 03 Jun 2023 22:10:15 +0300
[Message part 1 (text/plain, inline)]
Greg Hogan <code <at> greghogan.com> writes:

> On Wed, May 31, 2023 at 9:14 AM Oleg Pykhalov <go.wigust <at> gmail.com> wrote:
> [...]
>> Do you mean use layered images by default without ability to build all
>> in a single layer?  Current layered implementation is slow to build
>> because it needs to calculate a size of each layer, pack, and compress.
>> So if user wants a faster build, a non-layered image is still an option.
>>
>> Regards,
>> Oleg.
>
> I am trying out your patch, and wanted to benchmark the runtime
> difference between docker and docker-layered packs, but the latter
> looks to be failing with any compression other than the default gzip.
> In particular, I was looking to disable compression with
> '--compression=none'.

I'll send a fixed v4 revision for '--compression=none'. Unfortunately,
because we cannot append to an existing compressed tarball:

    tar: Cannot update compressed archives
    Try 'tar --help' or 'tar --usage' for more information.

adding more compression types requires to write a handler for every
compressor separately in guix/docker.scm file:
--8<---------------cut here---------------start------------->8---
      (if layered-image?
          (begin
            (invoke "tar" "-rf" "image.tar" "config.json")
            (if compressor
                (begin
                  (apply invoke `(,@compressor "image.tar"))
                  (copy-file "image.tar.gz" image))
                (copy-file "image.tar" image)))
--8<---------------cut here---------------end--------------->8---

I would like to vote that addional compressors could be added later if
needed.

Regards,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Sat, 03 Jun 2023 19:16:02 GMT) Full text and rfc822 format available.

Message #80 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, Greg Hogan <code <at> greghogan.com>
Subject: [PATCH v4 1/2] guix: docker: Build layered image.
Date: Sat,  3 Jun 2023 22:14:59 +0300
* doc/guix.texi (Invoking guix pack): Document docker-layered format.
(image Reference): Same.
(image-type Reference): Document docker-layered-image-type.
* gnu/image.scm
(validate-image-format)[docker-layered]: New image format.
* gnu/system/image.scm
(docker-layered-image, docker-layered-image-type): New variables.
(system-docker-image)[layered-image?]: New argument.
(system-docker-layered-image): New procedure.
(image->root-file-system)[docker-layered]: New image format.
* gnu/tests/docker.scm (%test-docker-layered-system): New test.
* guix/docker.scm (%docker-image-max-layers): New variable.
(build-docker-image)[stream-layered-image, root-system]: New arguments.
* guix/scripts/pack.scm (stream-layered-image.py): New variable.
(docker-image)[layered-image?]: New argument.
(docker-layered-image): New procedure.
(%formats)[docker-layered]: New format.
(show-formats): Document this.
* guix/scripts/system.scm
(system-derivation-for-action)[docker-layered-image]: New action.
(show-help): Document this.
(actions)[docker-layered-image]: New action.
(process-action): Add this.
* tests/pack.scm: Add "docker-layered-image + localstatedir" test.
---
 doc/guix.texi           |  18 +++-
 gnu/image.scm           |   3 +-
 gnu/system/image.scm    |  76 +++++++++++----
 gnu/tests/docker.scm    |  20 +++-
 guix/docker.scm         | 208 +++++++++++++++++++++++++++++++---------
 guix/scripts/pack.scm   |  62 ++++++++++--
 guix/scripts/system.scm |  11 ++-
 tests/pack.scm          |  48 ++++++++++
 8 files changed, 369 insertions(+), 77 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 7f8d8d66e9..483be6ef16 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -56,7 +56,7 @@
 Copyright @copyright{} 2017, 2018, 2019, 2020 Arun Isaac@*
 Copyright @copyright{} 2017 nee@*
 Copyright @copyright{} 2018 Rutger Helling@*
-Copyright @copyright{} 2018, 2021 Oleg Pykhalov@*
+Copyright @copyright{} 2018, 2021, 2023 Oleg Pykhalov@*
 Copyright @copyright{} 2018 Mike Gerwitz@*
 Copyright @copyright{} 2018 Pierre-Antoine Rouby@*
 Copyright @copyright{} 2018, 2019 Gábor Boskovits@*
@@ -6984,9 +6984,15 @@ Invoking guix pack
 guix pack -f docker -S /bin=bin guile guile-readline
 @end example
 
+or
+
+@example
+guix pack -f docker-layered -S /bin=bin guile guile-readline
+@end example
+
 @noindent
-The result is a tarball that can be passed to the @command{docker load}
-command, followed by @code{docker run}:
+The result is a tarball with image or layered image that can be passed
+to the @command{docker load} command, followed by @code{docker run}:
 
 @example
 docker load < @var{file}
@@ -44347,6 +44353,8 @@ image Reference
 
 @item @code{docker}, a Docker image.
 
+@item @code{docker-layered}, a layered Docker image.
+
 @item @code{iso9660}, an ISO-9660 image.
 
 @item @code{tarball}, a tar.gz image archive.
@@ -44682,6 +44690,10 @@ image-type Reference
 Build an image based on the @code{docker-image} image.
 @end defvar
 
+@defvar docker-layered-image-type
+Build a layered image based on the @code{docker-layered-image} image.
+@end defvar
+
 @defvar raw-with-offset-image-type
 Build an MBR image with a single partition starting at a @code{1024KiB}
 offset.  This is useful to leave some room to install a bootloader in
diff --git a/gnu/image.scm b/gnu/image.scm
index 523653dd77..8a6a0d8479 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -152,7 +153,7 @@ (define-syntax-rule (define-set-sanitizer name field set)
 
 ;; The supported image formats.
 (define-set-sanitizer validate-image-format format
-  (disk-image compressed-qcow2 docker iso9660 tarball wsl2))
+  (disk-image compressed-qcow2 docker docker-layered iso9660 tarball wsl2))
 
 ;; The supported partition table types.
 (define-set-sanitizer validate-partition-table-type partition-table-type
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index afef79185f..3a502f19ec 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2022 Pavel Shlyak <p.shlyak <at> pantherx.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo <at> cyberdimension.org>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -78,6 +79,7 @@ (define-module (gnu system image)
             efi-disk-image
             iso9660-image
             docker-image
+            docker-layered-image
             tarball-image
             wsl2-image
             raw-with-offset-disk-image
@@ -89,6 +91,7 @@ (define-module (gnu system image)
             iso-image-type
             uncompressed-iso-image-type
             docker-image-type
+            docker-layered-image-type
             tarball-image-type
             wsl2-image-type
             raw-with-offset-image-type
@@ -167,6 +170,10 @@ (define docker-image
   (image-without-os
    (format 'docker)))
 
+(define docker-layered-image
+  (image-without-os
+   (format 'docker-layered)))
+
 (define tarball-image
   (image-without-os
    (format 'tarball)))
@@ -237,6 +244,11 @@ (define docker-image-type
    (name 'docker)
    (constructor (cut image-with-os docker-image <>))))
 
+(define docker-layered-image-type
+  (image-type
+   (name 'docker-layered)
+   (constructor (cut image-with-os docker-layered-image <>))))
+
 (define tarball-image-type
   (image-type
    (name 'tarball)
@@ -633,9 +645,12 @@ (define (image-with-label base-image label)
 
 (define* (system-docker-image image
                               #:key
-                              (name "docker-image"))
+                              (name "docker-image")
+                              (archiver tar)
+                              layered-image?)
   "Build a docker image for IMAGE.  NAME is the base name to use for the
-output file."
+output file.  If LAYERED-IMAGE? is true, the image will with many of the store
+paths being on their own layer to improve sharing between images."
   (define boot-program
     ;; Program that runs the boot script of OS, which in turn starts shepherd.
     (program-file "boot-program"
@@ -678,9 +693,11 @@ (define* (system-docker-image image
               (use-modules (guix docker)
                            (guix build utils)
                            (gnu build image)
+                           (srfi srfi-1)
                            (srfi srfi-19)
                            (guix build store-copy)
-                           (guix store database))
+                           (guix store database)
+                           (ice-9 receive))
 
               ;; Set the SQL schema location.
               (sql-schema #$schema)
@@ -700,18 +717,31 @@ (define* (system-docker-image image
                                            #:register-closures? #$register-closures?
                                            #:deduplicate? #f
                                            #:system-directory #$os)
-                (build-docker-image
-                 #$output
-                 (cons* image-root
-                        (map store-info-item
-                             (call-with-input-file #$graph
-                               read-reference-graph)))
-                 #$os
-                 #:entry-point '(#$boot-program #$os)
-                 #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
-                 #:creation-time (make-time time-utc 0 1)
-                 #:system #$image-target
-                 #:transformations `((,image-root -> ""))))))))
+                (when #$layered-image?
+                  (setenv "PATH"
+                          (string-join (list #+(file-append archiver "/bin")
+                                             #+(file-append coreutils "/bin")
+                                             #+(file-append gzip "/bin"))
+                                       ":")))
+                (apply build-docker-image
+                       (append (list #$output
+                                     (append (if #$layered-image?
+                                                 '()
+                                                 (list image-root))
+                                             (map store-info-item
+                                                  (call-with-input-file #$graph
+                                                    read-reference-graph)))
+                                     #$os
+                                     #:entry-point '(#$boot-program #$os)
+                                     #:compressor
+                                     '(#+(file-append gzip "/bin/gzip") "-9n")
+                                     #:creation-time (make-time time-utc 0 1)
+                                     #:system #$image-target
+                                     #:transformations `((,image-root -> "")))
+                               (if #$layered-image?
+                                   (list #:root-system image-root
+                                         #:layered-image? #$layered-image?)
+                                   '()))))))))
 
     (computed-file name builder
                    ;; Allow offloading so that this I/O-intensive process
@@ -720,6 +750,18 @@ (define* (system-docker-image image
                    #:options `(#:references-graphs ((,graph ,os))
                                #:substitutable? ,substitutable?))))
 
+(define* (system-docker-layered-image image
+                                      #:key
+                                      (name "docker-image")
+                                      (archiver tar)
+                                      (layered-image? #t))
+  "Build a docker image for IMAGE.  NAME is the base name to use for the
+output file."
+  (system-docker-image image
+                       #:name name
+                       #:archiver archiver
+                       #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Tarball image.
@@ -811,7 +853,7 @@ (define (image->root-file-system image)
   "Return the IMAGE root partition file-system type."
   (case (image-format image)
     ((iso9660) "iso9660")
-    ((docker tarball wsl2) "dummy")
+    ((docker docker-layered tarball wsl2) "dummy")
     (else
      (partition-file-system (find-root-partition image)))))
 
@@ -948,6 +990,8 @@ (define* (system-image image)
                                        ("bootcfg" ,bootcfg))))
        ((memq image-format '(docker))
         (system-docker-image image*))
+       ((memq image-format '(docker-layered))
+        (system-docker-layered-image image*))
        ((memq image-format '(tarball))
         (system-tarball-image image*))
        ((memq image-format '(wsl2))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index edc9804414..0cccc02ad2 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
 ;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -43,7 +44,8 @@ (define-module (gnu tests docker)
   #:use-module (guix build-system trivial)
   #:use-module ((guix licenses) #:prefix license:)
   #:export (%test-docker
-            %test-docker-system))
+            %test-docker-system
+            %test-docker-layered-system))
 
 (define %docker-os
   (simple-operating-system
@@ -316,3 +318,19 @@ (define %test-docker-system
                                    (locale-libcs (list glibc)))
                                  #:type docker-image-type)))
                  run-docker-system-test)))))
+
+(define %test-docker-layered-system
+  (system-test
+   (name "docker-layered-system")
+   (description "Run a system image as produced by @command{guix system
+docker-layered-image} inside Docker.")
+   (value (with-monad %store-monad
+            (>>= (lower-object
+                  (system-image (os->image
+                                 (operating-system
+                                   (inherit (simple-operating-system))
+                                   ;; Use locales for a single libc to
+                                   ;; reduce space requirements.
+                                   (locale-libcs (list glibc)))
+                                 #:type docker-layered-image-type)))
+                 run-docker-system-test)))))
diff --git a/guix/docker.scm b/guix/docker.scm
index 5e6460f43f..b40cfb2374 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich <at> gmail.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,8 @@ (define-module (guix docker)
                           delete-file-recursively
                           with-directory-excursion
                           invoke))
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (gnu build install)
   #:use-module (json)                             ;guile-json
   #:use-module (srfi srfi-1)
@@ -38,6 +41,9 @@ (define-module (guix docker)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
   #:export (build-docker-image))
 
 ;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image.
@@ -92,12 +98,12 @@ (define (canonicalize-repository-name name)
                       (make-string (- min-length l) padding-character)))
       (_ normalized-name))))
 
-(define* (manifest path id #:optional (tag "guix"))
+(define* (manifest path layers #:optional (tag "guix"))
   "Generate a simple image manifest."
   (let ((tag (canonicalize-repository-name tag)))
     `#(((Config . "config.json")
         (RepoTags . #(,(string-append tag ":latest")))
-        (Layers . #(,(string-append id "/layer.tar")))))))
+        (Layers . ,(list->vector layers))))))
 
 ;; According to the specifications this is required for backwards
 ;; compatibility.  It duplicates information provided by the manifest.
@@ -106,8 +112,8 @@ (define* (repositories path id #:optional (tag "guix"))
   `((,(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 '()))
-  "Generate a minimal image configuration for the given LAYER file."
+(define* (config layers-diff-ids time arch #:key entry-point (environment '()))
+  "Generate a minimal image configuration for the given LAYERS files."
   ;; "architecture" must be values matching "platform.arch" in the
   ;; runtime-spec at
   ;; https://github.com/opencontainers/runtime-spec/blob/v1.0.0-rc2/config.md#platform
@@ -125,7 +131,7 @@ (define* (config layer time arch #:key entry-point (environment '()))
     (container_config . #nil)
     (os . "linux")
     (rootfs . ((type . "layers")
-               (diff_ids . #(,(layer-diff-id layer)))))))
+               (diff_ids . ,(list->vector layers-diff-ids))))))
 
 (define directive-file
   ;; Return the file or directory created by a 'evaluate-populate-directive'
@@ -136,6 +142,37 @@ (define directive-file
     (('directory name _ ...)
      (string-trim name #\/))))
 
+(define %docker-image-max-layers
+  100)
+
+(define (paths-split-sort paths)
+  "Split list of PATHS at %DOCKER-IMAGE-MAX-LAYERS and sort by disk usage."
+  (let* ((paths-length (length paths))
+         (port (apply open-pipe* OPEN_READ
+                      (append '("du" "--summarize") paths)))
+         (output (read-string port)))
+    (close-port port)
+    (receive (head tail)
+        (split-at
+         (map (match-lambda ((size . path) path))
+              (sort (map (lambda (line)
+                           (match (string-split line #\tab)
+                             ((size path)
+                              (cons (string->number size) path))))
+                         (string-split
+                          (string-trim-right output #\newline)
+                          #\newline))
+                    (lambda (path1 path2)
+                      (< (match path2 ((size . _) size))
+                         (match path1 ((size . _) size))))))
+         (if (>= paths-length %docker-image-max-layers)
+             (- %docker-image-max-layers 2)
+             (1- paths-length)))
+      (list head tail))))
+
+(define (create-empty-tar file)
+  (invoke "tar" "-cf" file "--files-from" "/dev/null"))
+
 (define* (build-docker-image image paths prefix
                              #:key
                              (repository "guix")
@@ -146,11 +183,13 @@ (define* (build-docker-image image paths prefix
                              entry-point
                              (environment '())
                              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.  REPOSITORY
-is a descriptive name that will show up in \"REPOSITORY\" column of the output
-of \"docker images\".
+                             (creation-time (current-time time-utc))
+                             layered-image?
+                             root-system)
+  "Write to IMAGE a layerer Docker image archive containing the given PATHS.
+PREFIX 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.
@@ -172,7 +211,14 @@ (define* (build-docker-image image paths prefix
 SYSTEM is a GNU triplet (or prefix thereof) of the system the binaries in
 PATHS are for; it is used to produce metadata in the image.  Use COMPRESSOR, a
 command such as '(\"gzip\" \"-9n\"), to compress IMAGE.  Use CREATION-TIME, a
-SRFI-19 time-utc object, as the creation time in metadata."
+SRFI-19 time-utc object, as the creation time in metadata.
+
+When LAYERED-IMAGE? is true build layered image, providing a Docker
+image with many of the store paths being on their own layer to improve sharing
+between images.
+
+ROOT-SYSTEM is a directory with a provisioned root file system, which will be
+added to image as a layer."
   (define (sanitize path-fragment)
     (escape-special-chars
      ;; GNU tar strips the leading slash off of absolute paths before applying
@@ -203,6 +249,53 @@ (define* (build-docker-image image paths prefix
     (if (eq? '() transformations)
         '()
         `("--transform" ,(transformations->expression transformations))))
+  (define layers-hashes
+    (match-lambda
+      (((head ...) (tail ...) id)
+       (create-empty-tar "image.tar")
+       (let* ((head-layers
+               (map
+                (lambda (file)
+                  (invoke "tar" "cf" "layer.tar" file)
+                  (let* ((file-hash (layer-diff-id "layer.tar"))
+                         (file-name (string-append file-hash "/layer.tar")))
+                    (mkdir file-hash)
+                    (rename-file "layer.tar" file-name)
+                    (invoke "tar" "-rf" "image.tar" file-name)
+                    (delete-file file-name)
+                    file-hash))
+                head))
+              (tail-layer
+               (begin
+                 (create-empty-tar "layer.tar")
+                 (for-each (lambda (file)
+                             (invoke "tar" "-rf" "layer.tar" file))
+                           tail)
+                 (let* ((file-hash (layer-diff-id "layer.tar"))
+                        (file-name (string-append file-hash "/layer.tar")))
+                   (mkdir file-hash)
+                   (rename-file "layer.tar" file-name)
+                   (invoke "tar" "-rf" "image.tar" file-name)
+                   (delete-file file-name)
+                   file-hash)))
+              (customization-layer
+               (let* ((file-id (string-append id "/layer.tar"))
+                      (file-hash (layer-diff-id file-id))
+                      (file-name (string-append file-hash "/layer.tar")))
+                 (mkdir file-hash)
+                 (rename-file file-id file-name)
+                 (invoke "tar" "-rf" "image.tar" file-name)
+                 file-hash))
+              (all-layers
+               (append head-layers (list tail-layer customization-layer))))
+         (with-output-to-file "manifest.json"
+           (lambda ()
+             (scm->json (manifest prefix
+                                  (map (cut string-append <> "/layer.tar")
+                                       all-layers)
+                                  repository))))
+         (invoke "tar" "-rf" "image.tar" "manifest.json")
+         all-layers))))
   (let* ((directory "/tmp/docker-image") ;temporary working directory
          (id (docker-id prefix))
          (time (date->string (time-utc->date creation-time) "~4"))
@@ -229,26 +322,39 @@ (define* (build-docker-image image paths prefix
         (with-output-to-file "json"
           (lambda () (scm->json (image-description id time))))
 
-        ;; Create a directory for the non-store files that need to go into the
-        ;; archive.
-        (mkdir "extra")
+        (if root-system
+            (let ((directory (getcwd)))
+              (with-directory-excursion root-system
+                (apply invoke "tar"
+                       "-cf" (string-append directory "/layer.tar")
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." "..")))))))))
+            (begin
+              ;; Create a directory for the non-store files that need to go
+              ;; into the archive.
+              (mkdir "extra")
 
-        (with-directory-excursion "extra"
-          ;; Create non-store files.
-          (for-each (cut evaluate-populate-directive <> "./")
-                    extra-files)
+              (with-directory-excursion "extra"
+                ;; Create non-store files.
+                (for-each (cut evaluate-populate-directive <> "./")
+                          extra-files)
 
-          (when database
-            ;; Initialize /var/guix, assuming PREFIX points to a profile.
-            (install-database-and-gc-roots "." database prefix))
+                (when database
+                  ;; Initialize /var/guix, assuming PREFIX points to a
+                  ;; profile.
+                  (install-database-and-gc-roots "." database prefix))
 
-          (apply invoke "tar" "-cf" "../layer.tar"
-                 `(,@transformation-options
-                   ,@(tar-base-options)
-                   ,@paths
-                   ,@(scandir "."
-                              (lambda (file)
-                                (not (member file '("." ".."))))))))
+                (apply invoke "tar" "-cf" "../layer.tar"
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(if layered-image? '() paths)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." ".."))))))))
+              (delete-file-recursively "extra")))
 
         ;; It is possible for "/" to show up in the archive, especially when
         ;; applying transformations.  For example, the transformation
@@ -261,24 +367,36 @@ (define* (build-docker-image image paths prefix
         ;; error messages.
         (with-error-to-port (%make-void-port "w")
           (lambda ()
-            (system* "tar" "--delete" "/" "-f" "layer.tar")))
-
-        (delete-file-recursively "extra"))
+            (system* "tar" "--delete" "/" "-f" "layer.tar"))))
 
       (with-output-to-file "config.json"
         (lambda ()
-          (scm->json (config (string-append id "/layer.tar")
-                             time arch
-                             #:environment environment
-                             #:entry-point entry-point))))
-      (with-output-to-file "manifest.json"
-        (lambda ()
-          (scm->json (manifest prefix id repository))))
-      (with-output-to-file "repositories"
-        (lambda ()
-          (scm->json (repositories prefix id repository)))))
-
-    (apply invoke "tar" "-cf" image "-C" directory
-           `(,@(tar-base-options #:compressor compressor)
-             "."))
+          (scm->json
+           (config (if layered-image?
+                       (layers-hashes (append (paths-split-sort paths)
+                                              (list id)))
+                       (list (layer-diff-id (string-append id "/layer.tar"))))
+                   time arch
+                   #:environment environment
+                   #:entry-point entry-point))))
+      (if layered-image?
+          (begin
+            (invoke "tar" "-rf" "image.tar" "config.json")
+            (if compressor
+                (begin
+                  (apply invoke `(,@compressor "image.tar"))
+                  (copy-file "image.tar.gz" image))
+                (copy-file "image.tar" image)))
+          (begin
+            (with-output-to-file "manifest.json"
+              (lambda ()
+                (scm->json (manifest prefix
+                                     (list (string-append id "/layer.tar"))
+                                     repository))))
+            (with-output-to-file "repositories"
+              (lambda ()
+                (scm->json (repositories prefix id repository))))
+            (apply invoke "tar" "-cf" image
+                   `(,@(tar-base-options #:compressor compressor)
+                     ".")))))
     (delete-file-recursively directory)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 0dc9979194..3fefd2eac3 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2020 Eric Bavier <bavier <at> posteo.net>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@ (define-module (guix scripts pack)
   #:use-module (guix scripts)
   #:use-module (guix ui)
   #:use-module (guix gexp)
+  #:use-module ((guix build utils) #:select (%xz-parallel-args))
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
@@ -53,6 +55,8 @@ (define-module (guix scripts pack)
   #:use-module ((gnu packages compression) #:hide (zip))
   #:use-module (gnu packages guile)
   #:use-module (gnu packages base)
+  #:use-module (gnu packages shells)
+  #:autoload   (gnu packages package-management) (guix)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:autoload   (gnu packages guile) (guile2.0-json guile-json)
   #:use-module (srfi srfi-1)
@@ -67,6 +71,7 @@ (define-module (guix scripts pack)
             debian-archive
             rpm-archive
             docker-image
+            docker-layered-image
             squashfs-image
 
             %formats
@@ -597,12 +602,14 @@ (define* (docker-image name profile
                        localstatedir?
                        (symlinks '())
                        (archiver tar)
-                       (extra-options '()))
+                       (extra-options '())
+                       layered-image?)
   "Return a derivation to construct a Docker image of PROFILE.  The
 image is a tarball conforming to the Docker Image Specification, compressed
 with COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it
 must a be a GNU triplet and it is used to derive the architecture metadata in
-the image."
+the image.  If LAYERED-IMAGE? is true, the image will with many of the
+store paths being on their own layer to improve sharing between images."
   (define database
     (and localstatedir?
          (file-append (store-database (list profile))
@@ -653,7 +660,13 @@ (define* (docker-image name profile
               `((directory "/tmp" ,(getuid) ,(getgid) #o1777)
                 ,@(append-map symlink->directives '#$symlinks)))
 
-            (setenv "PATH" #+(file-append archiver "/bin"))
+            (setenv "PATH"
+                    (string-join `(#+(file-append archiver "/bin")
+                                   #+@(if layered-image?
+                                          (list (file-append coreutils "/bin")
+                                                (file-append gzip "/bin"))
+                                          '()))
+                                 ":"))
 
             (build-docker-image #$output
                                 (map store-info-item
@@ -671,7 +684,8 @@ (define* (docker-image name profile
                                                               #$entry-point)))
                                 #:extra-files directives
                                 #:compressor #+(compressor-command compressor)
-                                #:creation-time (make-time time-utc 0 1))))))
+                                #:creation-time (make-time time-utc 0 1)
+                                #:layered-image? #$layered-image?)))))
 
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
@@ -679,6 +693,33 @@ (define* (docker-image name profile
                     #:target target
                     #:references-graphs `(("profile" ,profile))))
 
+(define* (docker-layered-image name profile
+                               #:key target
+                               (profile-name "guix-profile")
+                               (compressor (first %compressors))
+                               entry-point
+                               localstatedir?
+                               (symlinks '())
+                               (archiver tar)
+                               (extra-options '())
+                               (layered-image? #t))
+  "Return a derivation to construct a Docker image of PROFILE.  The image is a
+tarball conforming to the Docker Image Specification, compressed with
+COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it must a
+be a GNU triplet and it is used to derive the architecture metadata in the
+image.  If LAYERED-IMAGE? is true, the image will with many of the store paths
+being on their own layer to improve sharing between images."
+  (docker-image name profile
+                #:target target
+                #:profile-name profile-name
+                #:compressor compressor
+                #:entry-point entry-point
+                #:localstatedir? localstatedir?
+                #:symlinks symlinks
+                #:archiver archiver
+                #:extra-options extra-options
+                #:layered-image? layered-image?))
+
 
 ;;;
 ;;; Debian archive format.
@@ -1353,6 +1394,7 @@ (define %formats
   `((tarball . ,self-contained-tarball)
     (squashfs . ,squashfs-image)
     (docker  . ,docker-image)
+    (docker-layered  . ,docker-layered-image)
     (deb . ,debian-archive)
     (rpm . ,rpm-archive)))
 
@@ -1361,15 +1403,17 @@ (define (show-formats)
   (display (G_ "The supported formats for 'guix pack' are:"))
   (newline)
   (display (G_ "
-  tarball       Self-contained tarball, ready to run on another machine"))
+  tarball        Self-contained tarball, ready to run on another machine"))
+  (display (G_ "
+  squashfs       Squashfs image suitable for Singularity"))
   (display (G_ "
-  squashfs      Squashfs image suitable for Singularity"))
+  docker         Tarball ready for 'docker load'"))
   (display (G_ "
-  docker        Tarball ready for 'docker load'"))
+  docker-layered Tarball with a layered image ready for 'docker load'"))
   (display (G_ "
-  deb           Debian archive installable via dpkg/apt"))
+  deb            Debian archive installable via dpkg/apt"))
   (display (G_ "
-  rpm           RPM archive installable via rpm/yum"))
+  rpm            RPM archive installable via rpm/yum"))
   (newline))
 
 (define (required-option symbol)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index d7163dd3eb..e4bf0347c7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2022 Tobias Geerinckx-Rice <me <at> tobias.gr>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -727,13 +728,15 @@ (define* (system-derivation-for-action image action
                                               #:graphic? graphic?
                                               #:disk-image-size image-size
                                               #:mappings mappings))
-      ((image disk-image vm-image docker-image)
+      ((image disk-image vm-image docker-image docker-layered-image)
        (when (eq? action 'disk-image)
          (warning (G_ "'disk-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'vm-image)
          (warning (G_ "'vm-image' is deprecated: use 'image' instead~%")))
        (when (eq? action 'docker-image)
          (warning (G_ "'docker-image' is deprecated: use 'image' instead~%")))
+       (when (eq? action 'docker-layered-image)
+         (warning (G_ "'docker-layered-image' is deprecated: use 'image' instead~%")))
        (lower-object (system-image image))))))
 
 (define (maybe-suggest-running-guix-pull)
@@ -980,6 +983,8 @@ (define (show-help)
    image            build a Guix System image\n"))
   (display (G_ "\
    docker-image     build a Docker image\n"))
+  (display (G_ "\
+   docker-layered-image build a Docker layered image\n"))
   (display (G_ "\
    init             initialize a root file system to run GNU\n"))
   (display (G_ "\
@@ -1193,7 +1198,7 @@ (define actions '("build" "container" "vm" "vm-image" "image" "disk-image"
                   "list-generations" "describe"
                   "delete-generations" "roll-back"
                   "switch-generation" "search" "edit"
-                  "docker-image"))
+                  "docker-image" "docker-layered-image"))
 
 (define (process-action action args opts)
   "Process ACTION, a sub-command, with the arguments are listed in ARGS.
@@ -1242,6 +1247,8 @@ (define (process-action action args opts)
          (image       (let* ((image-type (case action
                                            ((vm-image) qcow2-image-type)
                                            ((docker-image) docker-image-type)
+                                           ((docker-layered-image)
+                                            docker-layered-image-type)
                                            (else image-type)))
                             (image-size (assoc-ref opts 'image-size))
                             (volatile?
diff --git a/tests/pack.scm b/tests/pack.scm
index ce5a2f8a53..432ab1b2ea 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@ (define-module (test-pack)
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix utils)
+  #:use-module ((guix build utils) #:select (%store-directory))
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (glibc-utf8-locales))
   #:use-module (gnu packages bootstrap)
@@ -250,6 +252,52 @@ (define rpm-for-tests
                           (mkdir #$output)))))))
       (built-derivations (list check))))
 
+  (unless store (test-skip 1))
+  (test-assertm "docker-layered-image + localstatedir" store
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile -> (profile
+                      (content (packages->manifest (list %bootstrap-guile)))
+                      (hooks '())
+                      (locales? #f)))
+         (tarball (docker-layered-image "docker-pack" profile
+                                #:symlinks '(("/bin/Guile" -> "bin/guile"))
+                                #:localstatedir? #t))
+         (check   (gexp->derivation "check-tarball"
+                    (with-imported-modules '((guix build utils))
+                      #~(begin
+                          (use-modules (guix build utils)
+                                       (ice-9 match))
+
+                          (define bin
+                            (string-append "." #$profile "/bin"))
+
+                          (define store
+                            (string-append "." #$(%store-directory)))
+
+                          (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+                          (mkdir "base")
+                          (with-directory-excursion "base"
+                            (invoke "tar" "xvf" #$tarball))
+
+                          (match (find-files "base" "layer.tar")
+                            ((layers ...)
+                             (for-each (lambda (layer)
+                                         (invoke "tar" "xvf" layer)
+                                         (invoke "chmod" "--recursive" "u+w" store))
+                                       layers)))
+
+                          (when
+                              (and (file-exists? (string-append bin "/guile"))
+                                   (file-exists? "var/guix/db/db.sqlite")
+                                   (file-is-directory? "tmp")
+                                   (string=? (string-append #$%bootstrap-guile "/bin")
+                                             (pk 'binlink (readlink bin)))
+                                   (string=? (string-append #$profile "/bin/guile")
+                                             (pk 'guilelink (readlink "bin/Guile"))))
+                            (mkdir #$output)))))))
+      (built-derivations (list check))))
+
   (unless store (test-skip 1))
   (test-assertm "squashfs-image + localstatedir" store
     (mlet* %store-monad

base-commit: 66c9b82fed3c59ee07187898592c688c82fed273
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Sat, 03 Jun 2023 19:18:02 GMT) Full text and rfc822 format available.

Message #83 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>, Greg Hogan <code <at> greghogan.com>
Subject: [PATCH v4] news: Add entry for the new 'docker-layered' distribution
 format.
Date: Sat,  3 Jun 2023 22:16:27 +0300
* etc/news.scm: Add entry.
---
 etc/news.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index 314f0ab352..158a9284b0 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -18,6 +18,7 @@
 ;; Copyright © 2021 Andrew Tropin <andrew <at> trop.in>
 ;; Copyright © 2021, 2023 Jonathan Brielmaier <jonathan.brielmaier <at> web.de>
 ;; Copyright © 2022 Thiago Jung Bauermann <bauermann <at> kolabnow.com>
+;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -26,6 +27,63 @@
 (channel-news
  (version 0)
 
+ (entry (commit "457c813653a44117e296deaa49e79fc701b90791")
+        (title
+         (de "Neues Format @samp{docker-layered} für den Befehl @command{guix pack}")
+         (en "New @samp{docker-layered} format for the @command{guix pack} command")
+         (ru "Новый @samp{docker-layered} формат для @command{guix pack} команды"))
+        (body
+         (de "Sie können jetzt auch mehrschichtige Docker-Abbilder mit dem Befehl
+@command{guix pack --format=docker-layered} erzeugen. Damit bekommen Sie ein
+Docker-Abbild, bei dem Store-Pfade auf getrennten Schichten („Layer“)
+untergebracht sind, die sich mehrere Abbilder teilen können.  Das Abbild wird
+im Store als gzip-komprimierter Tarball erzeugt.  Hier ist ein einfaches
+Beispiel, wo ein mehrschichtiges Docker-Abbild für das Paket @code{hello}
+angelegt wird:
+
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+@command{guix system image} kann jetzt geschichtete Docker-Abbilder erzeugen,
+indem Sie @code{docker-layered} an die Befehlszeilenoption @option{--image-type}
+übergeben.
+
+Siehe @command{info \"(guix.de) Aufruf von guix pack\"} und
+@command{info \"(guix.de) Systemabbilder\"} für weitere Informationen.")
+         (en "Docker layered images can now be produced via the @command{guix
+pack --format=docker-layered} command, providing a Docker image with many of
+the store paths being on their own layer to improve sharing between images.
+The image is realized into the GNU store as a gzipped tarball.  Here is a
+simple example that generates a layered Docker image for the @code{hello}
+package:
+
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+The @command{guix system image} can now produce layered Docker image by passing
+@code{docker-layered} to @option{--image-type} option.
+
+See @command{info \"(guix) Invoking guix pack\"} and
+@command{info \"(guix) System Images\"} for more information.")
+         (ru "Появилась команда создания многослойных Docker образов с помощью
+@command{guix pack --format=docker-layered}, которая соберет Docker образ с
+путями в store расположенными на отдельных слоях, ускоряя таким образом
+передачу образов.  Образ будет создан в GNU store в качестве gzipped tarball.
+
+Пример создания Docker layered образ с @code{hello} пакетом:
+@example
+guix pack --format=docker-layered --symlink=/usr/bin/hello=bin/hello hello
+@end example
+
+@command{guix system image} теперь может создавать layered Docker образ путем
+указания в опции @option{--image-type} параметра @code{docker-layered}.
+
+Смотрите @command{info \"(guix) Invoking guix pack\"} и
+@command{info \"(guix) System Images\"} для получения более детальных
+сведений.")))
+
  (entry (commit "ba5da5125a81307500982517e2f458d57b024668")
         (title
          (en "New @code{arguments} rule for @command{guix style}")

base-commit: 66c9b82fed3c59ee07187898592c688c82fed273
prerequisite-patch-id: 9c90b67b3c2bb18d7fd17d083b0ab0d1cd5333cd
-- 
2.38.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Sun, 27 Aug 2023 03:18:02 GMT) Full text and rfc822 format available.

Message #86 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: guix-devel <guix-devel <at> gnu.org>
Cc: 64173 <at> debbugs.gnu.org, 62153 <at> debbugs.gnu.org
Subject: Merging guix pack changes for Docker containers packaging
Date: Sun, 27 Aug 2023 06:16:49 +0300
[Message part 1 (text/plain, inline)]
Hi Guix,

I would like to merge 62153.  After 64173 will be merge, merging 62153
is not possible without conflict resolving with Git.

64173 introduces ‘%docker-format-options’ variable.  With this variable
it's possible in 62153 to replace ‘--image-type=docker-layered’ with
‘--docker-layers=N’ option, where:

    if ‘N’ is zero, then use current non layered format
    if ‘N’ is bigger than zero, then use layered format

Number of layers specification is nice to have, because Docker layers
are limited.  So if user would like to modify a Docker image by adding
more layers on top, then hacks like squashing layers are not required.
Also, it will be possible to delete code which builds non layered Docker
image without deprecating command line options.

Is it possible to partially merge 64173, specifically
‘%docker-format-options’ variable and it requirements, so it can be used
in 62153 for ‘--docker-layers=N’ option?

[1]: https://issues.guix.gnu.org/issue/62153
[2]: https://issues.guix.gnu.org/64173


Regards,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Fri, 22 Dec 2023 22:11:02 GMT) Full text and rfc822 format available.

Message #89 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Greg Hogan <code <at> greghogan.com>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH v4 1/2] guix: docker: Build layered image.
Date: Fri, 22 Dec 2023 23:10:20 +0100
Oleg Pykhalov <go.wigust <at> gmail.com> skribis:

> * doc/guix.texi (Invoking guix pack): Document docker-layered format.
> (image Reference): Same.
> (image-type Reference): Document docker-layered-image-type.
> * gnu/image.scm
> (validate-image-format)[docker-layered]: New image format.
> * gnu/system/image.scm
> (docker-layered-image, docker-layered-image-type): New variables.
> (system-docker-image)[layered-image?]: New argument.
> (system-docker-layered-image): New procedure.
> (image->root-file-system)[docker-layered]: New image format.
> * gnu/tests/docker.scm (%test-docker-layered-system): New test.
> * guix/docker.scm (%docker-image-max-layers): New variable.
> (build-docker-image)[stream-layered-image, root-system]: New arguments.
> * guix/scripts/pack.scm (stream-layered-image.py): New variable.
> (docker-image)[layered-image?]: New argument.
> (docker-layered-image): New procedure.
> (%formats)[docker-layered]: New format.
> (show-formats): Document this.
> * guix/scripts/system.scm
> (system-derivation-for-action)[docker-layered-image]: New action.
> (show-help): Document this.
> (actions)[docker-layered-image]: New action.
> (process-action): Add this.
> * tests/pack.scm: Add "docker-layered-image + localstatedir" test.

[...]

> +  #:use-module (guix diagnostics)
> +  #:use-module (guix i18n)

(guix docker) shouldn’t need these.

> +  #:use-module (ice-9 popen)
> +  #:use-module (ice-9 rdelim)
> +  #:use-module (ice-9 receive)

For consistency, I’d recommend (srfi srfi-71) instead of (ice-9
receive).

> +(define %docker-image-max-layers
> +  100)

I’d add a comment on the second line, like “;; Maximum number of layers
allowed in a Docker image according to …”.

> +(define (paths-split-sort paths)
> +  "Split list of PATHS at %DOCKER-IMAGE-MAX-LAYERS and sort by disk usage."

Nitpick: maybe (define (size-sorted-store-items items) …)?

> +  (let* ((paths-length (length paths))
> +         (port (apply open-pipe* OPEN_READ
> +                      (append '("du" "--summarize") paths)))
> +         (output (read-string port)))
> +    (close-port port)

How about:

  (map (lambda (item)
         (cons item (file-size item)))
       items)

?

See (guix build store-copy) for the definition of ‘file-size’.

That way we avoid the dependency on Coreutils and code that “parses” the
output of ‘du’.

> +  (define layers-hashes

A short comment explaining what the inputs and outputs of this procedure
are would be great.

> +    (match-lambda
> +      (((head ...) (tail ...) id)
> +       (create-empty-tar "image.tar")
> +       (let* ((head-layers
> +               (map
> +                (lambda (file)
> +                  (invoke "tar" "cf" "layer.tar" file)
> +                  (let* ((file-hash (layer-diff-id "layer.tar"))
> +                         (file-name (string-append file-hash "/layer.tar")))
> +                    (mkdir file-hash)
> +                    (rename-file "layer.tar" file-name)
> +                    (invoke "tar" "-rf" "image.tar" file-name)
> +                    (delete-file file-name)
> +                    file-hash))
> +                head))
> +              (tail-layer
> +               (begin
> +                 (create-empty-tar "layer.tar")
> +                 (for-each (lambda (file)
> +                             (invoke "tar" "-rf" "layer.tar" file))
> +                           tail)
> +                 (let* ((file-hash (layer-diff-id "layer.tar"))
> +                        (file-name (string-append file-hash "/layer.tar")))
> +                   (mkdir file-hash)
> +                   (rename-file "layer.tar" file-name)
> +                   (invoke "tar" "-rf" "image.tar" file-name)
> +                   (delete-file file-name)
> +                   file-hash)))
> +              (customization-layer
> +               (let* ((file-id (string-append id "/layer.tar"))
> +                      (file-hash (layer-diff-id file-id))
> +                      (file-name (string-append file-hash "/layer.tar")))
> +                 (mkdir file-hash)
> +                 (rename-file file-id file-name)
> +                 (invoke "tar" "-rf" "image.tar" file-name)
> +                 file-hash))
> +              (all-layers
> +               (append head-layers (list tail-layer customization-layer))))

Maybe this can be factorized a bit with:

  (define (seal-layer)
    ;; Add 'layer.tar' to 'image.tar' under the right name.  Return its hash.
    (let* ((file-hash (layer-diff-id "layer.tar"))
           (file-name (string-append file-hash "/layer.tar")))
      (mkdir file-hash)
      (rename-file "layer.tar" file-name)
      (invoke "tar" "-rf" "image.tar" file-name)
      (delete-file file-name)
      file-hash)))

?

Apart from this stylistic issues, it looks great to me.

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Fri, 22 Dec 2023 22:12:01 GMT) Full text and rfc822 format available.

Message #92 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: guix-devel <guix-devel <at> gnu.org>, 62153 <at> debbugs.gnu.org,
 64173 <at> debbugs.gnu.org
Subject: Re: [bug#62153] Merging guix pack changes for Docker containers
 packaging
Date: Fri, 22 Dec 2023 23:11:07 +0100
Hi Oleg,

Apologies for not replying earlier.  I occasionally get reminded of the
fact that building single-layer images is a problem, but only now did I
take the time to look more closely at the latest version of these
patches.

Oleg Pykhalov <go.wigust <at> gmail.com> skribis:

> I would like to merge 62153.  After 64173 will be merge, merging 62153
> is not possible without conflict resolving with Git.
>
> 64173 introduces ‘%docker-format-options’ variable.  With this variable
> it's possible in 62153 to replace ‘--image-type=docker-layered’ with
> ‘--docker-layers=N’ option, where:
>
>     if ‘N’ is zero, then use current non layered format
>     if ‘N’ is bigger than zero, then use layered format

OK we should do that.  However, the original submitter of #64173
apparently dropped the ball as we were approaching the final version.

Would you like to adopt it and submit/push a version that incorporates
the latest comments?

Alternatively, we could do the opposite: merge the Docker layer patches
first, and then rebase the ‘%docker-format-options’ patch, after which
we could add the ‘--docker-layers’ option.

What’s your preference?

> Number of layers specification is nice to have, because Docker layers
> are limited.  So if user would like to modify a Docker image by adding
> more layers on top, then hacks like squashing layers are not required.
> Also, it will be possible to delete code which builds non layered Docker
> image without deprecating command line options.

Agreed.

Anyway, apart from the stylistic issues I reported, v4 of this patch set
looks great to me.  (For clarity I’d have preferred three patches, one
for (guix docker), one for ‘guix pack’, and one for ‘guix system’; but
it’s really a detail, let’s not block this patch series any longer.)

Thanks,
Ludo’.




Information forwarded to guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 26 Dec 2023 02:17:01 GMT) Full text and rfc822 format available.

Message #95 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Greg Hogan <code <at> greghogan.com>
Subject: [PATCH v5 0/5] Add Docker layered image for pack and system
Date: Tue, 26 Dec 2023 05:15:02 +0300
This patch series applies 64173 and for 62153 replaces 'docker-layered-image'
format with '--max-layers=N' option for 'guix pack' and 'guix system image'.

Graham James Addis (1):
  guix: pack: Add '--entry-point-argument' option.

Oleg Pykhalov (4):
  tests: docker-system: Increase image size.
  guix: docker: Build layered images.
  guix: pack: Build layered images.
  scripts: system: Build layered images.

 doc/guix.texi           |  40 +++++++-
 gnu/image.scm           |   4 +
 gnu/system/image.scm    |  41 +++++---
 gnu/tests/docker.scm    |   2 +-
 guix/docker.scm         | 212 +++++++++++++++++++++++++++++++---------
 guix/scripts/pack.scm   |  80 ++++++++++++---
 guix/scripts/system.scm |  28 +++++-
 tests/pack.scm          |  49 ++++++++++
 8 files changed, 379 insertions(+), 77 deletions(-)


base-commit: a4a14ab6d79f6f1f926a82dd50db4655232042b7
-- 
2.41.0





Information forwarded to guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 26 Dec 2023 02:21:02 GMT) Full text and rfc822 format available.

Message #98 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>,
 Graham James Addis <grahamjamesaddis <at> gmail.com>
Subject: [PATCH 1/5] guix: pack: Add '--entry-point-argument' option.
Date: Tue, 26 Dec 2023 05:18:53 +0300
From: Graham James Addis <grahamjamesaddis <at> gmail.com>

* guix/scripts/pack.scm:
(entry-point-argument-spec-option-parser): New procedure.
(docker-image, %default-options, %docker-format-options,
show-docker-format-options/detailed, %options, show-docker-format-options,
guix-pack): Handle '--entry-point-argument' option.
* doc/guix.texi: (Invoking guix pack): Document this

Signed-off-by: Oleg Pykhalov <go.wigust <at> gmail.com>
Change-Id: I1124feff6af39dcc63c85fd6cc7ad50f398489dc
---
 doc/guix.texi         | 14 +++++++++++-
 guix/scripts/pack.scm | 50 +++++++++++++++++++++++++++++++++++--------
 2 files changed, 54 insertions(+), 10 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 76b4eae67f..cca250dc31 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -122,6 +122,7 @@
 Copyright @copyright{} 2023 Foundation Devices, Inc.@*
 Copyright @copyright{} 2023 Thomas Ieong@*
 Copyright @copyright{} 2023 Saku Laesvuori@*
+Copyright @copyright{} 2023 Graham James Addis@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -7406,7 +7407,7 @@ Invoking guix pack
 @env{GUIX_EXECUTION_ENGINE} environment variable accordingly.
 @end quotation
 
-@cindex entry point, for Docker images
+@cindex entry point, for Docker and Singularity images
 @item --entry-point=@var{command}
 Use @var{command} as the @dfn{entry point} of the resulting pack, if the pack
 format supports it---currently @code{docker} and @code{squashfs} (Singularity)
@@ -7429,6 +7430,17 @@ Invoking guix pack
 docker run @var{image-id}
 @end example
 
+@cindex entry point arguments, for docker images
+@item --entry-point-argument=@var{command}
+@itemx -A @var{command}
+Use @var{command} as an argument to @dfn{entry point} of the resulting pack.
+This option is only valid in conjunction with @code{--entry-point} and can
+appear multiple times on the command line.
+
+@example
+guix pack -f docker --entry-point=bin/guile --entry-point-argument="--help" guile
+@end example
+
 @item --expression=@var{expr}
 @itemx -e @var{expr}
 Consider the package @var{expr} evaluates to.
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 8071840de1..4c0a602eb1 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
 ;;; Copyright © 2020 Eric Bavier <bavier <at> posteo.net>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Graham James Addis <graham <at> addis.org.uk>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -202,6 +203,16 @@ (define (symlink-spec-option-parser opt name arg result)
      (leave (G_ "~a: invalid symlink specification~%")
             arg))))
 
+(define (entry-point-argument-spec-option-parser opt name arg result)
+  "A SRFI-37 opion parser for the --entry-point-argument option. The spec
+takes multiple occurances. The entries are used in the exec form for the
+docker entry-point. The values are used as parameters in conjunction with
+the --entry-point option which is used as the first value in the exec form."
+  (let ((entry-point-argument (assoc-ref result 'entry-point-argument)))
+    (alist-cons 'entry-point-argument
+                (append entry-point-argument (list arg))
+                (alist-delete 'entry-point-argument result eq?))))
+
 (define (set-utf8-locale profile)
   "Configure the environment to use the \"en_US.utf8\" locale provided by the
 GLIBC-UT8-LOCALES package."
@@ -562,10 +573,22 @@ (define* (docker-image name profile
               `((directory "/tmp" ,(getuid) ,(getgid) #o1777)
                 ,@(append-map symlink->directives '#$symlinks)))
 
+            (define (form-entry-point prefix entry-point entry-point-argument)
+              ;; Construct entry-point parameter for build-docker-image.  The
+              ;; first entry is constructed by prefixing the entry-point with
+              ;; the supplied index subsequent entries are taken from the
+              ;; --entry-point-argument options.
+              (and=> entry-point
+                     (lambda (entry-point)
+                       (cons* (string-append prefix "/" entry-point)
+		              entry-point-argument))))
+
             (setenv "PATH" #+(file-append archiver "/bin"))
 
             (let-keywords '#$extra-options #f
-                          ((image-tag #f))
+                          ((image-tag #f)
+                           (entry-point-argument #f))
+
               (build-docker-image #$output
                                   (map store-info-item
                                        (call-with-input-file "profile"
@@ -578,11 +601,10 @@ (define* (docker-image name profile
                                   #:database #+database
                                   #:system (or #$target %host-type)
                                   #:environment environment
-                                  #:entry-point
-                                  #$(and entry-point
-                                         #~(list
-                                            (string-append #$profile "/"
-                                                           #$entry-point)))
+                                  #:entry-point (form-entry-point
+                                                 #$profile
+                                                 #$entry-point
+                                                 entry-point-argument)
                                   #:extra-files directives
                                   #:compressor
                                   #+(compressor-command compressor)
@@ -1264,6 +1286,7 @@ (define %default-options
     (debug . 0)
     (verbosity . 1)
     (symlinks . ())
+    (entry-point-argument . ())
     (compressor . ,(first %compressors))))
 
 (define %formats
@@ -1299,7 +1322,9 @@ (define (required-option symbol)
                    rest))))
 
 (define %docker-format-options
-  (list (required-option 'image-tag)))
+  (list (required-option 'image-tag)
+        (option '(#\A "entry-point-argument") #t #f
+                entry-point-argument-spec-option-parser)))
 
 (define (show-docker-format-options)
   (display (G_ "
@@ -1308,7 +1333,12 @@ (define (show-docker-format-options)
 (define (show-docker-format-options/detailed)
   (display (G_ "
       --image-tag=NAME
-                         Use the given NAME for the Docker image repository"))
+                         Use the given NAME for the Docker image repository
+
+      -A, --entry-point-argument=COMMAND/PARAMETER
+                         Value(s) to use for the Docker EntryPoint arguments.
+                         Multiple instances are accepted. This is only valid
+                         in conjunction with the --entry-point option"))
   (newline)
   (exit 0))
 
@@ -1619,7 +1649,9 @@ (define-command (guix-pack . args)
                    (extra-options (match pack-format
                                     ('docker
                                      (list #:image-tag
-                                           (assoc-ref opts 'image-tag)))
+                                           (assoc-ref opts 'image-tag)
+                                           #:entry-point-argument
+                                           (assoc-ref opts 'entry-point-argument)))
                                     ('deb
                                      (list #:control-file
                                            (process-file-arg opts 'control-file)
-- 
2.41.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 26 Dec 2023 02:21:03 GMT) Full text and rfc822 format available.

Message #101 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH 2/5] tests: docker-system: Increase image size.
Date: Tue, 26 Dec 2023 05:18:54 +0300
* gnu/tests/docker.scm (run-docker-system-test)[vm]: Increase
'disk-image-size'.

Change-Id: If88588d8981efdfdc539460900f1cbb9a663f9cb
---
 gnu/tests/docker.scm | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index edc9804414..9e9d2e2d07 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -212,7 +212,7 @@ (define (run-docker-system-test tarball)
     (virtual-machine
      (operating-system os)
      (volatile? #f)
-     (disk-image-size (* 5500 (expt 2 20)))
+     (disk-image-size (* 6000 (expt 2 20)))
      (memory-size 2048)
      (port-forwardings '())))
 
-- 
2.41.0





Information forwarded to guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 26 Dec 2023 02:21:03 GMT) Full text and rfc822 format available.

Message #104 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH 3/5] guix: docker: Build layered images.
Date: Tue, 26 Dec 2023 05:18:55 +0300
* guix/docker.scm (%docker-image-max-layers): New variable.
(size-sorted-store-items, create-empty-tar): New procedures.
(config, manifest, build-docker-image): Build layered images.

Change-Id: I4c8846bff0a3ceccb77e6bdf95d4942e5c3efe41
---
 guix/docker.scm | 212 +++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 166 insertions(+), 46 deletions(-)

diff --git a/guix/docker.scm b/guix/docker.scm
index 5e6460f43f..5deca2afdb 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017, 2018, 2019, 2021 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich <at> gmail.com>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,16 +30,27 @@ (define-module (guix docker)
                           with-directory-excursion
                           invoke))
   #:use-module (gnu build install)
+  #:use-module ((guix build store-copy)
+                #:select (file-size))
   #:use-module (json)                             ;guile-json
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:use-module ((texinfo string-utils)
                 #:select (escape-special-chars))
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 match)
-  #:export (build-docker-image))
+  #:export (%docker-image-max-layers
+            build-docker-image))
+
+;; The maximum number of layers allowed in a Docker image is typically around
+;; 128, although it may vary depending on the Docker daemon. However, we
+;; recommend setting the limit to 100 to ensure sufficient room for future
+;; extensions.
+(define %docker-image-max-layers
+  #f)
 
 ;; Generate a 256-bit identifier in hexadecimal encoding for the Docker image.
 (define docker-id
@@ -92,12 +104,12 @@ (define (canonicalize-repository-name name)
                       (make-string (- min-length l) padding-character)))
       (_ normalized-name))))
 
-(define* (manifest path id #:optional (tag "guix"))
+(define* (manifest path layers #:optional (tag "guix"))
   "Generate a simple image manifest."
   (let ((tag (canonicalize-repository-name tag)))
     `#(((Config . "config.json")
         (RepoTags . #(,(string-append tag ":latest")))
-        (Layers . #(,(string-append id "/layer.tar")))))))
+        (Layers . ,(list->vector layers))))))
 
 ;; According to the specifications this is required for backwards
 ;; compatibility.  It duplicates information provided by the manifest.
@@ -106,8 +118,8 @@ (define* (repositories path id #:optional (tag "guix"))
   `((,(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 '()))
-  "Generate a minimal image configuration for the given LAYER file."
+(define* (config layers-diff-ids time arch #:key entry-point (environment '()))
+  "Generate a minimal image configuration for the given LAYERS files."
   ;; "architecture" must be values matching "platform.arch" in the
   ;; runtime-spec at
   ;; https://github.com/opencontainers/runtime-spec/blob/v1.0.0-rc2/config.md#platform
@@ -125,7 +137,7 @@ (define* (config layer time arch #:key entry-point (environment '()))
     (container_config . #nil)
     (os . "linux")
     (rootfs . ((type . "layers")
-               (diff_ids . #(,(layer-diff-id layer)))))))
+               (diff_ids . ,(list->vector layers-diff-ids))))))
 
 (define directive-file
   ;; Return the file or directory created by a 'evaluate-populate-directive'
@@ -136,6 +148,26 @@ (define directive-file
     (('directory name _ ...)
      (string-trim name #\/))))
 
+(define (size-sorted-store-items items max-layers)
+  "Split list of ITEMS at %MAX-LAYERS and sort by disk usage."
+  (let* ((items-length (length items))
+         (head tail
+               (split-at
+                (map (match-lambda ((size . item) item))
+                     (sort (map (lambda (item)
+                                  (cons (file-size item) item))
+                                items)
+                           (lambda (item1 item2)
+                             (< (match item2 ((size . _) size))
+                                (match item1 ((size . _) size))))))
+                (if (>= items-length max-layers)
+                    (- max-layers 2)
+                    (1- items-length)))))
+    (list head tail)))
+
+(define (create-empty-tar file)
+  (invoke "tar" "-cf" file "--files-from" "/dev/null"))
+
 (define* (build-docker-image image paths prefix
                              #:key
                              (repository "guix")
@@ -146,11 +178,13 @@ (define* (build-docker-image image paths prefix
                              entry-point
                              (environment '())
                              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.  REPOSITORY
-is a descriptive name that will show up in \"REPOSITORY\" column of the output
-of \"docker images\".
+                             (creation-time (current-time time-utc))
+                             max-layers
+                             root-system)
+  "Write to IMAGE a layerer Docker image archive containing the given PATHS.
+PREFIX 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.
@@ -172,7 +206,14 @@ (define* (build-docker-image image paths prefix
 SYSTEM is a GNU triplet (or prefix thereof) of the system the binaries in
 PATHS are for; it is used to produce metadata in the image.  Use COMPRESSOR, a
 command such as '(\"gzip\" \"-9n\"), to compress IMAGE.  Use CREATION-TIME, a
-SRFI-19 time-utc object, as the creation time in metadata."
+SRFI-19 time-utc object, as the creation time in metadata.
+
+When MAX-LAYERS is not false build layered image, providing a Docker
+image with many of the store paths being on their own layer to improve sharing
+between images.
+
+ROOT-SYSTEM is a directory with a provisioned root file system, which will be
+added to image as a layer."
   (define (sanitize path-fragment)
     (escape-special-chars
      ;; GNU tar strips the leading slash off of absolute paths before applying
@@ -203,6 +244,59 @@ (define* (build-docker-image image paths prefix
     (if (eq? '() transformations)
         '()
         `("--transform" ,(transformations->expression transformations))))
+  (define (seal-layer)
+    ;; Add 'layer.tar' to 'image.tar' under the right name.  Return its hash.
+    (let* ((file-hash (layer-diff-id "layer.tar"))
+           (file-name (string-append file-hash "/layer.tar")))
+      (mkdir file-hash)
+      (rename-file "layer.tar" file-name)
+      (invoke "tar" "-rf" "image.tar" file-name)
+      (delete-file file-name)
+      file-hash))
+  (define layers-hashes
+    ;; Generate a tarball that includes container image layers as tarballs,
+    ;; along with a manifest.json file describing the layer and config file
+    ;; locations.
+    (match-lambda
+      (((head ...) (tail ...) id)
+       (create-empty-tar "image.tar")
+       (let* ((head-layers
+               (map
+                (lambda (file)
+                  (invoke "tar" "cf" "layer.tar" file)
+                  (seal-layer))
+                head))
+              (tail-layer
+               (begin
+                 (create-empty-tar "layer.tar")
+                 (for-each (lambda (file)
+                             (invoke "tar" "-rf" "layer.tar" file))
+                           tail)
+                 (let* ((file-hash (layer-diff-id "layer.tar"))
+                        (file-name (string-append file-hash "/layer.tar")))
+                   (mkdir file-hash)
+                   (rename-file "layer.tar" file-name)
+                   (invoke "tar" "-rf" "image.tar" file-name)
+                   (delete-file file-name)
+                   file-hash)))
+              (customization-layer
+               (let* ((file-id (string-append id "/layer.tar"))
+                      (file-hash (layer-diff-id file-id))
+                      (file-name (string-append file-hash "/layer.tar")))
+                 (mkdir file-hash)
+                 (rename-file file-id file-name)
+                 (invoke "tar" "-rf" "image.tar" file-name)
+                 file-hash))
+              (all-layers
+               (append head-layers (list tail-layer customization-layer))))
+         (with-output-to-file "manifest.json"
+           (lambda ()
+             (scm->json (manifest prefix
+                                  (map (cut string-append <> "/layer.tar")
+                                       all-layers)
+                                  repository))))
+         (invoke "tar" "-rf" "image.tar" "manifest.json")
+         all-layers))))
   (let* ((directory "/tmp/docker-image") ;temporary working directory
          (id (docker-id prefix))
          (time (date->string (time-utc->date creation-time) "~4"))
@@ -229,26 +323,39 @@ (define* (build-docker-image image paths prefix
         (with-output-to-file "json"
           (lambda () (scm->json (image-description id time))))
 
-        ;; Create a directory for the non-store files that need to go into the
-        ;; archive.
-        (mkdir "extra")
+        (if root-system
+            (let ((directory (getcwd)))
+              (with-directory-excursion root-system
+                (apply invoke "tar"
+                       "-cf" (string-append directory "/layer.tar")
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." "..")))))))))
+            (begin
+              ;; Create a directory for the non-store files that need to go
+              ;; into the archive.
+              (mkdir "extra")
 
-        (with-directory-excursion "extra"
-          ;; Create non-store files.
-          (for-each (cut evaluate-populate-directive <> "./")
-                    extra-files)
+              (with-directory-excursion "extra"
+                ;; Create non-store files.
+                (for-each (cut evaluate-populate-directive <> "./")
+                          extra-files)
 
-          (when database
-            ;; Initialize /var/guix, assuming PREFIX points to a profile.
-            (install-database-and-gc-roots "." database prefix))
+                (when database
+                  ;; Initialize /var/guix, assuming PREFIX points to a
+                  ;; profile.
+                  (install-database-and-gc-roots "." database prefix))
 
-          (apply invoke "tar" "-cf" "../layer.tar"
-                 `(,@transformation-options
-                   ,@(tar-base-options)
-                   ,@paths
-                   ,@(scandir "."
-                              (lambda (file)
-                                (not (member file '("." ".."))))))))
+                (apply invoke "tar" "-cf" "../layer.tar"
+                       `(,@transformation-options
+                         ,@(tar-base-options)
+                         ,@(if max-layers '() paths)
+                         ,@(scandir "."
+                                    (lambda (file)
+                                      (not (member file '("." ".."))))))))
+              (delete-file-recursively "extra")))
 
         ;; It is possible for "/" to show up in the archive, especially when
         ;; applying transformations.  For example, the transformation
@@ -261,24 +368,37 @@ (define* (build-docker-image image paths prefix
         ;; error messages.
         (with-error-to-port (%make-void-port "w")
           (lambda ()
-            (system* "tar" "--delete" "/" "-f" "layer.tar")))
-
-        (delete-file-recursively "extra"))
+            (system* "tar" "--delete" "/" "-f" "layer.tar"))))
 
       (with-output-to-file "config.json"
         (lambda ()
-          (scm->json (config (string-append id "/layer.tar")
-                             time arch
-                             #:environment environment
-                             #:entry-point entry-point))))
-      (with-output-to-file "manifest.json"
-        (lambda ()
-          (scm->json (manifest prefix id repository))))
-      (with-output-to-file "repositories"
-        (lambda ()
-          (scm->json (repositories prefix id repository)))))
-
-    (apply invoke "tar" "-cf" image "-C" directory
-           `(,@(tar-base-options #:compressor compressor)
-             "."))
+          (scm->json
+           (config (if max-layers
+                       (layers-hashes
+                        (append (size-sorted-store-items paths max-layers)
+                                (list id)))
+                       (list (layer-diff-id (string-append id "/layer.tar"))))
+                   time arch
+                   #:environment environment
+                   #:entry-point entry-point))))
+      (if max-layers
+          (begin
+            (invoke "tar" "-rf" "image.tar" "config.json")
+            (if compressor
+                (begin
+                  (apply invoke `(,@compressor "image.tar"))
+                  (copy-file "image.tar.gz" image))
+                (copy-file "image.tar" image)))
+          (begin
+            (with-output-to-file "manifest.json"
+              (lambda ()
+                (scm->json (manifest prefix
+                                     (list (string-append id "/layer.tar"))
+                                     repository))))
+            (with-output-to-file "repositories"
+              (lambda ()
+                (scm->json (repositories prefix id repository))))
+            (apply invoke "tar" "-cf" image
+                   `(,@(tar-base-options #:compressor compressor)
+                     ".")))))
     (delete-file-recursively directory)))
-- 
2.41.0





Information forwarded to guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 26 Dec 2023 02:21:04 GMT) Full text and rfc822 format available.

Message #107 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH 4/5] guix: pack: Build layered images.
Date: Tue, 26 Dec 2023 05:18:56 +0300
* guix/scripts/pack.scm (docker-image, guix-pack, %default-options,
%docker-format-options, show-docker-format-options/detailed): Handle
'--max-layers' option.
* doc/guix.texi (Invoking guix pack): Document this.

Change-Id: I90660b2421fcdde891f003469fe2e2edaac7da41
---
 doc/guix.texi         | 26 ++++++++++++++++++++++-
 guix/scripts/pack.scm | 38 ++++++++++++++++++++++++++-------
 tests/pack.scm        | 49 +++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 104 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index cca250dc31..d21048405a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -56,7 +56,7 @@
 Copyright @copyright{} 2017, 2018, 2019, 2020, 2023 Arun Isaac@*
 Copyright @copyright{} 2017 nee@*
 Copyright @copyright{} 2018 Rutger Helling@*
-Copyright @copyright{} 2018, 2021 Oleg Pykhalov@*
+Copyright @copyright{} 2018, 2021, 2023 Oleg Pykhalov@*
 Copyright @copyright{} 2018 Mike Gerwitz@*
 Copyright @copyright{} 2018 Pierre-Antoine Rouby@*
 Copyright @copyright{} 2018, 2019 Gábor Boskovits@*
@@ -7441,6 +7441,30 @@ Invoking guix pack
 guix pack -f docker --entry-point=bin/guile --entry-point-argument="--help" guile
 @end example
 
+@cindex maximum layers argument, for docker images
+@item --max-layers=@code{n}
+Specifies the maximum number of Docker image layers allowed when
+building an image.
+
+@example
+guix pack -f docker --max-layers=100 guile
+@end example
+
+This option allows you to limit the number of layers in a Docker image.
+Docker images are comprised of multiple layers, and each layer adds to
+the overall size and complexity of the image.  By setting a maximum
+number of layers, you can control the following effects:
+
+@itemize
+@item Disk Usage:
+Increasing the number of layers can help optimize the disk space
+required to store multiple images built with a similar package graph.
+
+@item Pulling:
+When transferring images between different nodes or systems, having more
+layers can reduce the time required to pull the image.
+@end itemize
+
 @item --expression=@var{expr}
 @itemx -e @var{expr}
 Consider the package @var{expr} evaluates to.
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 4c0a602eb1..22f0dd6061 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2020 Eric Bavier <bavier <at> posteo.net>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
 ;;; Copyright © 2023 Graham James Addis <graham <at> addis.org.uk>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -48,6 +49,7 @@ (define-module (guix scripts pack)
   #:use-module (guix scripts build)
   #:use-module (guix transformations)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module ((guix docker) #:select (%docker-image-max-layers))
   #:use-module (gnu compression)
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
@@ -517,12 +519,15 @@ (define* (docker-image name profile
                        localstatedir?
                        (symlinks '())
                        (archiver tar)
-                       (extra-options '()))
+                       (extra-options '())
+                       max-layers)
   "Return a derivation to construct a Docker image of PROFILE.  The
 image is a tarball conforming to the Docker Image Specification, compressed
 with COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it
 must a be a GNU triplet and it is used to derive the architecture metadata in
-the image.  EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument."
+the image.  EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument.
+If MAX-LAYERS is not false, the image will with many of the store paths being
+on their own layer to improve sharing between images."
   (define database
     (and localstatedir?
          (file-append (store-database (list profile))
@@ -583,11 +588,17 @@ (define* (docker-image name profile
                        (cons* (string-append prefix "/" entry-point)
 		              entry-point-argument))))
 
-            (setenv "PATH" #+(file-append archiver "/bin"))
+            (setenv "PATH"
+                    (string-join `(#+(file-append archiver "/bin")
+                                   #+@(if max-layers
+                                          (list (file-append gzip "/bin"))
+                                          '()))
+                                 ":"))
 
             (let-keywords '#$extra-options #f
                           ((image-tag #f)
-                           (entry-point-argument #f))
+                           (entry-point-argument #f)
+                           (max-layers #f))
 
               (build-docker-image #$output
                                   (map store-info-item
@@ -609,7 +620,8 @@ (define* (docker-image name profile
                                   #:compressor
                                   #+(compressor-command compressor)
                                   #:creation-time
-                                  (make-time time-utc 0 1)))))))
+                                  (make-time time-utc 0 1)
+                                  #:max-layers max-layers))))))
 
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
@@ -1287,6 +1299,7 @@ (define %default-options
     (verbosity . 1)
     (symlinks . ())
     (entry-point-argument . ())
+    (max-layers . ,%docker-image-max-layers)
     (compressor . ,(first %compressors))))
 
 (define %formats
@@ -1324,7 +1337,11 @@ (define (required-option symbol)
 (define %docker-format-options
   (list (required-option 'image-tag)
         (option '(#\A "entry-point-argument") #t #f
-                entry-point-argument-spec-option-parser)))
+                entry-point-argument-spec-option-parser)
+        (option '("max-layers") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'max-layers (string->number* arg)
+                              result)))))
 
 (define (show-docker-format-options)
   (display (G_ "
@@ -1338,7 +1355,10 @@ (define (show-docker-format-options/detailed)
       -A, --entry-point-argument=COMMAND/PARAMETER
                          Value(s) to use for the Docker EntryPoint arguments.
                          Multiple instances are accepted. This is only valid
-                         in conjunction with the --entry-point option"))
+                         in conjunction with the --entry-point option
+
+      --max-layers=N
+                         Number of image layers"))
   (newline)
   (exit 0))
 
@@ -1651,7 +1671,9 @@ (define-command (guix-pack . args)
                                      (list #:image-tag
                                            (assoc-ref opts 'image-tag)
                                            #:entry-point-argument
-                                           (assoc-ref opts 'entry-point-argument)))
+                                           (assoc-ref opts 'entry-point-argument)
+                                           #:max-layers
+                                           (assoc-ref opts 'max-layers)))
                                     ('deb
                                      (list #:control-file
                                            (process-file-arg opts 'control-file)
diff --git a/tests/pack.scm b/tests/pack.scm
index ac78817a70..fda4dc04c6 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017-2021, 2023 Ludovic Courtès <ludo <at> gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado <at> elephly.net>
 ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,6 +30,7 @@ (define-module (test-pack)
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module (guix utils)
+  #:use-module ((guix build utils) #:select (%store-directory))
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (libc-utf8-locales-for-target))
   #:use-module (gnu packages bootstrap)
@@ -250,6 +252,53 @@ (define rpm-for-tests
                            (mkdir #$output)))))))
       (built-derivations (list check))))
 
+  (unless store (test-skip 1))
+  (test-assertm "docker-layered-image + localstatedir"
+    (mlet* %store-monad
+        ((guile   (set-guile-for-build (default-guile)))
+         (profile -> (profile
+                      (content (packages->manifest (list %bootstrap-guile)))
+                      (hooks '())
+                      (locales? #f)))
+         (tarball (docker-image "docker-pack" profile
+                                #:symlinks '(("/bin/Guile" -> "bin/guile"))
+                                #:localstatedir? #t
+                                #:max-layers 100))
+         (check   (gexp->derivation "check-tarball"
+                                    (with-imported-modules '((guix build utils))
+                                      #~(begin
+                                          (use-modules (guix build utils)
+                                                       (ice-9 match))
+
+                                          (define bin
+                                            (string-append "." #$profile "/bin"))
+
+                                          (define store
+                                            (string-append "." #$(%store-directory)))
+
+                                          (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+                                          (mkdir "base")
+                                          (with-directory-excursion "base"
+                                            (invoke "tar" "xvf" #$tarball))
+
+                                          (match (find-files "base" "layer.tar")
+                                            ((layers ...)
+                                             (for-each (lambda (layer)
+                                                         (invoke "tar" "xvf" layer)
+                                                         (invoke "chmod" "--recursive" "u+w" store))
+                                                       layers)))
+
+                                          (when
+                                              (and (file-exists? (string-append bin "/guile"))
+                                                   (file-exists? "var/guix/db/db.sqlite")
+                                                   (file-is-directory? "tmp")
+                                                   (string=? (string-append #$%bootstrap-guile "/bin")
+                                                             (pk 'binlink (readlink bin)))
+                                                   (string=? (string-append #$profile "/bin/guile")
+                                                             (pk 'guilelink (readlink "bin/Guile"))))
+                                            (mkdir #$output)))))))
+      (built-derivations (list check))))
+
   (unless store (test-skip 1))
   (test-assertm "squashfs-image + localstatedir"
     (mlet* %store-monad
-- 
2.41.0





Information forwarded to guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 26 Dec 2023 02:21:04 GMT) Full text and rfc822 format available.

Message #110 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: 62153 <at> debbugs.gnu.org
Cc: Oleg Pykhalov <go.wigust <at> gmail.com>
Subject: [PATCH 5/5] scripts: system: Build layered images.
Date: Tue, 26 Dec 2023 05:18:57 +0300
* guix/scripts/system.scm (show-help, %docker-format-options, %options,
%default-options, show-docker-format-options,
show-docker-format-options/detailed, process-action): Handle '--max-layers'
option.
* gnu/system/image.scm (system-docker-image): Same.
* gnu/image.scm (<image>)[max-layers]: New record field.

Change-Id: I2726655aefd6688b976057fd5a38e9972ebfc292
---
 gnu/image.scm           |  4 ++++
 gnu/system/image.scm    | 41 ++++++++++++++++++++++++++++-------------
 guix/scripts/system.scm | 28 ++++++++++++++++++++++++++--
 3 files changed, 58 insertions(+), 15 deletions(-)

diff --git a/gnu/image.scm b/gnu/image.scm
index 523653dd77..7fb06dec10 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe <at> gnu.org>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -42,6 +43,7 @@ (define-module (gnu image)
             image-format
             image-platform
             image-size
+            image-max-layers
             image-operating-system
             image-partition-table-type
             image-partitions
@@ -170,6 +172,8 @@ (define-record-type* <image>
   (size               image-size  ;size in bytes as integer
                       (default 'guess)
                       (sanitize validate-size))
+  (max-layers         image-max-layers  ;number of layers as integer
+                      (default #false))
   (operating-system   image-operating-system)  ;<operating-system>
   (partition-table-type image-partition-table-type ; 'mbr or 'gpt
                       (default 'mbr)
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b825892232..2cc1012893 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo <at> cyberdimension.org>
 ;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
 ;;; Copyright © 2023 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2023 Oleg Pykhalov <go.wigust <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -686,7 +687,8 @@ (define (image-with-label base-image label)
 
 (define* (system-docker-image image
                               #:key
-                              (name "docker-image"))
+                              (name "docker-image")
+                              (archiver tar))
   "Build a docker image for IMAGE.  NAME is the base name to use for the
 output file."
   (define boot-program
@@ -731,6 +733,7 @@ (define* (system-docker-image image
               (use-modules (guix docker)
                            (guix build utils)
                            (gnu build image)
+                           (srfi srfi-1)
                            (srfi srfi-19)
                            (guix build store-copy)
                            (guix store database))
@@ -754,18 +757,30 @@ (define* (system-docker-image image
                                            #:register-closures? #$register-closures?
                                            #:deduplicate? #f
                                            #:system-directory #$os)
-                (build-docker-image
-                 #$output
-                 (cons* image-root
-                        (map store-info-item
-                             (call-with-input-file #$graph
-                               read-reference-graph)))
-                 #$os
-                 #:entry-point '(#$boot-program #$os)
-                 #:compressor '(#+(file-append gzip "/bin/gzip") "-9n")
-                 #:creation-time (make-time time-utc 0 1)
-                 #:system #$image-target
-                 #:transformations `((,image-root -> ""))))))))
+                (when #$(image-max-layers image)
+                  (setenv "PATH"
+                          (string-join (list #+(file-append archiver "/bin")
+                                             #+(file-append gzip "/bin"))
+                                       ":")))
+                (apply build-docker-image
+                       (append (list #$output
+                                     (append (if #$(image-max-layers image)
+                                                 '()
+                                                 (list image-root))
+                                             (map store-info-item
+                                                  (call-with-input-file #$graph
+                                                    read-reference-graph)))
+                                     #$os
+                                     #:entry-point '(#$boot-program #$os)
+                                     #:compressor
+                                     '(#+(file-append gzip "/bin/gzip") "-9n")
+                                     #:creation-time (make-time time-utc 0 1)
+                                     #:system #$image-target
+                                     #:transformations `((,image-root -> "")))
+                               (if #$(image-max-layers image)
+                                   (list #:root-system image-root
+                                         #:max-layers #$(image-max-layers image))
+                                   '()))))))))
 
     (computed-file name builder
                    ;; Allow offloading so that this I/O-intensive process
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f85b663d64..a21ecd4d1e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -58,6 +58,7 @@ (define-module (guix scripts system)
   #:use-module (guix scripts system reconfigure)
   #:use-module (guix build utils)
   #:use-module (guix progress)
+  #:use-module ((guix docker) #:select (%docker-image-max-layers))
   #:use-module (gnu build image)
   #:use-module (gnu build install)
   #:autoload   (gnu build file-systems)
@@ -1053,6 +1054,8 @@ (define (show-help)
   (newline)
   (show-native-build-options-help)
   (newline)
+  (show-docker-format-options)
+  (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
@@ -1060,6 +1063,12 @@ (define (show-help)
   (newline)
   (show-bug-report-information))
 
+(define %docker-format-options
+  (list (option '("max-layers") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'max-layers (string->number* arg)
+                               result)))))
+
 (define %options
   ;; Specifications of the command-line options.
   (cons* (option '(#\h "help") #f #f
@@ -1154,7 +1163,8 @@ (define %options
                    (alist-cons 'list-installed (or arg "") result)))
          (append %standard-build-options
                  %standard-cross-build-options
-                 %standard-native-build-options)))
+                 %standard-native-build-options
+                 %docker-format-options)))
 
 (define %default-options
   ;; Alist of default option values.
@@ -1175,7 +1185,8 @@ (define %default-options
     (label . #f)
     (volatile-image-root? . #f)
     (volatile-vm-root? . #t)
-    (graph-backend . "graphviz")))
+    (graph-backend . "graphviz")
+    (max-layers . ,%docker-image-max-layers)))
 
 (define (verbosity-level opts)
   "Return the verbosity level based on OPTS, the alist of parsed options."
@@ -1183,6 +1194,17 @@ (define (verbosity-level opts)
       (if (eq? (assoc-ref opts 'action) 'build)
           3 1)))
 
+(define (show-docker-format-options)
+  (display (G_ "
+      --help-docker-format list options specific to the docker image type.")))
+
+(define (show-docker-format-options/detailed)
+  (display (G_ "
+      --max-layers=N
+                         Number of image layers"))
+  (newline)
+  (exit 0))
+
 
 ;;;
 ;;; Entry point.
@@ -1245,6 +1267,7 @@ (define (process-action action args opts)
                                            ((docker-image) docker-image-type)
                                            (else image-type)))
                             (image-size (assoc-ref opts 'image-size))
+                            (image-max-layers (assoc-ref opts 'max-layers))
                             (volatile?
                              (assoc-ref opts 'volatile-image-root?))
                             (shared-network?
@@ -1258,6 +1281,7 @@ (define (process-action action args opts)
                                       (image-with-label base-image label)
                                       base-image))
                          (size image-size)
+                         (max-layers image-max-layers)
                          (volatile-root? volatile?)
                          (shared-network? shared-network?))))
          (os          (or (image-operating-system image)
-- 
2.41.0





Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Tue, 26 Dec 2023 02:42:01 GMT) Full text and rfc822 format available.

Message #113 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 64173 <at> debbugs.gnu.org, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] Merging guix pack changes for Docker containers
 packaging
Date: Tue, 26 Dec 2023 05:40:52 +0300
[Message part 1 (text/plain, inline)]
Hi Ludovic,

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

> Apologies for not replying earlier.  I occasionally get reminded of the
> fact that building single-layer images is a problem, but only now did I
> take the time to look more closely at the latest version of these
> patches.
>
> Oleg Pykhalov <go.wigust <at> gmail.com> skribis:
>
>> I would like to merge 62153.  After 64173 will be merge, merging 62153
>> is not possible without conflict resolving with Git.
>>
>> 64173 introduces ‘%docker-format-options’ variable.  With this variable
>> it's possible in 62153 to replace ‘--image-type=docker-layered’ with
>> ‘--docker-layers=N’ option, where:
>>
>>     if ‘N’ is zero, then use current non layered format
>>     if ‘N’ is bigger than zero, then use layered format
>
> OK we should do that.  However, the original submitter of #64173
> apparently dropped the ball as we were approaching the final version.
>
> Would you like to adopt it and submit/push a version that incorporates
> the latest comments?
>
> Alternatively, we could do the opposite: merge the Docker layer patches
> first, and then rebase the ‘%docker-format-options’ patch, after which
> we could add the ‘--docker-layers’ option.
>
> What’s your preference?

[…]

Patches 64173 and 62153 (v5) have been sent to 62153.

If you don't mind, I have changed the option naming to '--max-layers=N'
instead of '--docker-layers=N' to align with the format of
'--entry-point-argument' (without specifying Docker as the only image
format that utilizes layers).

I did not include code to check if 'N' is zero and use the current
non-layered format. Instead, I opted for the default value of '#false'
as it was easier to implement.


Regards,
Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 27 Dec 2023 18:16:02 GMT) Full text and rfc822 format available.

Message #116 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>,
 Graham James Addis <grahamjamesaddis <at> gmail.com>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 Christopher Baines <guix <at> cbaines.net>,
 Ludovic Courtès <ludo <at> gnu.org>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/5] guix: pack: Add
 '--entry-point-argument' option.
Date: Wed, 27 Dec 2023 19:14:57 +0100
Hello Oleg,

> +  "A SRFI-37 opion parser for the --entry-point-argument option. The spec

option -> option

> +takes multiple occurances. The entries are used in the exec form for the

orrurances -> occurrences, also use two spaces after a dot.

> +              ;; first entry is constructed by prefixing the entry-point with
> +              ;; the supplied index subsequent entries are taken from the

subsequent -> , subsequent

> +      -A, --entry-point-argument=COMMAND/PARAMETER
> +                         Value(s) to use for the Docker EntryPoint arguments.

EntryPoint -> ENTRYPOINT

Thanks,

Mathieu




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 27 Dec 2023 18:18:01 GMT) Full text and rfc822 format available.

Message #119 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>,
 Graham James Addis <grahamjamesaddis <at> gmail.com>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 Christopher Baines <guix <at> cbaines.net>,
 Ludovic Courtès <ludo <at> gnu.org>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 1/5] guix: pack: Add
 '--entry-point-argument' option.
Date: Wed, 27 Dec 2023 19:16:55 +0100
+              (and=> entry-point
+                     (lambda (entry-point)
+                       (cons* (string-append prefix "/" entry-point)
+		              entry-point-argument))))
   ^          ^

There are also two tabulations here that need to be removed.

Thanks,

Mathieu




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 27 Dec 2023 20:17:01 GMT) Full text and rfc822 format available.

Message #122 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 Christopher Baines <guix <at> cbaines.net>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 3/5] guix: docker: Build layered images.
Date: Wed, 27 Dec 2023 21:15:51 +0100
> +When MAX-LAYERS is not false build layered image, providing a Docker
> +image with many of the store paths being on their own layer to improve sharing
> +between images.

"many of the store paths being on their own layer" is a big vague.

It could be rephrased to "store paths splitted in their own layers" or so.

Thanks,

Mathieu




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 27 Dec 2023 20:26:02 GMT) Full text and rfc822 format available.

Message #125 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 Christopher Baines <guix <at> cbaines.net>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 4/5] guix: pack: Build layered images.
Date: Wed, 27 Dec 2023 21:25:02 +0100
> +If MAX-LAYERS is not false, the image will with many of the store paths being
> +on their own layer to improve sharing between images."

Same comment as in previous patch, "many" is a bit vague. "the image
will be splitted in up to MAX-LAYERS layers" or so could work.

> +         (check   (gexp->derivation "check-tarball"
> +                                    (with-imported-modules '((guix build utils))

You could rearrange as:

--8<---------------cut here---------------start------------->8---
(check   (gexp->derivation
          "check-tarball"
          (with-imported-modules '((guix build utils))
--8<---------------cut here---------------end--------------->8---

to reduce the indentation of this block:

> +                                      #~(begin
> +                                          (use-modules (guix build utils)
> +                                                       (ice-9 match))

...

> +                                                   (string=? (string-append #$%bootstrap-guile "/bin")
> +                                                             (pk 'binlink (readlink bin)))
> +                                                   (string=? (string-append #$profile "/bin/guile")
> +                                                             (pk 'guilelink (readlink "bin/Guile"))))

Left over pk's?

Thanks,

Mathieu




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Wed, 27 Dec 2023 20:30:01 GMT) Full text and rfc822 format available.

Message #128 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>,
 Ludovic Courtès <ludo <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 Christopher Baines <guix <at> cbaines.net>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 5/5] scripts: system: Build layered images.
Date: Wed, 27 Dec 2023 21:29:05 +0100
Other than the few cosmetic remarks, the series looks great. I tested
producing multi-layers pack and images with success.

You may want to wait for Ludo's opinion as a reviewer of the v4, but as
far as I am concerned, I think that you can directly proceed with the
cosmetic issues fixed.

Thanks,

Mathieu




Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Mon, 08 Jan 2024 16:50:02 GMT) Full text and rfc822 format available.

Message #131 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Mathieu Othacehe <othacehe <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Oleg Pykhalov <go.wigust <at> gmail.com>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 Christopher Baines <guix <at> cbaines.net>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 5/5] scripts: system: Build layered images.
Date: Mon, 08 Jan 2024 17:49:03 +0100
Hello Oleg and all,

Mathieu Othacehe <othacehe <at> gnu.org> skribis:

> Other than the few cosmetic remarks, the series looks great. I tested
> producing multi-layers pack and images with success.
>
> You may want to wait for Ludo's opinion as a reviewer of the v4, but as
> far as I am concerned, I think that you can directly proceed with the
> cosmetic issues fixed.

I haven’t been able to test it yet, but I agree with Mathieu’s
suggestions and I agree that you can proceed with this small fixes.

As a bonus, consider adding an entry in ‘etc/news.scm’: it’s definitely
news-worthy!

Ludo’.




Reply sent to Oleg Pykhalov <go.wigust <at> gmail.com>:
You have taken responsibility. (Tue, 09 Jan 2024 13:00:02 GMT) Full text and rfc822 format available.

Notification sent to Oleg Pykhalov <go.wigust <at> gmail.com>:
bug acknowledged by developer. (Tue, 09 Jan 2024 13:00:02 GMT) Full text and rfc822 format available.

Message #136 received at 62153-done <at> debbugs.gnu.org (full text, mbox):

From: Oleg Pykhalov <go.wigust <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 62153-done <at> debbugs.gnu.org, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#62153] [PATCH 5/5] scripts: system: Build layered images.
Date: Tue, 09 Jan 2024 15:58:58 +0300
[Message part 1 (text/plain, inline)]
Hello Ludovic,

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

>> Other than the few cosmetic remarks, the series looks great. I tested
>> producing multi-layers pack and images with success.
>>
>> You may want to wait for Ludo's opinion as a reviewer of the v4, but as
>> far as I am concerned, I think that you can directly proceed with the
>> cosmetic issues fixed.
>
> I haven’t been able to test it yet, but I agree with Mathieu’s
> suggestions and I agree that you can proceed with this small fixes.
>
> As a bonus, consider adding an entry in ‘etc/news.scm’: it’s definitely
> news-worthy!

All Mathieu's suggestions applied, etc/news.scm from v4 slightly
modified accordingly.  Everything pushed to master.

Thanks everyone for helping adding this feature.

Oleg.
[signature.asc (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#62153; Package guix-patches. (Thu, 18 Jan 2024 14:56:02 GMT) Full text and rfc822 format available.

Message #139 received at 62153 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Oleg Pykhalov <go.wigust <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, Ricardo Wurmus <rekado <at> elephly.net>,
 Christopher Baines <guix <at> cbaines.net>, 62153 <at> debbugs.gnu.org
Subject: Re: [bug#62153] [PATCH 3/5] guix: docker: Build layered images.
Date: Thu, 18 Jan 2024 15:55:39 +0100
Hi Oleg!

Oleg Pykhalov <go.wigust <at> gmail.com> skribis:

> +;; The maximum number of layers allowed in a Docker image is typically around
> +;; 128, although it may vary depending on the Docker daemon. However, we
> +;; recommend setting the limit to 100 to ensure sufficient room for future
> +;; extensions.
> +(define %docker-image-max-layers
> +  #f)

It just occurred to me that the meaning of #f is unclear here; also, the
manual does not specify the default value of ‘--max-layers’.

Should we:

  1. Set ‘%docker-image-max-layers’ to an integer, maybe 100, in
     accordance with the comment above?

  2. Clarify in the manual what the default is, and explain that users
     can pass ‘--max-layers=1’ if they want, well, a single layer.

Thoughts?

Ludo’.




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Fri, 16 Feb 2024 12:24:10 GMT) Full text and rfc822 format available.

This bug report was last modified 69 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.