From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1.migadu.com ([2001:41d0:303:e16b::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id 2MAfM7x1yGYcCgAA62LTzQ:P1 (envelope-from ) for ; Fri, 23 Aug 2024 11:42:53 +0000 Received: from aspmx1.migadu.com ([2001:41d0:303:e16b::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1.migadu.com with LMTPS id 2MAfM7x1yGYcCgAA62LTzQ (envelope-from ) for ; Fri, 23 Aug 2024 13:42:52 +0200 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=m2sktWM+; dkim=fail ("body hash did not verify") header.d=autistici.org header.s=stigmate header.b=tZSWE2H+; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1724413372; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-type:content-type: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=GFLKDlP2c0Ebxnxavyij9cSCFGdER95PT9kWNCw2upQ=; b=mUeux3sZV7brW3pTY82DCmG+2fms2AExT1vEHkxOnsLER/6PDm1uBHtmUuqCpTVPRCdE3D Z+q53jesZwAsx/tQRK0CzhjgDUq81H9bf/gCmaHv9EyUj4SsLexJ1gjp8LE2CR0gx6staO iEqQhAskiBz0GsaxTdO/leaYmEjg3v/EvokeqR/icPUvSNltyMfuSi9IBPDvRjmLl+ZQx5 1maawnTr+Q1PJHWqFwb8yKC1ns9JJqSl8YudYR1j6KGM+nBgu7IY+q/rpBe/expGbOUE6H MDYcxpPHxm85VNS5PnRJ6rXoi2kEcTws4102MA/6cI4D2t57X0OyI/vW4v0kVQ== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=m2sktWM+; dkim=fail ("body hash did not verify") header.d=autistici.org header.s=stigmate header.b=tZSWE2H+; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=pass (policy=none) header.from=gnu.org ARC-Seal: i=1; s=key1; d=yhetil.org; t=1724413372; a=rsa-sha256; cv=none; b=hdhUXStjCknb4C8TsyH+vlkkW5ILrKPvJ8VRJpt1BGwdKFDwAgTr/HXHfgF+tEFKqT+nsi EKIor6Cy221ms+8woIRRlIJOlTa4DlNsdnifj2ZHfzYMfD9bPHmaxZfpl2QWxZutTEMyGC uXDFfagDOpq1SANkD93AQuvcupq/0xiWneJfJ/lPiT7b784rcBYSt0MzyNfwXgMVI1jsCX KCnskz/Evq7dFtiuu4Kj+c9v6sO0xR2Knk0xPEcEJLjftm7jiW/2b1nFShX7GdnI1tkJ5a eDE63Uu6k/5ikUv66kDsLF4KMmxxAcgsEo6n8XsvRb6WSyOca+pxMUBZATGn/w== Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id D436254688 for ; Fri, 23 Aug 2024 13:42:51 +0200 (CEST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1shSgf-0005yx-LA; Fri, 23 Aug 2024 07:42:38 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1shSgU-0005xA-AI for guix-patches@gnu.org; Fri, 23 Aug 2024 07:42:26 -0400 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 1shSgO-0001ay-VC; Fri, 23 Aug 2024 07:42:21 -0400 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=PAWkKaXoRcatfyDs1NVXOY2w07uOZcc4n1t2ABYwKeM=; b=m2sktWM+s1ECtsvbS/QroID/Pu83TKnwHwJICprEpoiValgHCYGc2F9IsmawFGX4AgZzzcD76pBcoRPZFKMyb+dDbrZoeG9cmB3aH6WQNGqwRdwlzCdTrvSJacFttESusRgFOM8WQdg0Aoz7ivmuOb7n+nRXZ7bC4tnl1l4sGFY64BivsBePwV0ucxTf9FfDcRXNiJ5kzyU6X5O9uOD49gYEEjYtUn0uFGuorqmhZVNh12QJ61BQpOoI7/qKKokrgGmJc0Z3Awb37Qu6FsJ5u8c8N50k9JmYiJWB7SlwdSBeN5nnjAGOBVHW+Gwlz9zXXoe72RhrNqyZoe+3CtAutg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1shSh5-0005K5-8L; Fri, 23 Aug 2024 07:43:03 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72740] [PATCH v3 4/4] services: Add rootless-podman-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: pelzflorian@pelzflorian.de, ludo@gnu.org, matt@excalamus.com, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Fri, 23 Aug 2024 11:43:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72740 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 72740@debbugs.gnu.org Cc: Giacomo Leidi , Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer X-Debbugs-Original-Xcc: Florian Pelz , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Matthew Trzcinski , Maxim Cournoyer Received: via spool by 72740-submit@debbugs.gnu.org id=B72740.172441334120380 (code B ref 72740); Fri, 23 Aug 2024 11:43:03 +0000 Received: (at 72740) by debbugs.gnu.org; 23 Aug 2024 11:42:21 +0000 Received: from localhost ([127.0.0.1]:39110 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1shSgN-0005IY-QB for submit@debbugs.gnu.org; Fri, 23 Aug 2024 07:42:21 -0400 Received: from confino.investici.org ([93.190.126.19]:23325) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1shSgJ-0005Hw-Sg for 72740@debbugs.gnu.org; Fri, 23 Aug 2024 07:42:17 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1724413281; bh=PAWkKaXoRcatfyDs1NVXOY2w07uOZcc4n1t2ABYwKeM=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=tZSWE2H+IPPljvFXyAGqI/hC0WYFl8lN5/viZhdb3x9548sKQSAFIiH0UyhD08XET tj9Ri6zmNm/KW9vQg3hj0D43r07MQUfdD32+ZNsZ+LXmsTZRvDzl81P5HQ2CU2MsvW dvpjWPhz6JWH42y1arFKbRGNg9WXcRM0AnuTrELI= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Wqyns0SZ1z11HX; Fri, 23 Aug 2024 11:41:21 +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 4Wqynr6XD9z11GF; Fri, 23 Aug 2024 11:41:20 +0000 (UTC) Date: Fri, 23 Aug 2024 13:40:57 +0200 Message-ID: <8b98dbb863b7cca61be7006a0e52de76f2ad98af.1724413257.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.45.2 In-Reply-To: <1af98aa934040d79301c290acd719a7710e09800.1724413257.git.goodoldpaul@autistici.org> References: <1af98aa934040d79301c290acd719a7710e09800.1724413257.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 From: Giacomo Leidi via Guix-patches via Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Country: US X-Migadu-Flow: FLOW_IN X-Migadu-Queue-Id: D436254688 X-Migadu-Scanner: mx13.migadu.com X-Migadu-Spam-Score: -5.58 X-Spam-Score: -5.58 X-TUID: RzZyMWp1cgSF * gnu/services/containers.scm: New file; (rootless-podman-configuration): new variable; (rootless-podman-service-subids): new variable; (rootless-podman-service-accounts): new variable; (rootless-podman-service-profile): new variable; (rootless-podman-shepherd-services): new variable; (rootless-podman-service-etc): new variable; (rootless-podman-service-type): new variable. * gnu/local.mk: Test it. * gnu/local.mk: Add them. * doc/guix.texi (Miscellaneous Services): Document it. Change-Id: I041496474c1027da353bd6852f2554a065914d7a --- doc/guix.texi | 104 +++++++++++ gnu/local.mk | 2 + gnu/services/containers.scm | 238 +++++++++++++++++++++++++ gnu/tests/containers.scm | 340 ++++++++++++++++++++++++++++++++++++ 4 files changed, 684 insertions(+) create mode 100644 gnu/services/containers.scm create mode 100644 gnu/tests/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index 0e1e253b02..eb6a1b2442 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -40852,6 +40852,110 @@ Miscellaneous Services invoke @command{singularity run} and similar commands. @end defvar +@cindex Rootless Podman +@subsubheading Rootless Podman Service + +The @code{(gnu services containers)} module provides the following service. + + +@cindex Rootless Podman, container management tool +@defvar rootless-podman-service-type + +@url{https://www.sylabs.io/singularity/, Singularity} is a container management +tool. In addition to providing a drop-in replacement for Docker, Podman offers +the ability to run containers in rootless mode. This allows regular users to +deploy containers without elevated privileges. + +The @code{rootless-podman-service-type} sets up the Guix System to allow +unprivileged users to run @command{podman} commands: + +@lisp +(use-service-modules containers networking @dots{}) + +(operating-system + ;; @dots{} + (users (cons (user-account + (name "alice") + (comment "Bob's sister") + (group "users") + + ;; Adding the account to the "cgroup" group + ;; makes it possible to run podman commands. + (supplementary-groups '("cgroup" "wheel" + "audio" "video"))) + %base-user-accounts)) + (services + (list + (service iptables-service-type) + (service rootless-podman-service-type + (rootless-podman-configuration + (subgids + (list (subid-range (name "alice")))) + (subuids + (list (subid-range (name "alice"))))))))) +@end lisp + +The @code{iptables-service-type} is required for Podman to be able to setup its +own networks. Due to the change in user groups and file systems it is +recommended to reboot (or at least logout), before trying to run Podman commands. + +To test your installation you can run: + +@example +$ podman run -it --rm docker.io/alpine cat /etc/*release* +NAME="Alpine Linux" +ID=alpine +VERSION_ID=3.20.2 +PRETTY_NAME="Alpine Linux v3.20" +HOME_URL="https://alpinelinux.org/" +BUG_REPORT_URL="https://gitlab.alpinelinux.org/alpine/aports/-/issues" +@end example + +@end defvar + +@c %start of fragment + +@deftp {Data Type} rootless-podman-configuration +Available @code{rootless-podman-configuration} fields are: + +@table @asis +@item @code{podman} (default: @code{podman}) (type: package) +The Podman package that will be installed in the system profile. + +@item @code{group-name} (default: @code{"cgroup"}) (type: string) +The name of the group that will own /sys/fs/cgroup resources. Users that +want to use rootless Podman have to be in this group. + +@item @code{containers-registries} (type: lowerable) +A string or a gexp evaluating to the path of Podman's +@code{containers/registries.conf} configuration file. + +@item @code{containers-storage} (type: lowerable) +A string or a gexp evaluating to the path of Podman's +@code{containers/storage.conf} configuration file. + +@item @code{containers-policy} (type: lowerable) +A string or a gexp evaluating to the path of Podman's +@code{containers/policy.json} configuration file. + +@item @code{pam-limits} (type: list-of-pam-limits-entries) +The PAM limits to be set for rootless Podman. + +@item @code{subgids} (default: @code{()}) (type: list-of-subid-ranges) +A list of subid ranges representing the subgids that will be +available for each configured user. + +@item @code{subuids} (default: @code{()}) (type: list-of-subid-ranges) +A list of subid ranges representing the subuids that will be +available for each configured user. + +@end table + +@end deftp + + +@c %end of fragment + @cindex OCI-backed, Shepherd services @subsubheading OCI backed services diff --git a/gnu/local.mk b/gnu/local.mk index 3b0a3858f7..a543f1ddc9 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -708,6 +708,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/cgit.scm \ %D%/services/ci.scm \ %D%/services/configuration.scm \ + %D%/services/containers.scm \ %D%/services/cuirass.scm \ %D%/services/cups.scm \ %D%/services/databases.scm \ @@ -813,6 +814,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/base.scm \ %D%/tests/cachefilesd.scm \ %D%/tests/ci.scm \ + %D%/tests/containers.scm \ %D%/tests/cups.scm \ %D%/tests/databases.scm \ %D%/tests/desktop.scm \ diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm new file mode 100644 index 0000000000..03f0649c0d --- /dev/null +++ b/gnu/services/containers.scm @@ -0,0 +1,238 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 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 services containers) + #:use-module (gnu packages containers) + #: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 accounts) + #:use-module (gnu system shadow) + #:use-module (gnu system pam) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (rootless-podman-configuration + rootless-podman-configuration? + rootless-podman-configuration-fields + rootless-podman-configuration-podman + rootless-podman-configuration-group-name + rootless-podman-configuration-containers-registries + rootless-podman-configuration-containers-storage + rootless-podman-configuration-containers-policy + rootless-podman-configuration-pam-limits + rootless-podman-configuration-subgids + rootless-podman-configuration-subuids + + rootless-podman-service-subids + rootless-podman-service-accounts + rootless-podman-service-profile + rootless-podman-shepherd-services + rootless-podman-service-etc + + rootless-podman-service-type)) + +(define (gexp-or-string? value) + (or (gexp? value) + (string? value))) + +(define (lowerable? value) + (or (file-like? value) + (gexp-or-string? value))) + +(define list-of-pam-limits-entries? + (list-of pam-limits-entry?)) + +(define list-of-subid-ranges? + (list-of subid-range?)) + +(define-configuration/no-serialization rootless-podman-configuration + (podman + (package podman) + "The Podman package that will be installed in the system profile.") + (group-name + (string "cgroup") + "The name of the group that will own /sys/fs/cgroup resources. Users that +want to use rootless Podman have to be in this group.") + (containers-registries + (lowerable + (plain-file "registries.conf" + (string-append "unqualified-search-registries = ['docker.io','" + "registry.fedora.org','registry.opensuse.org']"))) + "A string or a gexp evaluating to the path of Podman's +@code{containers/registries.conf} configuration file.") + (containers-storage + (lowerable + (plain-file "storage.conf" + "[storage] +driver = \"overlay\"")) + "A string or a gexp evaluating to the path of Podman's +@code{containers/storage.conf} configuration file.") + (containers-policy + (lowerable + (plain-file "policy.json" + "{\"default\": [{\"type\": \"insecureAcceptAnything\"}]}")) + "A string or a gexp evaluating to the path of Podman's +@code{containers/policy.json} configuration file.") + (pam-limits + (list-of-pam-limits-entries + (list (pam-limits-entry "*" 'both 'nofile 100000))) + "The PAM limits to be set for rootless Podman.") + (subgids + (list-of-subid-ranges '()) + "A list of subid ranges representing the subgids that will be +available for each configured user.") + (subuids + (list-of-subid-ranges '()) + "A list of subid ranges representing the subuids that will be +available for each configured user.")) + +(define rootless-podman-service-profile + (lambda (config) + (list + (rootless-podman-configuration-podman config)))) + +(define rootless-podman-service-etc + (lambda (config) + (list `("containers/registries.conf" + ,(rootless-podman-configuration-containers-registries config)) + `("containers/storage.conf" + ,(rootless-podman-configuration-containers-storage config)) + `("containers/policy.json" + ,(rootless-podman-configuration-containers-policy config))))) + +(define rootless-podman-service-subids + (lambda (config) + (subids-extension + (subgids (rootless-podman-configuration-subgids config)) + (subuids (rootless-podman-configuration-subuids config))))) + +(define rootless-podman-service-accounts + (lambda (config) + (list (user-group (name (rootless-podman-configuration-group-name config)) + (system? #t))))) + +(define (cgroups-fs-owner-entrypoint config) + (define group + (rootless-podman-configuration-group-name config)) + (program-file "cgroups2-fs-owner-entrypoint" + #~(system* + "bash" "-c" + (string-append "echo Setting /sys/fs/cgroup " + "group ownership to " #$group " && chown -v " + "root:" #$group " /sys/fs/cgroup && " + "chmod -v 775 /sys/fs/cgroup && chown -v " + "root:" #$group " /sys/fs/cgroup/cgroup." + "{procs,subtree_control,threads} && " + "chmod -v 664 /sys/fs/cgroup/cgroup." + "{procs,subtree_control,threads}")))) + +(define (rootless-podman-cgroups-fs-owner-service config) + (shepherd-service (provision '(cgroups2-fs-owner)) + (requirement + '(dbus-system + elogind + file-system-/sys/fs/cgroup + networking + udev + cgroups2-limits)) + (one-shot? #t) + (documentation + "Set ownership of /sys/fs/cgroup to the configured group.") + (start + #~(make-forkexec-constructor + (list + #$(cgroups-fs-owner-entrypoint config)))) + (stop + #~(make-kill-destructor)))) + +(define cgroups-limits-entrypoint + (program-file "cgroups2-limits-entrypoint" + #~(system* + "bash" "-c" + (string-append "echo Setting cgroups v2 limits && " + "echo +cpu +cpuset +memory +pids" + " >> /sys/fs/cgroup/cgroup.subtree_control")))) + +(define (rootless-podman-cgroups-limits-service config) + (shepherd-service (provision '(cgroups2-limits)) + (requirement + '(dbus-system + elogind + networking + udev + file-system-/sys/fs/cgroup + rootless-podman-shared-root-fs)) + (one-shot? #t) + (documentation + "Allow setting cgroups limits: cpu, cpuset, memory and +pids.") + (start + #~(make-forkexec-constructor + (list + #$cgroups-limits-entrypoint))) + (stop + #~(make-kill-destructor)))) + +(define rootless-podman-shared-root-fs-entrypoint + (program-file "rootless-podman-shared-root-fs-entrypoint" + #~(system* + "mount" "--make-shared" "/"))) + +(define (rootless-podman-shared-root-fs-service config) + (shepherd-service (provision '(rootless-podman-shared-root-fs)) + (requirement + '(user-processes)) + (one-shot? #t) + (documentation + "Buildah/Podman running as rootless expects the bind mount +to be shared. This service sets it so.") + (start + #~(make-forkexec-constructor + (list + #$rootless-podman-shared-root-fs-entrypoint))) + (stop + #~(make-kill-destructor)))) + +(define (rootless-podman-shepherd-services config) + (list + (rootless-podman-shared-root-fs-service config) + (rootless-podman-cgroups-limits-service config) + (rootless-podman-cgroups-fs-owner-service config))) + +(define rootless-podman-service-type + (service-type (name 'rootless-podman) + (extensions + (list + (service-extension subids-service-type + rootless-podman-service-subids) + (service-extension account-service-type + rootless-podman-service-accounts) + (service-extension profile-service-type + rootless-podman-service-profile) + (service-extension shepherd-root-service-type + rootless-podman-shepherd-services) + (service-extension pam-limits-service-type + rootless-podman-configuration-pam-limits) + (service-extension etc-service-type + rootless-podman-service-etc))) + (default-value (rootless-podman-configuration)) + (description + "This service configures rootless @code{podman} on the Guix System."))) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm new file mode 100644 index 0000000000..ba2fb22df6 --- /dev/null +++ b/gnu/tests/containers.scm @@ -0,0 +1,340 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 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 tests containers) + #:use-module (gnu) + #:use-module (gnu tests) + #:use-module (guix build-system trivial) + #:use-module (gnu packages bash) + #:use-module (gnu packages containers) + #:use-module (gnu packages guile) + #:use-module (gnu packages guile-xyz) + #:use-module (gnu services) + #:use-module (gnu services containers) + #:use-module (gnu services desktop) + #:use-module (gnu services dbus) + #:use-module (gnu services networking) + #:use-module (gnu system) + #:use-module (gnu system accounts) + #:use-module (gnu system vm) + #:use-module (guix gexp) + #:use-module ((guix licenses) #:prefix license:) + #:use-module (guix monads) + #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix store) + #:export (%test-rootless-podman)) + + +(define %rootless-podman-os + (simple-operating-system + (service rootless-podman-service-type + (rootless-podman-configuration + (subgids + (list (subid-range (name "dummy")))) + (subuids + (list (subid-range (name "dummy")))))) + + (service dhcp-client-service-type) + (service dbus-root-service-type) + (service polkit-service-type) + (service elogind-service-type) + + (simple-service 'accounts + account-service-type + (list (user-account + (name "dummy") + (group "users") + (supplementary-groups '("wheel" "netdev" "cgroup" + "audio" "video"))))))) + +(define (run-rootless-podman-test oci-tarball) + + (define os + (marionette-operating-system + (operating-system-with-gc-roots + %rootless-podman-os + (list oci-tarball)) + #: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) + (gnu services herd)) + #~(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") + + (test-assert "service started" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'cgroups2-fs-owner) + (#f #f) + ;; herd returns (running #f), likely because of one shot, + ;; so consider any non-error a success. + (('service response-parts ...) #t))) + marionette)) + + (test-equal "/sys/fs/cgroup/cgroup.subtree_control content is sound" + (list "cpu" "cpuset" "memory" "pids") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (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* ((response1 (slurp + ,(string-append #$coreutils "/bin/cat") + "/sys/fs/cgroup/cgroup.subtree_control"))) + (sort-list (string-split (first response1) #\space) stringscm (scm->json-string \"JSON!\")))'")) + + ;; Check whether /tmp exists. + (response4 (slurp + ,(string-append #$podman "/bin/podman") + "run" "--pull" "never" repository&tag "-c" + "'(display (stat:perms (lstat \"/tmp\")))'"))) + (call-with-output-file (string-append ,out-dir "/response1") + (lambda (port) + (display (string-join response1 " ") port))) + (call-with-output-file (string-append ,out-dir "/response2") + (lambda (port) + (display (string-join response2 " ") port))) + (call-with-output-file (string-append ,out-dir "/response3") + (lambda (port) + (display (string-join response3 " ") port))) + (call-with-output-file (string-append ,out-dir "/response4") + (lambda (port) + (display (string-join response4 " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + (wait-for-file (string-append ,out-dir "/response4")) + (append + (slurp "cat" (string-append ,out-dir "/response1")) + (slurp "cat" (string-append ,out-dir "/response2")) + (slurp "cat" (string-append ,out-dir "/response3")) + (map string->number (slurp "cat" (string-append ,out-dir "/response4"))))) + marionette)) + + (test-end)))) + + (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)))) -- 2.45.2