From patchwork Sun Mar 9 01:06:11 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Giacomo Leidi X-Patchwork-Id: 39955 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 D686027BBEA; Sun, 9 Mar 2025 01:07:57 +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=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable 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 74B1527BBEB for ; Sun, 9 Mar 2025 01:07:57 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tr58D-0007u1-QS; Sat, 08 Mar 2025 20:07:05 -0500 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 1tr58B-0007sW-GY for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:03 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tr58B-0003tO-8T for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:03 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:From:To:In-Reply-To:References:Subject; bh=AJ4/OJL3IyQG00I5i1Z/KH7n+uwTOfq3PFWqIhSVXsw=; b=WdhIbzawYAy1t+JCx767cxM7T0ti9sH8BgHGTtMN9bQ+AJckC+kdV+ob1nwQoY0M0pYjcswPAGLsuLlQSx+hErgyrY9RrzySN9wUWHhL43yjkZUUDWygC+YyiG9fPUjtb2zAKD9scMPFto9cS8X7gFS83Izc9KBOnlCetMv5RH9GmzUjTsIDjcHavH68Ni2iYunRxo4h55BdYmwSnm9q+oPDheb2klxToXq8lRtiXuY2UtU/O1pTmf0tEBxzs3aMumBAV6CoLeFm0mZw5aEGmlzZe1PSZ7xtpHrTzHzhV/fmzAg9zwNHMNe4OieI1F/ek6ZgDo3J+TcQhKnSwZRhJA==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tr58B-0000Kd-2L for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 1/5] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823891194 (code B ref 76081); Sun, 09 Mar 2025 01:07:03 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:29 +0000 Received: from localhost ([127.0.0.1]:57382 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57c-0000J9-O1 for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:29 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:32619) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000IY-AV for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:26 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482382; bh=AJ4/OJL3IyQG00I5i1Z/KH7n+uwTOfq3PFWqIhSVXsw=; h=From:To:Cc:Subject:Date:From; b=J0v3+JL7rRNTDwEmPNYqmhINDY7Zw19ydBYBALNr49hB/0S53okIhiZKEQbfYS5m0 Y0HWMTxesXDY5RCgbuuMk25Byozsbz0ZapKOMWY0WSJl97YPitdV0ufZTK5NEZ9pW6 VoyPZv4hPA55wGHOR3Dq6HT42cvg7lWVhWOdgT4Q= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKp4jpqz11NM; Sun, 9 Mar 2025 01:06:22 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKp3Q1mz11NJ; Sun, 9 Mar 2025 01:06:22 +0000 (UTC) Date: Sun, 9 Mar 2025 02:06:11 +0100 Message-ID: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 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: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: Giacomo Leidi 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 This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) base-commit: 5adfe1b8e92ff332656bcc7a9d71a35306b3411e diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index b3cd109ce6c..d5a211765a6 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " From patchwork Sun Mar 9 01:06:12 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Giacomo Leidi X-Patchwork-Id: 39954 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 1FC9C27BBE9; Sun, 9 Mar 2025 01:07:53 +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=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable 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 08C2327BBE2 for ; Sun, 9 Mar 2025 01:07:50 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tr58K-0007yu-3a; Sat, 08 Mar 2025 20:07:12 -0500 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 1tr58D-0007sz-4e for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:05 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tr58C-0003tt-QS for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:04 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=5w1pguUy5euk/p6I7KBfaqhA/lWVRKQOsLxduTGYZqY=; b=OdAkvj5wy/tQpSwfcADY1t8DANGk21PoakNbdgAh8oj4P7OEe9OquLKpdu125WQJ50FomZzELJ76vUfR8+5ensHa2OkVMJalr6mIav5g4NSuOH7VKTciADlUaAXnMRIwdXYC0IXBqvySLfFZq3KdG8d44gQKxXYnLusQWJ0Pq3p4RMrqm+RjRD7+QtW/QYf9a6DROEHi9iR/rfOh2a9k1kxWpyL/XnMtYAaUVFLCE43Ogeu8fFO3Q07bsrgEPVKZKKZVz1+OZLqgxHI5ND5QrLtS89tlpjtRsQxVooR/BZQQ98RFwcLakdzst4w/3WUAcDJetep+dlu2QTM71jXH0w==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tr58C-0000LB-L3 for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 2/5] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414824011235 (code B ref 76081); Sun, 09 Mar 2025 01:07:04 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:41 +0000 Received: from localhost ([127.0.0.1]:57388 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57n-0000Jp-6E for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:41 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:50417) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000IZ-Cd for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:29 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482383; bh=5w1pguUy5euk/p6I7KBfaqhA/lWVRKQOsLxduTGYZqY=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=n6AxZ2HVYVPW9xmWASiPyYFkZMXDVQPI+Z6E0N4Mj2UpzghD1hWHVAxjibPFf2kWC 18KAR1PFcP+yb4LCJcfH/uSshfifcqv1LQGSVzvFnLumUFAICn2moaRqI3HFNjxyY0 P/crJdliXiMElEevKxI6Y5b2Tof4QvDmZgN6TXmg= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKq0TGnz11NQ; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKp6Ctmz11NJ; Sun, 9 Mar 2025 01:06:22 +0000 (UTC) Date: Sun, 9 Mar 2025 02:06:12 +0100 Message-ID: <5ea9ef46b656b23c6213ec086084fd572b10816a.1741482375.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> 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: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: Giacomo Leidi 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 This patch moves the oci-container-configuration and related configuration records to (gnu services containers). Public symbols are still exported for backwards compatibility but since the oci-container-service-type will be deprecated in favor of the more general oci-service-type, everything is moved outside of the docker related module. * gnu/services/docker.scm: Move everything related to oci-container-configuration to... * gnu/services/containers.scm: ...here.scm. * gnu/tests/docker.scm: Simplify %test-oci-container test case. Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7 --- gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++- gnu/services/docker.scm | 577 +++--------------------------------- gnu/tests/docker.scm | 99 +++---- 3 files changed, 625 insertions(+), 600 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index d5a211765a6..24f31c756b8 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services containers) + #:use-module (gnu image) + #:use-module (gnu packages admin) #:use-module (gnu packages bash) #:use-module (gnu packages containers) + #:use-module (gnu packages docker) #:use-module (gnu packages file-systems) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services configuration) #:use-module (gnu services shepherd) + #:use-module (gnu system) #:use-module (gnu system accounts) + #:use-module (gnu system image) #:use-module (gnu system shadow) #:use-module (gnu system pam) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) + #:use-module (guix monads) #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? rootless-podman-configuration-fields @@ -48,7 +60,44 @@ (define-module (gnu services containers) rootless-podman-shepherd-services rootless-podman-service-etc - rootless-podman-service-type)) + rootless-podman-service-type + + oci-image + oci-image? + oci-image-fields + oci-image-repository + oci-image-tag + oci-image-value + oci-image-pack-options + oci-image-target + oci-image-system + oci-image-grafts? + + oci-container-configuration + oci-container-configuration? + oci-container-configuration-fields + oci-container-configuration-user + oci-container-configuration-group + oci-container-configuration-command + oci-container-configuration-entrypoint + oci-container-configuration-host-environment + oci-container-configuration-environment + oci-container-configuration-image + oci-container-configuration-provision + oci-container-configuration-requirement + oci-container-configuration-log-file + oci-container-configuration-auto-start? + oci-container-configuration-respawn? + oci-container-configuration-shepherd-actions + oci-container-configuration-network + oci-container-configuration-ports + oci-container-configuration-volumes + oci-container-configuration-container-user + oci-container-configuration-workdir + oci-container-configuration-extra-arguments + + oci-container-shepherd-service + %oci-container-accounts)) (define (gexp-or-string? value) (or (gexp? value) @@ -190,7 +239,7 @@ (define (rootless-podman-cgroups-limits-service config) rootless-podman-shared-root-fs)) (one-shot? #t) (documentation - "Allow setting cgroups limits: cpu, cpuset, memory and + "Allow setting cgroups limits: cpu, cpuset, io, memory and pids.") (start #~(make-forkexec-constructor @@ -244,3 +293,497 @@ (define rootless-podman-service-type (default-value (rootless-podman-configuration)) (description "This service configures rootless @code{podman} on the Guix System."))) + + +;;; +;;; OCI container. +;;; + +(define (oci-sanitize-pair pair delimiter) + (define (valid? member) + (or (string? member) + (gexp? member) + (file-like? member))) + (match pair + (((? valid? key) . (? valid? value)) + #~(string-append #$key #$delimiter #$value)) + (_ + (raise + (formatted-message + (G_ "pair members must contain only strings, gexps or file-like objects +but ~a was found") + pair))))) + +(define (oci-sanitize-mixed-list name value delimiter) + (map + (lambda (el) + (cond ((string? el) el) + ((pair? el) (oci-sanitize-pair el delimiter)) + (else + (raise + (formatted-message + (G_ "~a members must be either a string or a pair but ~a was +found!") + name el))))) + value)) + +(define (oci-sanitize-host-environment value) + ;; Expected spec format: + ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") + (oci-sanitize-mixed-list "host-environment" value "=")) + +(define (oci-sanitize-environment value) + ;; Expected spec format: + ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") + (oci-sanitize-mixed-list "environment" value "=")) + +(define (oci-sanitize-ports value) + ;; Expected spec format: + ;; '(("8088" . "80") "2022:22") + (oci-sanitize-mixed-list "ports" value ":")) + +(define (oci-sanitize-volumes value) + ;; Expected spec format: + ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") + (oci-sanitize-mixed-list "volumes" value ":")) + +(define (oci-sanitize-shepherd-actions value) + (map + (lambda (el) + (if (shepherd-action? el) + el + (raise + (formatted-message + (G_ "shepherd-actions may only be shepherd-action records +but ~a was found") el)))) + value)) + +(define (oci-sanitize-extra-arguments value) + (define (valid? member) + (or (string? member) + (gexp? member) + (file-like? member))) + (map + (lambda (el) + (if (valid? el) + el + (raise + (formatted-message + (G_ "extra arguments may only be strings, gexps or file-like objects +but ~a was found") el)))) + value)) + +(define (oci-image-reference image) + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + +(define (oci-lowerable-image? image) + (or (manifest? image) + (operating-system? image) + (gexp? image) + (file-like? image))) + +(define (string-or-oci-image? image) + (or (string? image) + (oci-image? image))) + +(define list-of-symbols? + (list-of symbol?)) + +(define-maybe/no-serialization string) + +(define-configuration/no-serialization oci-image + (repository + (string) + "A string like @code{myregistry.local:5000/testing/test-image} that names +the OCI image.") + (tag + (string "latest") + "A string representing the OCI image tag. Defaults to @code{latest}.") + (value + (oci-lowerable-image) + "A @code{manifest} or @code{operating-system} record that will be lowered +into an OCI compatible tarball. Otherwise this field's value can be a gexp +or a file-like object that evaluates to an OCI compatible tarball.") + (pack-options + (list '()) + "An optional set of keyword arguments that will be passed to the +@code{docker-image} procedure from @code{guix scripts pack}. They can be used +to replicate @command{guix pack} behavior: + +@lisp +(oci-image + (repository \"guile\") + (tag \"3\") + (manifest (specifications->manifest '(\"guile\"))) + (pack-options + '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\")) + #:max-layers 2))) +@end lisp + +If the @code{value} field is an @code{operating-system} record, this field's +value will be ignored.") + (system + (maybe-string) + "Attempt to build for a given system, e.g. \"i686-linux\"") + (target + (maybe-string) + "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"") + (grafts? + (boolean #f) + "Whether to allow grafting or not in the pack build.")) + +(define-configuration/no-serialization oci-container-configuration + (user + (string "oci-container") + "The user under whose authority docker commands will be run.") + (group + (string "docker") + "The group under whose authority docker commands will be run.") + (command + (list-of-strings '()) + "Overwrite the default command (@code{CMD}) of the image.") + (entrypoint + (maybe-string) + "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.") + (host-environment + (list '()) + "Set environment variables in the host environment where @command{docker run} +is invoked. This is especially useful to pass secrets from the host to the +container without having them on the @command{docker run}'s command line: by +setting the @code{MYSQL_PASSWORD} on the host and by passing +@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is +possible to securely set values in the container environment. This field's +value can be a list of pairs or strings, even mixed: + +@lisp +(list '(\"LANGUAGE\" . \"eo:ca:eu\") + \"JAVA_HOME=/opt/java\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to @code{make-forkexec-constructor}." + (sanitizer oci-sanitize-host-environment)) + (environment + (list '()) + "Set environment variables inside the container. This can be a list of pairs +or strings, even mixed: + +@lisp +(list '(\"LANGUAGE\" . \"eo:ca:eu\") + \"JAVA_HOME=/opt/java\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the Docker CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} +documentation for semantics." + (sanitizer oci-sanitize-environment)) + (image + (string-or-oci-image) + "The image used to build the container. It can be a string or an +@code{oci-image} record. Strings are resolved by the Docker +Engine, and follow the usual format +@code{myregistry.local:5000/testing/test-image:tag}.") + (provision + (maybe-string) + "Set the name of the provisioned Shepherd service.") + (requirement + (list-of-symbols '()) + "Set additional Shepherd services dependencies to the provisioned Shepherd +service.") + (log-file + (maybe-string) + "When @code{log-file} is set, it names the file to which the service’s +standard output and standard error are redirected. @code{log-file} is created +if it does not exist, otherwise it is appended to.") + (auto-start? + (boolean #t) + "Whether this service should be started automatically by the Shepherd. If it +is @code{#f} the service has to be started manually with @command{herd start}.") + (respawn? + (boolean #f) + "Whether to restart the service when it stops, for instance when the +underlying process dies.") + (shepherd-actions + (list '()) + "This is a list of @code{shepherd-action} records defining actions supported +by the service." + (sanitizer oci-sanitize-shepherd-actions)) + (network + (maybe-string) + "Set a Docker network for the spawned container.") + (ports + (list '()) + "Set the port or port ranges to expose from the spawned container. This can +be a list of pairs or strings, even mixed: + +@lisp +(list '(\"8080\" . \"80\") + \"10443:443\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the Docker CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} +documentation for semantics." + (sanitizer oci-sanitize-ports)) + (volumes + (list '()) + "Set volume mappings for the spawned container. This can be a +list of pairs or strings, even mixed: + +@lisp +(list '(\"/root/data/grafana\" . \"/var/lib/grafana\") + \"/gnu/store:/gnu/store\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the Docker CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} +documentation for semantics." + (sanitizer oci-sanitize-volumes)) + (container-user + (maybe-string) + "Set the current user inside the spawned container. You can refer to the +@url{https://docs.docker.com/engine/reference/run/#user,upstream} +documentation for semantics.") + (workdir + (maybe-string) + "Set the current working for the spawned Shepherd service. +You can refer to the +@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} +documentation for semantics.") + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define oci-container-configuration->options + (lambda (config) + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config)))))))) + +(define* (get-keyword-value args keyword #:key (default #f)) + (let ((kv (memq keyword args))) + (if (and kv (>= (length kv) 2)) + (cadr kv) + default))) + +(define (lower-operating-system os target system) + (mlet* %store-monad + ((tarball + (lower-object + (system-image (os->image os #:type docker-image-type)) + system + #:target target))) + (return tarball))) + +(define (lower-manifest name image target system) + (define value (oci-image-value image)) + (define options (oci-image-pack-options image)) + (define image-reference + (oci-image-reference image)) + (define image-tag + (let* ((extra-options + (get-keyword-value options #:extra-options)) + (image-tag-option + (and extra-options + (get-keyword-value extra-options #:image-tag)))) + (if image-tag-option + '() + `(#:extra-options (#:image-tag ,image-reference))))) + + (mlet* %store-monad + ((_ (set-grafting + (oci-image-grafts? image))) + (guile (set-guile-for-build (default-guile))) + (profile + (profile-derivation value + #:target target + #:system system + #:hooks '() + #:locales? #f)) + (tarball (apply pack:docker-image + `(,name ,profile + ,@options + ,@image-tag + #:localstatedir? #t)))) + (return tarball))) + +(define (lower-oci-image name image) + (define value (oci-image-value image)) + (define image-target (oci-image-target image)) + (define image-system (oci-image-system image)) + (define target + (if (maybe-value-set? image-target) + image-target + (%current-target-system))) + (define system + (if (maybe-value-set? image-system) + image-system + (%current-system))) + (with-store store + (run-with-store store + (match value + ((? manifest? value) + (lower-manifest name image target system)) + ((? operating-system? value) + (lower-operating-system value target system)) + ((or (? gexp? value) + (? file-like? value)) + value) + (_ + (raise + (formatted-message + (G_ "oci-image value must contain only manifest, +operating-system, gexp or file-like records but ~a was found") + value)))) + #:target target + #:system system))) + +(define (%oci-image-loader name image tag) + (let ((docker (file-append docker-cli "/bin/docker")) + (tarball (lower-oci-image name image))) + (with-imported-modules '((guix build utils)) + (program-file (format #f "~a-image-loader" name) + #~(begin + (use-modules (guix build utils) + (ice-9 popen) + (ice-9 rdelim)) + + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (define line + (read-line + (open-input-pipe + (string-append #$docker " load -i " #$tarball)))) + + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let ((repository&tag + (string-drop line + (string-length + "Loaded image: ")))) + + (invoke #$docker "tag" repository&tag #$tag) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)))))))) + +(define (oci-container-shepherd-service config) + (define (guess-name name image) + (if (maybe-value-set? name) + name + (string-append "docker-" + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))))) + + (let* ((docker (file-append docker-cli "/bin/docker")) + (actions (oci-container-configuration-shepherd-actions config)) + (auto-start? + (oci-container-configuration-auto-start? config)) + (user (oci-container-configuration-user config)) + (group (oci-container-configuration-group config)) + (host-environment + (oci-container-configuration-host-environment config)) + (command (oci-container-configuration-command config)) + (log-file (oci-container-configuration-log-file config)) + (provision (oci-container-configuration-provision config)) + (requirement (oci-container-configuration-requirement config)) + (respawn? + (oci-container-configuration-respawn? config)) + (image (oci-container-configuration-image config)) + (image-reference (oci-image-reference image)) + (options (oci-container-configuration->options config)) + (name (guess-name provision image)) + (extra-arguments + (oci-container-configuration-extra-arguments config))) + + (shepherd-service (provision `(,(string->symbol name))) + (requirement `(dockerd user-processes ,@requirement)) + (respawn? respawn?) + (auto-start? auto-start?) + (documentation + (string-append + "Docker backed Shepherd service for " + (if (oci-image? image) name image) ".")) + (start + #~(lambda () + #$@(if (oci-image? image) + #~((invoke #$(%oci-image-loader + name image image-reference))) + #~()) + (fork+exec-command + ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...] + (list #$docker "run" "--rm" "--name" #$name + #$@options #$@extra-arguments + #$image-reference #$@command) + #:user #$user + #:group #$group + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #:environment-variables + (list #$@host-environment)))) + (stop + #~(lambda _ + (invoke #$docker "rm" "-f" #$name))) + (actions + (if (oci-image? image) + '() + (append + (list + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + name image)) + (procedure + #~(lambda _ + (invoke #$docker "pull" #$image))))) + actions)))))) + +(define %oci-container-accounts + (list (user-account + (name "oci-container") + (comment "OCI services account") + (group "docker") + (system? #t) + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 9ab3e583345..828ceea313a 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services docker) - #:use-module (gnu image) #:use-module (gnu services) #:use-module (gnu services configuration) - #:use-module (gnu services base) - #:use-module (gnu services dbus) + #:use-module (gnu services containers) #:use-module (gnu services shepherd) - #:use-module (gnu system) - #:use-module (gnu system image) #:use-module (gnu system privilege) #:use-module (gnu system shadow) - #:use-module (gnu packages admin) ;shadow #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity - #:use-module (guix records) - #:use-module (guix diagnostics) #:use-module (guix gexp) - #:use-module (guix i18n) - #:use-module (guix monads) - #:use-module (guix packages) - #:use-module (guix profiles) - #:use-module ((guix scripts pack) #:prefix pack:) - #:use-module (guix store) + #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) #:use-module (ice-9 match) + #:re-export (oci-image ;for backwards compatibility, until the + oci-image? ;oci-container-service-type is fully deprecated + oci-image-fields + oci-image-repository + oci-image-tag + oci-image-value + oci-image-pack-options + oci-image-target + oci-image-system + oci-image-grafts? + oci-container-configuration + oci-container-configuration? + oci-container-configuration-fields + oci-container-configuration-user + oci-container-configuration-group + oci-container-configuration-command + oci-container-configuration-entrypoint + oci-container-configuration-host-environment + oci-container-configuration-environment + oci-container-configuration-image + oci-container-configuration-provision + oci-container-configuration-requirement + oci-container-configuration-log-file + oci-container-configuration-auto-start? + oci-container-configuration-respawn? + oci-container-configuration-shepherd-actions + oci-container-configuration-network + oci-container-configuration-ports + oci-container-configuration-volumes + oci-container-configuration-container-user + oci-container-configuration-workdir + oci-container-configuration-extra-arguments + oci-container-shepherd-service + %oci-container-accounts) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-image - oci-image? - oci-image-fields - oci-image-repository - oci-image-tag - oci-image-value - oci-image-pack-options - oci-image-target - oci-image-system - oci-image-grafts? - oci-container-configuration - oci-container-configuration? - oci-container-configuration-fields - oci-container-configuration-user - oci-container-configuration-group - oci-container-configuration-command - oci-container-configuration-entrypoint - oci-container-configuration-host-environment - oci-container-configuration-environment - oci-container-configuration-image - oci-container-configuration-provision - oci-container-configuration-requirement - oci-container-configuration-log-file - oci-container-configuration-auto-start? - oci-container-configuration-respawn? - oci-container-configuration-shepherd-actions - oci-container-configuration-network - oci-container-configuration-ports - oci-container-configuration-volumes - oci-container-configuration-container-user - oci-container-configuration-workdir - oci-container-configuration-extra-arguments - oci-container-service-type - oci-container-shepherd-service - %oci-container-accounts)) + oci-container-service-type)) (define-maybe file-like) @@ -309,495 +297,6 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (oci-sanitize-pair pair delimiter) - (define (valid? member) - (or (string? member) - (gexp? member) - (file-like? member))) - (match pair - (((? valid? key) . (? valid? value)) - #~(string-append #$key #$delimiter #$value)) - (_ - (raise - (formatted-message - (G_ "pair members must contain only strings, gexps or file-like objects -but ~a was found") - pair))))) - -(define (oci-sanitize-mixed-list name value delimiter) - (map - (lambda (el) - (cond ((string? el) el) - ((pair? el) (oci-sanitize-pair el delimiter)) - (else - (raise - (formatted-message - (G_ "~a members must be either a string or a pair but ~a was -found!") - name el))))) - value)) - -(define (oci-sanitize-host-environment value) - ;; Expected spec format: - ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") - (oci-sanitize-mixed-list "host-environment" value "=")) - -(define (oci-sanitize-environment value) - ;; Expected spec format: - ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") - (oci-sanitize-mixed-list "environment" value "=")) - -(define (oci-sanitize-ports value) - ;; Expected spec format: - ;; '(("8088" . "80") "2022:22") - (oci-sanitize-mixed-list "ports" value ":")) - -(define (oci-sanitize-volumes value) - ;; Expected spec format: - ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") - (oci-sanitize-mixed-list "volumes" value ":")) - -(define (oci-sanitize-shepherd-actions value) - (map - (lambda (el) - (if (shepherd-action? el) - el - (raise - (formatted-message - (G_ "shepherd-actions may only be shepherd-action records -but ~a was found") el)))) - value)) - -(define (oci-sanitize-extra-arguments value) - (define (valid? member) - (or (string? member) - (gexp? member) - (file-like? member))) - (map - (lambda (el) - (if (valid? el) - el - (raise - (formatted-message - (G_ "extra arguments may only be strings, gexps or file-like objects -but ~a was found") el)))) - value)) - -(define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) - -(define (oci-lowerable-image? image) - (or (manifest? image) - (operating-system? image) - (gexp? image) - (file-like? image))) - -(define (string-or-oci-image? image) - (or (string? image) - (oci-image? image))) - -(define list-of-symbols? - (list-of symbol?)) - -(define-maybe/no-serialization string) - -(define-configuration/no-serialization oci-image - (repository - (string) - "A string like @code{myregistry.local:5000/testing/test-image} that names -the OCI image.") - (tag - (string "latest") - "A string representing the OCI image tag. Defaults to @code{latest}.") - (value - (oci-lowerable-image) - "A @code{manifest} or @code{operating-system} record that will be lowered -into an OCI compatible tarball. Otherwise this field's value can be a gexp -or a file-like object that evaluates to an OCI compatible tarball.") - (pack-options - (list '()) - "An optional set of keyword arguments that will be passed to the -@code{docker-image} procedure from @code{guix scripts pack}. They can be used -to replicate @command{guix pack} behavior: - -@lisp -(oci-image - (repository \"guile\") - (tag \"3\") - (manifest (specifications->manifest '(\"guile\"))) - (pack-options - '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\")) - #:max-layers 2))) -@end lisp - -If the @code{value} field is an @code{operating-system} record, this field's -value will be ignored.") - (system - (maybe-string) - "Attempt to build for a given system, e.g. \"i686-linux\"") - (target - (maybe-string) - "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"") - (grafts? - (boolean #f) - "Whether to allow grafting or not in the pack build.")) - -(define-configuration/no-serialization oci-container-configuration - (user - (string "oci-container") - "The user under whose authority docker commands will be run.") - (group - (string "docker") - "The group under whose authority docker commands will be run.") - (command - (list-of-strings '()) - "Overwrite the default command (@code{CMD}) of the image.") - (entrypoint - (maybe-string) - "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.") - (host-environment - (list '()) - "Set environment variables in the host environment where @command{docker run} -is invoked. This is especially useful to pass secrets from the host to the -container without having them on the @command{docker run}'s command line: by -setting the @code{MYSQL_PASSWORD} on the host and by passing -@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is -possible to securely set values in the container environment. This field's -value can be a list of pairs or strings, even mixed: - -@lisp -(list '(\"LANGUAGE\" . \"eo:ca:eu\") - \"JAVA_HOME=/opt/java\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to @code{make-forkexec-constructor}." - (sanitizer oci-sanitize-host-environment)) - (environment - (list '()) - "Set environment variables inside the container. This can be a list of pairs -or strings, even mixed: - -@lisp -(list '(\"LANGUAGE\" . \"eo:ca:eu\") - \"JAVA_HOME=/opt/java\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics." - (sanitizer oci-sanitize-environment)) - (image - (string-or-oci-image) - "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format -@code{myregistry.local:5000/testing/test-image:tag}.") - (provision - (maybe-string) - "Set the name of the provisioned Shepherd service.") - (requirement - (list-of-symbols '()) - "Set additional Shepherd services dependencies to the provisioned Shepherd -service.") - (log-file - (maybe-string) - "When @code{log-file} is set, it names the file to which the service’s -standard output and standard error are redirected. @code{log-file} is created -if it does not exist, otherwise it is appended to.") - (auto-start? - (boolean #t) - "Whether this service should be started automatically by the Shepherd. If it -is @code{#f} the service has to be started manually with @command{herd start}.") - (respawn? - (boolean #f) - "Whether to restart the service when it stops, for instance when the -underlying process dies.") - (shepherd-actions - (list '()) - "This is a list of @code{shepherd-action} records defining actions supported -by the service." - (sanitizer oci-sanitize-shepherd-actions)) - (network - (maybe-string) - "Set a Docker network for the spawned container.") - (ports - (list '()) - "Set the port or port ranges to expose from the spawned container. This can -be a list of pairs or strings, even mixed: - -@lisp -(list '(\"8080\" . \"80\") - \"10443:443\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics." - (sanitizer oci-sanitize-ports)) - (volumes - (list '()) - "Set volume mappings for the spawned container. This can be a -list of pairs or strings, even mixed: - -@lisp -(list '(\"/root/data/grafana\" . \"/var/lib/grafana\") - \"/gnu/store:/gnu/store\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics." - (sanitizer oci-sanitize-volumes)) - (container-user - (maybe-string) - "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") - (workdir - (maybe-string) - "Set the current working for the spawned Shepherd service. -You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") - (extra-arguments - (list '()) - "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invocation." - (sanitizer oci-sanitize-extra-arguments))) - -(define oci-container-configuration->options - (lambda (config) - (let ((entrypoint - (oci-container-configuration-entrypoint config)) - (network - (oci-container-configuration-network config)) - (user - (oci-container-configuration-container-user config)) - (workdir - (oci-container-configuration-workdir config))) - (apply append - (filter (compose not unspecified?) - `(,(if (maybe-value-set? entrypoint) - `("--entrypoint" ,entrypoint) - '()) - ,(append-map - (lambda (spec) - (list "--env" spec)) - (oci-container-configuration-environment config)) - ,(if (maybe-value-set? network) - `("--network" ,network) - '()) - ,(if (maybe-value-set? user) - `("--user" ,user) - '()) - ,(if (maybe-value-set? workdir) - `("--workdir" ,workdir) - '()) - ,(append-map - (lambda (spec) - (list "-p" spec)) - (oci-container-configuration-ports config)) - ,(append-map - (lambda (spec) - (list "-v" spec)) - (oci-container-configuration-volumes config)))))))) - -(define* (get-keyword-value args keyword #:key (default #f)) - (let ((kv (memq keyword args))) - (if (and kv (>= (length kv) 2)) - (cadr kv) - default))) - -(define (lower-operating-system os target system) - (mlet* %store-monad - ((tarball - (lower-object - (system-image (os->image os #:type docker-image-type)) - system - #:target target))) - (return tarball))) - -(define (lower-manifest name image target system) - (define value (oci-image-value image)) - (define options (oci-image-pack-options image)) - (define image-reference - (oci-image-reference image)) - (define image-tag - (let* ((extra-options - (get-keyword-value options #:extra-options)) - (image-tag-option - (and extra-options - (get-keyword-value extra-options #:image-tag)))) - (if image-tag-option - '() - `(#:extra-options (#:image-tag ,image-reference))))) - - (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) - (guile (set-guile-for-build (default-guile))) - (profile - (profile-derivation value - #:target target - #:system system - #:hooks '() - #:locales? #f)) - (tarball (apply pack:docker-image - `(,name ,profile - ,@options - ,@image-tag - #:localstatedir? #t)))) - (return tarball))) - -(define (lower-oci-image name image) - (define value (oci-image-value image)) - (define image-target (oci-image-target image)) - (define image-system (oci-image-system image)) - (define target - (if (maybe-value-set? image-target) - image-target - (%current-target-system))) - (define system - (if (maybe-value-set? image-system) - image-system - (%current-system))) - (with-store store - (run-with-store store - (match value - ((? manifest? value) - (lower-manifest name image target system)) - ((? operating-system? value) - (lower-operating-system value target system)) - ((or (? gexp? value) - (? file-like? value)) - value) - (_ - (raise - (formatted-message - (G_ "oci-image value must contain only manifest, -operating-system, gexp or file-like records but ~a was found") - value)))) - #:target target - #:system system))) - -(define (%oci-image-loader name image tag) - (let ((docker (file-append docker-cli "/bin/docker")) - (tarball (lower-oci-image name image))) - (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) - #~(begin - (use-modules (guix build utils) - (ice-9 popen) - (ice-9 rdelim)) - - (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) - (define line - (read-line - (open-input-pipe - (string-append #$docker " load -i " #$tarball)))) - - (unless (or (eof-object? line) - (string-null? line)) - (format #t "~a~%" line) - (let ((repository&tag - (string-drop line - (string-length - "Loaded image: ")))) - - (invoke #$docker "tag" repository&tag #$tag) - (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)))))))) - -(define (oci-container-shepherd-service config) - (define (guess-name name image) - (if (maybe-value-set? name) - name - (string-append "docker-" - (basename - (if (string? image) - (first (string-split image #\:)) - (oci-image-repository image)))))) - - (let* ((docker (file-append docker-cli "/bin/docker")) - (actions (oci-container-configuration-shepherd-actions config)) - (auto-start? - (oci-container-configuration-auto-start? config)) - (user (oci-container-configuration-user config)) - (group (oci-container-configuration-group config)) - (host-environment - (oci-container-configuration-host-environment config)) - (command (oci-container-configuration-command config)) - (log-file (oci-container-configuration-log-file config)) - (provision (oci-container-configuration-provision config)) - (requirement (oci-container-configuration-requirement config)) - (respawn? - (oci-container-configuration-respawn? config)) - (image (oci-container-configuration-image config)) - (image-reference (oci-image-reference image)) - (options (oci-container-configuration->options config)) - (name (guess-name provision image)) - (extra-arguments - (oci-container-configuration-extra-arguments config))) - - (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) - (respawn? respawn?) - (auto-start? auto-start?) - (documentation - (string-append - "Docker backed Shepherd service for " - (if (oci-image? image) name image) ".")) - (start - #~(lambda () - #$@(if (oci-image? image) - #~((invoke #$(%oci-image-loader - name image image-reference))) - #~()) - (fork+exec-command - ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...] - (list #$docker "run" "--rm" "--name" #$name - #$@options #$@extra-arguments - #$image-reference #$@command) - #:user #$user - #:group #$group - #$@(if (maybe-value-set? log-file) - (list #:log-file log-file) - '()) - #:environment-variables - (list #$@host-environment)))) - (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) - (actions - (if (oci-image? image) - '() - (append - (list - (shepherd-action - (name 'pull) - (documentation - (format #f "Pull ~a's image (~a)." - name image)) - (procedure - #~(lambda _ - (invoke #$docker "pull" #$image))))) - actions)))))) - -(define %oci-container-accounts - (list (user-account - (name "oci-container") - (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") - (shell (file-append shadow "/sbin/nologin"))))) - (define (configs->shepherd-services configs) (map oci-container-shepherd-service configs)) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 90c8d0f8508..5dcf05a17e3 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -414,71 +414,54 @@ (define (run-oci-container-test) (test-runner-current (system-test-runner #$output)) (test-begin "oci-container") - (test-assert "containerd service running" - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (match (start-service 'containerd) - (#f #f) - (('service response-parts ...) - (match (assq-ref response-parts 'running) - ((pid) pid))))) - marionette)) - - (test-assert "containerd PID file present" - (wait-for-file "/run/containerd/containerd.pid" marionette)) - - (test-assert "dockerd running" - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (match (start-service 'dockerd) - (#f #f) - (('service response-parts ...) - (match (assq-ref response-parts 'running) - ((pid) pid))))) - marionette)) - - (sleep 10) ; let service start + (wait-for-file "/run/containerd/containerd.pid" marionette) (test-assert "docker-guile running" (marionette-eval '(begin (use-modules (gnu services herd)) - (match (start-service 'docker-guile) - (#f #f) - (('service response-parts ...) - (match (assq-ref response-parts 'running) - ((pid) pid))))) + (wait-for-service 'docker-guile #:timeout 120) + #t) marionette)) - (test-equal "passing host environment variables and volumes" - '("value" "hello") - (marionette-eval - `(begin - (use-modules (ice-9 popen) - (ice-9 rdelim)) - - (define slurp - (lambda args - (let* ((port (apply open-pipe* OPEN_READ args)) - (output (let ((line (read-line port))) - (if (eof-object? line) - "" - line))) - (status (close-pipe port))) - output))) - (let* ((response1 (slurp - ,(string-append #$docker-cli "/bin/docker") - "exec" "docker-guile" - "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) - (response2 (slurp - ,(string-append #$docker-cli "/bin/docker") - "exec" "docker-guile" - "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) + (test-assert "passing host environment variables and volumes" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (let ((line (read-line port))) + (if (eof-object? line) + "" + line))) + (status (close-pipe port))) + output))) + (let* ((response1 (slurp + ,(string-append #$docker-cli "/bin/docker") + "exec" "docker-guile" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + (response2 (slurp + ,(string-append #$docker-cli "/bin/docker") + "exec" "docker-guile" + "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) (display (call-with-input-file \"/shared.txt\" read-line)))"))) - (list response1 response2))) - marionette)) + (list response1 response2))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Service didn't come up after more than 60 seconds") + (if (equal? '("value" "hello") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) (test-end)))) From patchwork Sun Mar 9 01:06:13 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Giacomo Leidi X-Patchwork-Id: 39953 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 2F01727BBE9; Sun, 9 Mar 2025 01:07:31 +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=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable 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 18EE427BBEB for ; Sun, 9 Mar 2025 01:07:28 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tr58E-0007uX-3z; Sat, 08 Mar 2025 20:07:06 -0500 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 1tr58C-0007sg-2I for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:04 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tr58B-0003tN-Oc; Sat, 08 Mar 2025 20:07:03 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=OFurPoE5KAFCORjZk5Ct+DmNJsmN2g+9Hhckv+da+i4=; b=j2GNIf++HNde9/qasPUuS1fhZpCFxTpCEndPniSPDEgKw7aBPj1+hkDfLrm7nzpTCn7fk5P2kNyyBUrYCy+jQdxCyROjQ7BIXDrdIVUGRdvhdXfhxeJJIRsc0uLzXp66G+R3uqQCexi9fgZm1Vk8Fw5utdTUAPO7ou3lwJaiN1hIbXSniZiX9TPaox8CLJsDYvNDXWDeeeIdKMmpCPdWLDdf6pcQStBVjZyL2Wn2CnPXdOvf7VEI5EinpZLH7y3nAblP96SWGsXbQ4kFTqwCFQ0rBe9brLkoJcRwfRAQN+N97Hy7287jqWdDxEgqdcCsw7qRTN1OUrjyyCnapLo5vg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tr58A-0000KV-IG; Sat, 08 Mar 2025 20:07:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 3/5] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?utf-8?q?Court=C3=A8?= =?utf-8?q?s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?utf-8?q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823881185 (code B ref 76081); Sun, 09 Mar 2025 01:07:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:28 +0000 Received: from localhost ([127.0.0.1]:57381 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57c-0000J3-8A for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:28 -0500 Received: from confino.investici.org ([93.190.126.19]:44599) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000Ia-7e for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:25 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482383; bh=OFurPoE5KAFCORjZk5Ct+DmNJsmN2g+9Hhckv+da+i4=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=cAoPAeP2FWOMtdeHrpZdxmoCUfAjZ1oaJ8heXML3dv9Wmsuc644kd0xtSB1EP9PFu +oMh1f89EUKc0MIZX117VKtxXIvJmH7PO13lYWQmOL+m8IDGldnoJto599bXUlVSUT 4M3eqiV556HYV8edMoTaLTCB24wH84XpjzGUYdog= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKq3f8sz11NT; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKq2LHKz11NJ; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Date: Sun, 9 Mar 2025 02:06:13 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> 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: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: Giacomo Leidi 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 This patch implements a generalization of the oci-container-service-type, which consequently is made deprecated. The oci-service-type, in addition to all the features from the oci-container-service-type, can now provision OCI networks and volumes. It only handles OCI objects creation, the user is supposed to handle state once the objects are provsioned. It currently supports two different OCI runtimes: Docker and rootless Podman. Both runtimes are tested to make sure provisioned containers can connect to each other through provisioned networks and can read/write data with provisioned volumes. At last the Scheme API is thought to facilitate the implementation of a Guix Home service in the future. * gnu/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 306 ++++++-- gnu/services/containers.scm | 1335 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 +++++++++++++++++++++++++- 4 files changed, 2425 insertions(+), 252 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 7d8a5243ed8..8686380669b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -42839,59 +42839,162 @@ Miscellaneous Services @cindex OCI-backed, Shepherd services @subsubheading OCI backed services -Should you wish to manage your Docker containers with the same consistent -interface you use for your other Shepherd services, -@var{oci-container-service-type} is the tool to use: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "host") + (ports + '(("9000" . "9000") + ("9090" . "9090")))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "host") + (volumes + '("/var/lib/grafana:/var/lib/grafana"))))))) @end lisp In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package-or-string) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. When a string is passed it will be interpreted as the +absolute file-system path of the selected OCI runtime command. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -42911,16 +43014,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: list) -Set environment variables in the host environment where @command{docker -run} is invoked. This is especially useful to pass secrets from the -host to the container without having them on the @command{docker run}'s -command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -42928,22 +43031,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +Set environment variables inside the container. This can be a list of pairs +or strings, even mixed: @lisp (list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp -Pair members can be strings, gexps or file-like objects. -Strings are passed directly to the Docker CLI. You can refer to the -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: string-or-oci-image) The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker Engine, and -follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -42971,7 +43076,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI network for the spawned container. @item @code{ports} (default: @code{'()}) (type: list) Set the port or port ranges to expose from the spawned container. This can be a @@ -42982,10 +43087,11 @@ Miscellaneous Services "10443:443") @end lisp -Pair members can be strings, gexps or file-like objects. -Strings are passed directly to the Docker CLI. You can refer to the -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -42996,25 +43102,97 @@ Miscellaneous Services "/gnu/store:/gnu/store") @end lisp -Pair members can be strings, gexps or file-like objects. -Strings are passed directly to the Docker CLI. You can refer to the -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: string) Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 24f31c756b8..a78be00f038 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -39,8 +39,10 @@ (define-module (gnu services containers) #:use-module (guix packages) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix records) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +98,80 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-home-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + oci-configuration-valid? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-container-shepherd-name + oci-networks-shepherd-name + oci-networks-home-shepherd-name + oci-volumes-shepherd-name + oci-volumes-home-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-extension-merge + oci-service-extension-wrap-validate + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services + oci-configuration-extend)) (define (gexp-or-string? value) (or (gexp? value) @@ -296,9 +370,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (eq? maybe-group #f) + (if (eq? 'podman runtime) + "cgroup" + "docker") + maybe-group)) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -347,6 +454,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -374,10 +486,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -392,7 +509,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -437,11 +566,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -451,9 +584,9 @@ (define-configuration/no-serialization oci-container-configuration (host-environment (list '()) "Set environment variables in the host environment where @command{docker run} -is invoked. This is especially useful to pass secrets from the host to the -container without having them on the @command{docker run}'s command line: by -setting the @code{MYSQL_PASSWORD} on the host and by passing +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -477,15 +610,16 @@ (define-configuration/no-serialization oci-container-configuration @end lisp Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -514,7 +648,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -526,9 +660,10 @@ (define-configuration/no-serialization oci-container-configuration @end lisp Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -541,71 +676,363 @@ (define-configuration/no-serialization oci-container-configuration @end lisp Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman run} invocation." (sanitizer oci-sanitize-extra-arguments))) -(define oci-container-configuration->options - (lambda (config) - (let ((entrypoint - (oci-container-configuration-entrypoint config)) - (network - (oci-container-configuration-network config)) - (user - (oci-container-configuration-container-user config)) - (workdir - (oci-container-configuration-workdir config))) - (apply append - (filter (compose not unspecified?) - `(,(if (maybe-value-set? entrypoint) - `("--entrypoint" ,entrypoint) - '()) - ,(append-map - (lambda (spec) - (list "--env" spec)) - (oci-container-configuration-environment config)) - ,(if (maybe-value-set? network) - `("--network" ,network) - '()) - ,(if (maybe-value-set? user) - `("--user" ,user) - '()) - ,(if (maybe-value-set? workdir) - `("--workdir" ,workdir) - '()) - ,(append-map - (lambda (spec) - (list "-p" spec)) - (oci-container-configuration-ports config)) - ,(append-map - (lambda (spec) - (list "-v" spec)) - (oci-container-configuration-volumes config)))))))) - -(define* (get-keyword-value args keyword #:key (default #f)) - (let ((kv (memq keyword args))) - (if (and kv (>= (length kv) 2)) - (cadr kv) - default))) +(define (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-record-type* + oci-configuration + make-oci-configuration + oci-configuration? + this-oci-configuration + + (runtime oci-configuration-runtime + (default 'docker)) + (runtime-cli oci-configuration-runtime-cli + (default #f)) ; package or string + (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps + (default '())) ; or file-like objects + (user oci-configuration-user + (default "oci-container")) + (group oci-configuration-group ; string + (default #f)) + (subuids-range oci-configuration-subuids-range ; subid-range + (default #f)) + (subgids-range oci-configuration-subgids-range ; subid-range + (default #f)) + (containers oci-configuration-containers ; oci-container-configurations + (default '())) + (networks oci-configuration-networks ; oci-network-configurations + (default '())) + (volumes oci-configuration-volumes ; oci-volume-configurations + (default '())) + (verbose? oci-configuration-verbose? + (default #f)) + (home-service? oci-configuration-home-service? + (default for-home?) (innate))) + +(define (package-or-string? value) + (or (package? value) (string? value))) + +(define (oci-configuration-valid? config) + (define runtime-cli + (oci-configuration-runtime-cli config)) + (define group + (oci-configuration-group config)) + (define subuids-range + (oci-configuration-subuids-range config)) + (define subgids-range + (oci-configuration-subgids-range config)) + (and + (symbol? + (oci-sanitize-runtime (oci-configuration-runtime config))) + (or (eq? runtime-cli #f) + (package-or-string? runtime-cli)) + (list? (oci-configuration-runtime-extra-arguments config)) + (string? (oci-configuration-user config)) + (or (eq? group #f) + (string? group)) + (or (eq? subuids-range #f) + (subid-range? subuids-range)) + (or (eq? subgids-range #f) + (subid-range? subgids-range)) + (list-of-oci-containers? + (oci-configuration-containers config)) + (list-of-oci-networks? + (oci-configuration-networks config)) + (list-of-oci-volumes? + (oci-configuration-volumes config)) + (boolean? + (oci-configuration-verbose? config)) + (boolean? + (oci-configuration-home-service? config)))) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (eq? runtime-cli #f) + path + runtime-cli) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define (oci-runtime-home-cli config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli + (string-append (getenv "HOME") + "/.guix-home/profile")))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invocation) + "Return a Shepherd action printing a given INVOCATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invocation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invocation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-networks-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-networks-shepherd-name runtime))) + +(define (oci-volumes-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-volumes-shepherd-name runtime))) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -614,24 +1041,11 @@ (define (lower-operating-system os target system) #:target target))) (return tarball))) -(define (lower-manifest name image target system) - (define value (oci-image-value image)) - (define options (oci-image-pack-options image)) - (define image-reference - (oci-image-reference image)) - (define image-tag - (let* ((extra-options - (get-keyword-value options #:extra-options)) - (image-tag-option - (and extra-options - (get-keyword-value extra-options #:image-tag)))) - (if image-tag-option - '() - `(#:extra-options (#:image-tag ,image-reference))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -642,14 +1056,11 @@ (define (lower-manifest name image target system) (tarball (apply pack:docker-image `(,name ,profile ,@options - ,@image-tag #:localstatedir? #t)))) (return tarball))) -(define (lower-oci-image name image) - (define value (oci-image-value image)) - (define image-target (oci-image-target image)) - (define image-system (oci-image-system image)) +(define (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -662,7 +1073,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -677,113 +1089,686 @@ (define (lower-oci-image name image) #:target target #:system system))) -(define (%oci-image-loader name image tag) - (let ((docker (file-append docker-cli "/bin/docker")) - (tarball (lower-oci-image name image))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (ice-9 popen) - (ice-9 rdelim)) - - (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) - (define line - (read-line - (open-input-pipe - (string-append #$docker " load -i " #$tarball)))) - - (unless (or (eof-object? line) - (string-null? line)) - (format #t "~a~%" line) - (let ((repository&tag - (string-drop line - (string-length - "Loaded image: ")))) - - (invoke #$docker "tag" repository&tag #$tag) - (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)))))))) - -(define (oci-container-shepherd-service config) - (define (guess-name name image) - (if (maybe-value-set? name) - name - (string-append "docker-" - (basename - (if (string? image) - (first (string-split image #\:)) - (oci-image-repository image)))))) - - (let* ((docker (file-append docker-cli "/bin/docker")) - (actions (oci-container-configuration-shepherd-actions config)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invocation runtime runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invocation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" + ,@(if (eq? runtime 'podman) + ;; This is because podman takes some time to + ;; release container names. --replace seems + ;; to be required to be able to restart services. + '("--replace") + '()) + "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invocation #:key (verbose? #f) (pre-script #~())) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%") + (format #t "Current user: ~a ~a~%" + (getuid) (passwd:name (getpwuid (getuid)))) + (format #t "Current group: ~a ~a~%" + (getgid) (group:name (getgrgid (getgid)))) + (format #t "Current directory ~a~%" (getcwd))) + (define invocation (list #$@invocation)) + #$@pre-script + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (apply execlp `(,(first invocation) ,@invocation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((actions (oci-container-configuration-shepherd-actions config)) (auto-start? (oci-container-configuration-auto-start? config)) - (user (oci-container-configuration-user config)) - (group (oci-container-configuration-group config)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (host-environment (oci-container-configuration-host-environment config)) (command (oci-container-configuration-command config)) (log-file (oci-container-configuration-log-file config)) - (provision (oci-container-configuration-provision config)) (requirement (oci-container-configuration-requirement config)) (respawn? (oci-container-configuration-respawn? config)) (image (oci-container-configuration-image config)) (image-reference (oci-image-reference image)) (options (oci-container-configuration->options config)) - (name (guess-name provision image)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invocation + (oci-container-run-invocation + runtime runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments)) + (container-action + (lambda* (command #:key (environment-variables #f)) + #~(lambda _ + (fork+exec-command + (list #$@command) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) + #$@(if environment-variables + (list #:environment-variables + environment-variables) + '())))))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " backed Shepherd service for " (if (oci-image? image) name image) ".")) (start - #~(lambda () - #$@(if (oci-image? image) - #~((invoke #$(%oci-image-loader - name image image-reference))) - #~()) - (fork+exec-command - ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...] - (list #$docker "run" "--rm" "--name" #$name - #$@options #$@extra-arguments - #$image-reference #$@command) - #:user #$user - #:group #$group - #$@(if (maybe-value-set? log-file) - (list #:log-file log-file) - '()) - #:environment-variables - (list #$@host-environment)))) + (container-action + (list (oci-container-entrypoint + runtime runtime-cli name image image-reference + invocation #:verbose? verbose? + #:pre-script + (if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()))) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli name image image-reference + (list runtime-cli "rm" "-f" name) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invocation) " "))) + (if (oci-image? image) + '() (list - (shepherd-action - (name 'pull) - (documentation - (format #f "Pull ~a's image (~a)." - name image)) - (procedure - #~(lambda _ - (invoke #$docker "pull" #$image))))) - actions)))))) - -(define %oci-container-accounts + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli service-name image + image-reference + (list runtime-cli "pull" image) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))))))) + actions))))) + +(define (oci-object-create-invocation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invocation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invocations invocations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOCATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invocations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invocations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invocation) + (define name (last invocation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (let ((exit-code (status:exit-val (apply system* invocation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invocations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOCATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invocations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invocations invocations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invocations + (map + (lambda (network) + (oci-object-create-invocation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invocations + (map + (lambda (volume) + (oci-object-create-invocation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + "Returns a list of Shepherd services based on the input OCI state." + (let* ((networks-name + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime))) + (networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol networks-name)) + '())) + (volumes-name + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime))) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list (string->symbol volumes-name)) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + networks-name networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + volumes-name volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (system-runtime-cli + (oci-runtime-system-cli config)) + (home-runtime-cli + (oci-runtime-home-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config)) + (home-service? + (oci-configuration-home-service? config))) + (if home-service? + (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes + #:verbose? verbose? + #:networks-name + (oci-networks-home-shepherd-name runtime) + #:volumes-name + (oci-volumes-home-shepherd-name runtime)) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking))))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subgids #f) + (subid-range (name user)) + subgids) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subuids #f) + (subid-range (name user)) + subuids) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + `(,bash-minimal + ,@(if (string? runtime-cli) + '() + (list + (cond + ((not (eq? runtime-cli #f)) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))))) + +(define (oci-service-extension-wrap-validate extension) + (lambda (config) + (if (oci-configuration-valid? config) + (extension config) + (raise + (formatted-message + (G_ "Invalide oci-configuration ~a.") config))))) + +(define (oci-configuration-extend config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension subids-service-type + (oci-service-extension-wrap-validate + oci-service-subids)) + (service-extension account-service-type + (oci-service-extension-wrap-validate + oci-service-accounts)) + (service-extension shepherd-root-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend oci-configuration-extend) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 828ceea313a..125e748bb0e 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) oci-container-configuration-volumes oci-container-configuration-container-user oci-container-configuration-workdir - oci-container-configuration-extra-arguments - oci-container-shepherd-service - %oci-container-accounts) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -297,17 +302,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..5e6f39387e7 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #:use-module (gnu services) #:use-module (gnu services containers) #:use-module (gnu services desktop) + #:use-module ((gnu services docker) + #:select (containerd-service-type + docker-service-type)) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu system) @@ -39,7 +42,9 @@ (define-module (gnu tests containers) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) - #:export (%test-rootless-podman)) + #:export (%test-rootless-podman + %test-oci-service-rootless-podman + %test-oci-service-docker)) (define %rootless-podman-os @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-service-type) + (service dbus-root-service-type) + (service polkit-service-type) + (service elogind-service-type) + (service iptables-service-type) + (service rootless-podman-service-type) + (extra-special-file "/shared.txt" + (plain-file "shared.txt" "hello")) + (service oci-service-type + (oci-configuration + (runtime 'podman) + (verbose? #t))) + (simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list (oci-network-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-volume")))) + (containers + (list + (oci-container-configuration + (provision "first") + (image + (oci-image + (repository "guile") + (value + (specifications->manifest '("guile"))) + (pack-options + '(#:symlinks (("/bin" -> "bin")))))) + (entrypoint "/bin/guile") + (network "my-network") + (command + '("-c" "(use-modules (web server)) +(define (handler request request-body) + (values '((content-type . (text/plain))) \"out of office\")) +(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))")) + (host-environment + '(("VARIABLE" . "value"))) + (volumes + '(("my-volume" . "/my-volume"))) + (extra-arguments + '("--env" "VARIABLE"))) + (oci-container-configuration + (provision "second") + (image + (oci-image + (repository "guile") + (value + (specifications->manifest '("guile"))) + (pack-options + '(#:symlinks (("/bin" -> "bin")))))) + (entrypoint "/bin/guile") + (network "my-network") + (command + '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))")) + (volumes + '(("my-volume" . "/my-volume") + ("/shared.txt" . "/shared.txt:ro")))))))))) + +(define (run-rootless-podman-oci-service-test) + (define os + (marionette-operating-system + (operating-system-with-gc-roots + %oci-rootless-podman-os + (list)) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (test-runner-current (system-test-runner #$output)) + (test-begin "rootless-podman-oci-service") + + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'user-processes)) + marionette) + + (test-assert "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 6)) + (cond ((file-exists? file) + #t) + ((zero? i) + (error "file didn't show up" file)) + (else + (pk 'wait-for-file file) + (sleep 1) + (loop (- i 1)))))) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 6)) + (cond ((file-exists? file) + #t) + ((zero? i) + (error "file didn't show up" file)) + (else + (pk 'wait-for-file file) + (sleep 1) + (loop (- i 1)))))) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (cond ((file-exists? file) + #t) + ((zero? i) + (error "file didn't show up" file)) + (else + (pk 'wait-for-file file) + (sleep 1) + (loop (- i 1)))))) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (cond ((file-exists? file) + #t) + ((zero? i) + (error "file didn't show up" file)) + (else + (pk 'wait-for-file file) + (sleep 1) + (loop (- i 1)))))) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "second" + "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim)) +(display (call-with-input-file \"/shared.txt\" read-line)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (cond ((file-exists? file) + #t) + ((zero? i) + (error "file didn't show up" file)) + (else + (pk 'wait-for-file file) + (sleep 1) + (loop (- i 1)))))) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim)) +(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'") + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "second" + "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim)) +(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (cond ((file-exists? file) + #t) + ((zero? i) + (error "file didn't show up" file)) + (else + (pk 'wait-for-file file) + (sleep 1) + (loop (- i 1)))))) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "second" + "/bin/guile" "-c" "'(begin (use-modules (web client)) +(define-values (response out) + (http-get \"http://first:8080\")) +(display out))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-end)))) + + (gexp->derivation "rootless-podman-oci-service-test" test)) + +(define %test-oci-service-rootless-podman + (system-test + (name "oci-service-rootless-podman") + (description "Test Rootless-Podman backed OCI provisioning service.") + (value (run-rootless-podman-oci-service-test)))) + +(define %oci-docker-os + (simple-operating-system + (service dhcp-client-service-type) + (service dbus-root-service-type) + (service polkit-service-type) + (service elogind-service-type) + (service containerd-service-type) + (service docker-service-type) + (extra-special-file "/shared.txt" + (plain-file "shared.txt" "hello")) + (service oci-service-type + (oci-configuration + (verbose? #t))) + (simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list (oci-network-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-volume")))) + (containers + (list + (oci-container-configuration + (provision "first") + (image + (oci-image + (repository "guile") + (value + (specifications->manifest '("guile"))) + (pack-options + '(#:symlinks (("/bin" -> "bin")))))) + (entrypoint "/bin/guile") + (network "my-network") + (command + '("-c" "(use-modules (web server)) +(define (handler request request-body) + (values '((content-type . (text/plain))) \"out of office\")) +(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))")) + (host-environment + '(("VARIABLE" . "value"))) + (volumes + '(("my-volume" . "/my-volume"))) + (extra-arguments + '("--env" "VARIABLE"))) + (oci-container-configuration + (provision "second") + (image + (oci-image + (repository "guile") + (value + (specifications->manifest '("guile"))) + (pack-options + '(#:symlinks (("/bin" -> "bin")))))) + (entrypoint "/bin/guile") + (network "my-network") + (command + '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))")) + (volumes + '(("my-volume" . "/my-volume") + ("/shared.txt" . "/shared.txt:ro")))))))))) + +(define (run-docker-oci-service-test) + (define os + (marionette-operating-system + (operating-system-with-gc-roots + %oci-docker-os + (list)) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + + (test-runner-current (system-test-runner #$output)) + (test-begin "docker-oci-service") + + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'dockerd)) + marionette) + + (test-assert "docker-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ + (list "sh" "-l" "-c" + (string-join + args + " ")))) + (output (read-lines port)) + (status (close-pipe port))) + output))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (let ((line (read-line port))) + (if (eof-object? line) + "" + line))) + (status (close-pipe port))) + output))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "hello" + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (let ((line (read-line port))) + (if (eof-object? line) + "" + line))) + (status (close-pipe port))) + output))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "second" + "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) +(display (call-with-input-file \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (let ((line (read-line port))) + (if (eof-object? line) + "" + line))) + (status (close-pipe port))) + output))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) +(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))") + (slurp + "/run/current-system/profile/bin/docker" + "exec" "second" + "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) +(display (call-with-input-file \"/my-volume/out.txt\" read-line)))")) + marionette)) + + (test-equal "can read ports over network" + "out of office" + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (let ((line (read-line port))) + (if (eof-object? line) + "" + line))) + (status (close-pipe port))) + output))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "second" + "/bin/guile" "-c" "(begin (use-modules (web client)) +(define-values (response out) + (http-get \"http://first:8080\")) +(display out))")) + marionette)) + + (test-end)))) + + (gexp->derivation "docker-oci-service-test" test)) + +(define %test-oci-service-docker + (system-test + (name "oci-service-docker") + (description "Test Docker backed OCI provisioning service.") + (value (run-docker-oci-service-test)))) From patchwork Sun Mar 9 01:06:14 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Giacomo Leidi X-Patchwork-Id: 39956 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 87F1E27BBEA; Sun, 9 Mar 2025 01:07:58 +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=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, 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 55CA927BBE2 for ; Sun, 9 Mar 2025 01:07:57 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tr58D-0007t2-Mn; Sat, 08 Mar 2025 20:07:05 -0500 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 1tr58C-0007sf-1t for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:04 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tr58B-0003tZ-PB for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:03 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=OA+jF6nMN1H/fbeqERhZSvlXDfNZ/EM7zWgOCJPe3Mg=; b=Eii0DNxqk4wRSQdmvDjku4akyBoD+iY63RwKfwhJNvSmDIfAnuZ0j0eUeZKgwclJRBxdvyoB/kPrtGAAsEpWqPvY8AgWtG0yGoppnWpMbOQomR76pltcQtEycGcVVP8SiA271j3oDKv9TwAPLQqVQlK/Hs0ZqkB8crddDGwTsG6F4aqwoxXpxWW1JcQwvXDkLkOmHsju521UdZmjS+NARBWbuXEL695GIuQmd4p4sFFlKt+l+YSbB+x3zpbCgNNU+lpIhw+/MrfteUlcb86G1E5WWd1cdWZITLtitAJ7UJHrpe63K3wQPiXri4d/Mmi0H5zZcN22Ekmd+cidZQ3lJQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tr58B-0000Ku-Ju for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 4/5] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823901208 (code B ref 76081); Sun, 09 Mar 2025 01:07:03 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:30 +0000 Received: from localhost ([127.0.0.1]:57384 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57d-0000JE-4f for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:30 -0500 Received: from confino.investici.org ([93.190.126.19]:22917) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000Ib-9l for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:27 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482383; bh=OA+jF6nMN1H/fbeqERhZSvlXDfNZ/EM7zWgOCJPe3Mg=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=d3e6ZneUAN+y+ZnyVH9sadsoxifWXk9lS1voExqV8mWbOZ4iu1cs5wxbzjeoZSR94 +TZExxFg62UUuoD1KBeRJxUsLML/ShW2VPhR0T6BqhgqgQoDkPh4fbSmWlteXLHaR+ 0z9aHPFqsYazk9n4cP7wOM8QZgvQWFgSJLIG5IsE= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKq66Ljz11NV; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKq57M0z11NJ; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Date: Sun, 9 Mar 2025 02:06:14 +0100 Message-ID: <2801dce6518c3f6e99d76ec7010c8108114c224d.1741482375.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> 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: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: Giacomo Leidi 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 This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index a78be00f038..700c7b63603 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -75,6 +75,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 5e6f39387e7..8cdd86e7ae3 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-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-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os From patchwork Sun Mar 9 01:06:15 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Giacomo Leidi X-Patchwork-Id: 39952 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 AA17927BBEC; Sun, 9 Mar 2025 01:07:28 +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=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, 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 A2A9E27BBE2 for ; Sun, 9 Mar 2025 01:07:27 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tr58H-0007yO-AH; Sat, 08 Mar 2025 20:07:09 -0500 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 1tr58D-0007t9-EG for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:05 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tr58C-0003tp-Hh; Sat, 08 Mar 2025 20:07:04 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=M48IKbYcoh+yVWFUUliCPB3CIz3BAUfXQ15AWJnNPUU=; b=e0zKqm1M6GyW7pImpYhivlGeNs0WcWXN78I/Timk5hiQHc0z8toYAcVz90foGH1ebj8HJpMyGnL8daon6WKyMdUc/VgelRn8lDJ5BRt/2fatDdwCVkg43oTbl+FQoAZBswUCtqq6Kcgt7OBYmwJ2u2coG2I3H15gPSr6NkcvJk4I37zGQdqA1WR+LPYGHDFXO/7XMZXlPcMp5JfdBbKWxqXxrKz1wBRgsiMreylFXGfOqTNu5YyVzLDA4WhzLx8cv59X7HNIICQGTCIDkqhp5Cw9G62fVVT902J2CV3CIqJTTP2jEioV2Y7oFVbl9WmfFGI2gL2/j0B4IWLLpo2I0g==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tr58C-0000L1-3h; Sat, 08 Mar 2025 20:07:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 5/5] home: Add home-oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?utf-8?q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?utf-8?q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823911214 (code B ref 76081); Sun, 09 Mar 2025 01:07:04 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:31 +0000 Received: from localhost ([127.0.0.1]:57386 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57e-0000JR-5a for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:31 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:43993) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000Id-CW for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:27 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482384; bh=M48IKbYcoh+yVWFUUliCPB3CIz3BAUfXQ15AWJnNPUU=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=dk1hva4SBhqkpFjss9zXPo6IL+cR7j02CW/zJ4rbx6VG12f7feKHdiPAQfldGgaYu MdBTUiOpmrBneNM5I80sOVjpghVhJMwfBc4jwUvDKQL8qKQ51xfOlcLXlqQbPh4ztL I+bxvGVd5fuH3TcBiaIkHkZRIj9HtYje1bPCtFl8= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKr1jvNz11Nd; Sun, 9 Mar 2025 01:06:24 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKr0jRNz11NJ; Sun, 9 Mar 2025 01:06:24 +0000 (UTC) Date: Sun, 9 Mar 2025 02:06:15 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> 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: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: Giacomo Leidi 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/home/service/containers.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (OCI backed services): Document it. Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030 --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++ gnu/home/services/containers.scm | 50 ++++++++++++++ gnu/local.mk | 1 + gnu/services/containers.scm | 5 ++ 4 files changed, 170 insertions(+) create mode 100644 gnu/home/services/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index 8686380669b..7ed469f7920 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -50403,6 +50403,120 @@ Miscellaneous Home Services (dicod-configuration @dots{}))) @end lisp +@subsubheading OCI backed services + +@cindex OCI-backed, for Home +The @code{(gnu home services containers)} module provides the following service: + +@defvar home-oci-service-type +This is the type of the service that allows to manage your OCI containers with +the same consistent interface you use for your other Home Shepherd services. +@end defvar + +This service is a direct mapping of the @code{oci-service-type} system +service (@pxref{Miscellaneous Services, OCI backed services}). You can +use it like this: + +@lisp +(use-modules (gnu services containers) + (gnu home services containers)) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) + +@end lisp + +You may specify a custom configuration by providing a +@code{oci-configuration} record, exactly like for +@code{oci-service-type}, but wrapping it in @code{for-home}: + +@lisp +(use-modules (gnu services) + (gnu services containers) + (gnu home services containers)) + +(service home-oci-service-type + (for-home + (oci-configuration + (runtime 'podman) + (verbose? #t)))) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) +@end lisp + @node Invoking guix home @section Invoking @command{guix home} diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm new file mode 100644 index 00000000000..938dde2f37a --- /dev/null +++ b/gnu/home/services/containers.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Giacomo Leidi +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu home services containers) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services containers) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (home-oci-service-type)) + +(define home-oci-service-type + (service-type (inherit (system->home-service-type oci-service-type)) + (extensions + (list + (service-extension home-profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension home-shepherd-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + (extend + (lambda (config extension) + (for-home + (oci-configuration + (inherit (oci-configuration-extend config extension)))))) + (default-value (for-home (oci-configuration))))) diff --git a/gnu/local.mk b/gnu/local.mk index 9082ed04bfe..e0d1a25a607 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/admin.scm \ + %D%/home/services/containers.scm \ %D%/home/services/desktop.scm \ %D%/home/services/dict.scm \ %D%/home/services/dotfiles.scm \ diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 700c7b63603..002bbc1057b 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -762,6 +762,9 @@ (define-configuration/no-serialization oci-network-configuration (define (list-of-oci-networks? value) (list-of-oci-records? "networks" oci-network-configuration? value)) +;; (for-home (oci-configuration ...)) is not able to replace for-home? with #t, +;; pk prints #f. Once for-home will be able to work with (gnu services configuration) the +;; record can be migrated back to define-configuration. (define-record-type* oci-configuration make-oci-configuration @@ -796,6 +799,8 @@ (define-record-type* (define (package-or-string? value) (or (package? value) (string? value))) +;; TODO: This procedure can be dropped once we switch to define-configuration for +;; oci-configuration. (define (oci-configuration-valid? config) (define runtime-cli (oci-configuration-runtime-cli config))