From patchwork Mon Mar 13 00:33:09 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Oleg Pykhalov X-Patchwork-Id: 47925 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id CA74916DC2; Mon, 13 Mar 2023 00:34:25 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.8 required=5.0 tests=DKIM_ADSP_CUSTOM_MED, DKIM_INVALID,DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H2,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7C9C116D7C for ; Mon, 13 Mar 2023 00:34:21 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1pbW8d-0007Iy-Gw; Sun, 12 Mar 2023 20:34:07 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1pbW8Y-0007IF-Sv for guix-patches@gnu.org; Sun, 12 Mar 2023 20:34:05 -0400 Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1pbW8Y-0004je-L8 for guix-patches@gnu.org; Sun, 12 Mar 2023 20:34:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1pbW8Y-0007MU-GY for guix-patches@gnu.org; Sun, 12 Mar 2023 20:34:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#62153] [PATCH 1/2] guix: docker: Build layered image. References: <20230313003012.14325-1-go.wigust@gmail.com> In-Reply-To: <20230313003012.14325-1-go.wigust@gmail.com> Resent-From: Oleg Pykhalov Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 13 Mar 2023 00:34:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 62153 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 62153@debbugs.gnu.org Cc: Oleg Pykhalov Received: via spool by 62153-submit@debbugs.gnu.org id=B62153.167866763228281 (code B ref 62153); Mon, 13 Mar 2023 00:34:02 +0000 Received: (at 62153) by debbugs.gnu.org; 13 Mar 2023 00:33:52 +0000 Received: from localhost ([127.0.0.1]:33235 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pbW8L-0007M2-Qx for submit@debbugs.gnu.org; Sun, 12 Mar 2023 20:33:52 -0400 Received: from mail-lf1-f44.google.com ([209.85.167.44]:44645) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1pbW8H-0007Lk-R4 for 62153@debbugs.gnu.org; Sun, 12 Mar 2023 20:33:48 -0400 Received: by mail-lf1-f44.google.com with SMTP id s20so13637964lfb.11 for <62153@debbugs.gnu.org>; Sun, 12 Mar 2023 17:33:45 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20210112; t=1678667619; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=+CrOOOw/ikdlb1M3RlnsszvA+7Dk8TTM/NvG8qc83SI=; b=iHqxYHVEdjrAD3nOfLflNU2o+z6+idJXFxkNPSF2vIKr//DRTjgSBMmjJMHt1yR7/r l7pXr7BGT1CDZKbz3J6QXCRkvpMbX0D+kSYByUFAH3qh9FHb0MFTfIsNHQK2drpQ37Fh 9AOxXP53iL08lzhpDMAcwA9H2Ddzq2eOKcrsqFLnxJUWo0W/DvUGzRLUJWp7iP2oBgVg DfYmTqT77SBNrE1+42iPOGCzhI2fZ7UrLFelrcBg9ZshsZEgCJS52S0UobNIYPymH3A5 1kA0RBMkFt01aV2Mcer7W/K5FKCDC94ZsBKMMUnr1TE0vs3oPUjUlM37wx//wZ9vtuqH UBWQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; t=1678667619; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=+CrOOOw/ikdlb1M3RlnsszvA+7Dk8TTM/NvG8qc83SI=; b=ju2e8OOWAGAGcjTR5n+6JknGsD9m+Wz2fDqpwfoMT937YmqzA+/X91a3qTG5sMGFff 5css88xLbjz3YO8h+z4SbsyTdPvuiaXIgDPNc2KtHDVze5FbgdQJBgwxZ04grQFosZnQ +Ph1PFNMrmiCiZnQeerE4xenX7LfyauywhYXsOBhZFiQWl4pNaV9Md9p2WPHuu5TpOZj rfpxKf8pPecicdiFV6D805FHX8ZMpnu0buhhtBlXJapKb6G/ApkjIBpUjtfI6P//DpIJ kM16mTNOfXe2HYmYVm21NtyfrRfs/pUkwZvqGd6C7RkfIe8M/jSmwQI/EL46n25o34HS w9Lg== X-Gm-Message-State: AO0yUKWvk/q9B+lUR50qW6+X4YKsDCL2coAlzZht+vRHpLVwaV7YB2fg /IJ0qTnpN+nollq+stdJh02ZbMltT3E= X-Google-Smtp-Source: AK7set+f4jA6vZNJHp+5bcajjzhECiLfFOjdp+6G4dQQl4YVszRLI571ll0jaQAM/sZPeEc0HK7V2Q== X-Received: by 2002:a19:c20b:0:b0:4dc:807b:9050 with SMTP id l11-20020a19c20b000000b004dc807b9050mr3706795lfc.0.1678667618407; Sun, 12 Mar 2023 17:33:38 -0700 (PDT) Received: from guixsd.wugi.info ([88.201.161.72]) by smtp.gmail.com with ESMTPSA id t22-20020ac24c16000000b004cb41b43c25sm781659lfq.197.2023.03.12.17.33.38 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 12 Mar 2023 17:33:38 -0700 (PDT) From: Oleg Pykhalov Date: Mon, 13 Mar 2023 03:33:09 +0300 Message-Id: <20230313003310.17129-1-go.wigust@gmail.com> X-Mailer: git-send-email 2.38.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 # Copyright © 2018 Nikita # Copyright © 2018 Julien Lepiller -# Copyright © 2018 Oleg Pykhalov +# Copyright © 2018, 2023 Oleg Pykhalov # Copyright © 2018 Alex Vong # Copyright © 2019 Efraim Flashner # Copyright © 2021 Chris Marusich @@ -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 +;;; Copyright © 2023 Oleg Pykhalov ;;; ;;; 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 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli ;;; Copyright © 2022 Alex Griffin +;;; Copyright © 2023 Oleg Pykhalov ;;; ;;; 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 ;;; Copyright © 2019-2022 Ludovic Courtès +;;; Copyright © 2023 Oleg Pykhalov ;;; ;;; 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 ;;; Copyright © 2018 Chris Marusich ;;; Copyright © 2021 Maxim Cournoyer +;;; Copyright © 2023 Oleg Pykhalov ;;; ;;; 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 ;;; Copyright © 2020 Eric Bavier ;;; Copyright © 2022 Alex Griffin +;;; Copyright © 2023 Oleg Pykhalov ;;; ;;; 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 ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2022 Tobias Geerinckx-Rice +;;; Copyright © 2023 Oleg Pykhalov ;;; ;;; 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 ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2021, 2023 Maxim Cournoyer +;;; Copyright © 2023 Oleg Pykhalov ;;; ;;; 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