GNU bug report logs - #72740
Add rootless-podman-service-type

Previous Next

Package: guix-patches;

Reported by: paul <goodoldpaul <at> autistici.org>

Date: Tue, 20 Aug 2024 23:22:01 UTC

Severity: normal

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

Bug is archived. No further changes may be made.

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

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

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

Report forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Tue, 20 Aug 2024 23:22:02 GMT) Full text and rfc822 format available.
Acknowledgement sent to paul <goodoldpaul <at> autistici.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Tue, 20 Aug 2024 23:22:02 GMT) Full text and rfc822 format available.

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

From: paul <goodoldpaul <at> autistici.org>
To: guix-patches <at> gnu.org
Subject: Add rootless-podman-service-type
Date: Wed, 21 Aug 2024 01:20:41 +0200

[Message part 1 (text/plain, inline)]
Dear Guixers,

I'm sending a patchset adding rootless Podman support to the Guix 
System. I'm currently using this on my systems as it's set up in my 
personal channel [0]. By adding the following to my own system config

(use-modules (small-guix system accounts)
             (small-guix services containers))

(service iptables-service-type)
(service rootless-podman-service-type
         (rootless-podman-configuration
          (subgids
           (list (subid-range (name "alice"))))
          (subuids
           (list (subid-range (name "alice"))))))

I'm able to run the following rootless Podman hello world

$ 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"

and with guix shell podman compose I'm able to run this Podman compose 
hello world [1]:

$ mkdir data
$ echo hello world > data/index.html
$ podman compose up -d

...

exit code: 0
$ curl localhost:8080
hello world


This patch depends on the subids-service-type from issue #72337 [2]. 
Please let me know your thoughts.

Thank you for your work,

giacomo


[0]: 
https://gitlab.com/orang3/small-guix/-/blob/master/small-guix/services/containers.scm?ref_type=heads#L197
[1]: 
https://github.com/fishinthecalculator/rootless-podman-nginx-static-server
[2]: https://issues.guix.gnu.org/72337

[Message part 2 (text/html, inline)]
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Tue, 20 Aug 2024 23:23:02 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH 1/4] system: pam: Export pam records predicates.
Date: Wed, 21 Aug 2024 01:21:42 +0200

* gnu/system/pam.scm: Export pam-service-name?, pam-entry? and pam-limits-entry?.

Change-Id: I609acfcaae85b4969dc385b72b307e470f5a246e
---
 gnu/system/pam.scm | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index a035a92e25..5c7c4e8153 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -34,6 +34,7 @@ (define-module (gnu system pam)
   #:use-module ((guix utils) #:select (%current-system))
   #:use-module (gnu packages linux)
   #:export (pam-service
+            pam-service-name?
             pam-service-name
             pam-service-account
             pam-service-auth
@@ -41,11 +42,13 @@ (define-module (gnu system pam)
             pam-service-session
 
             pam-entry
+            pam-entry?
             pam-entry-control
             pam-entry-module
             pam-entry-arguments
 
             pam-limits-entry
+            pam-limits-entry?
             pam-limits-entry-domain
             pam-limits-entry-type
             pam-limits-entry-item

base-commit: 00245fdcd4909d7e6b20fe88f5d089717115adc1
-- 
2.45.2
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Tue, 20 Aug 2024 23:23:02 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH 2/4] services: pam: Allow extension of pam limits.
Date: Wed, 21 Aug 2024 01:21:43 +0200

* gnu/services/pam.scm (pam-limits-service-type): Allow extension of pam
limits rules from users and services.

Change-Id: I93a363d1a2887493d52ef3ae32fc9721f81ddfa8
---
 gnu/services/base.scm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 4b5b103cc3..e4e59da433 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1680,6 +1680,8 @@ (define pam-limits-service-type
 
     (service-type
      (name 'limits)
+     (compose concatenate)
+     (extend append)
      (extensions
       (list (service-extension pam-root-service-type
                                (lambda (config)
-- 
2.45.2
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Tue, 20 Aug 2024 23:24:02 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH 3/4] services: iptables: Provide a default value.
Date: Wed, 21 Aug 2024 01:21:44 +0200

There doesn't seem to be a reason to force users to write

(service iptables-service-type
         (iptables-configuration))

instead of simply

(service iptables-service-type)

This patch provides a default value for the iptables-service-type.

* gnu/services/networking.scm (iptables-service-type): Set default-value.

Change-Id: I93b6c544dfb064c7a0a999549dff61007a38f842
---
 gnu/services/networking.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 12d8934e43..c70fea7813 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -2055,6 +2055,7 @@ (define (iptables-shepherd-service config)
 (define iptables-service-type
   (service-type
    (name 'iptables)
+   (default-value (iptables-configuration))
    (description
     "Run @command{iptables-restore}, setting up the specified rules.")
    (extensions
-- 
2.45.2
Information forwarded to pelzflorian <at> pelzflorian.de, ludo <at> gnu.org, matt <at> excalamus.com, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Tue, 20 Aug 2024 23:24:02 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH 4/4] services: Add rootless-podman-service-type.
Date: Wed, 21 Aug 2024 01:21:45 +0200

* 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 | 216 +++++++++++++++++++++
 gnu/tests/containers.scm    | 361 ++++++++++++++++++++++++++++++++++++
 4 files changed, 683 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..2337a4a001
--- /dev/null
+++ b/gnu/services/containers.scm
@@ -0,0 +1,216 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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
+                       networking
+                       udev
+                       file-system-/sys/fs/cgroup
+                       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))
+                    (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-shepherd-services config)
+  (list
+   (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..e60b5e5b8d
--- /dev/null
+++ b/gnu/tests/containers.scm
@@ -0,0 +1,361 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 services shepherd)
+  #: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 'shared-root-service
+                   shepherd-root-service-type
+                   (list
+                    (shepherd-service
+                     (provision '(rootless-podman-shared-root-fs))
+                     (requirement
+                      '(file-systems))
+                     (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
+                          #$(program-file "rootless-podman-shared-root-fs-entrypoint"
+                                          #~(system*
+                                             "mount" "--make-shared" "/")))))
+                     (stop
+                      #~(make-kill-destructor)))))
+
+   (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) string<?)))
+             marionette))
+
+          (test-equal "/sys/fs/cgroup has correct permissions"
+            '("cgroup" "cgroup")
+            (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))
+
+          (test-equal "Load oci image and run it (unprivileged)"
+            '("hello world" "hi!" "JSON!" #o1777)
+            (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 "dummy")))
+                       (setuid (passwd:uid (getpw "dummy")))
+
+                       (let* ((loaded (slurp ,(string-append #$podman
+                                                             "/bin/podman")
+                                             "load" "-i"
+                                             ,#$oci-tarball))
+                              (repository&tag "localhost/guile-guest:latest")
+                              (response1 (slurp
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never"
+                                          "--entrypoint" "bin/Guile"
+                                          repository&tag
+                                          "/aa.scm"))
+                              (response2 (slurp ;default entry point
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never" repository&tag
+                                          "-c" "'(display \"hi!\")'"))
+
+                              ;; Check whether (json) is in $GUILE_LOAD_PATH.
+                              (response3 (slurp ;default entry point + environment
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never" repository&tag
+                                          "-c" "'(use-modules (json))
+  (display (json-string->scm (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
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Wed, 21 Aug 2024 08:20:02 GMT) Full text and rfc822 format available.

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

From: paul <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Subject: Re: Add rootless-podman-service-type
Date: Wed, 21 Aug 2024 10:18:44 +0200

Dear Guixers,


I'm sending a v2. This revision contains a small change: Buildah/Podman 
running as rootless expects the bind mount to be shared.  This patchset 
contains a Shepherd service that sets it so.

Thank you very much for your help,


giacomo
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Wed, 21 Aug 2024 08:21:02 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v2 2/4] services: pam: Allow extension of pam limits.
Date: Wed, 21 Aug 2024 10:19:25 +0200

* gnu/services/pam.scm (pam-limits-service-type): Allow extension of pam
limits rules from users and services.

Change-Id: I93a363d1a2887493d52ef3ae32fc9721f81ddfa8
---
 gnu/services/base.scm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 4b5b103cc3..e4e59da433 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1680,6 +1680,8 @@ (define pam-limits-service-type
 
     (service-type
      (name 'limits)
+     (compose concatenate)
+     (extend append)
      (extensions
       (list (service-extension pam-root-service-type
                                (lambda (config)
-- 
2.45.2
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Wed, 21 Aug 2024 08:21:03 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v2 1/4] system: pam: Export pam records predicates.
Date: Wed, 21 Aug 2024 10:19:24 +0200

* gnu/system/pam.scm: Export pam-service-name?, pam-entry? and pam-limits-entry?.

Change-Id: I609acfcaae85b4969dc385b72b307e470f5a246e
---
 gnu/system/pam.scm | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index a035a92e25..5c7c4e8153 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -34,6 +34,7 @@ (define-module (gnu system pam)
   #:use-module ((guix utils) #:select (%current-system))
   #:use-module (gnu packages linux)
   #:export (pam-service
+            pam-service-name?
             pam-service-name
             pam-service-account
             pam-service-auth
@@ -41,11 +42,13 @@ (define-module (gnu system pam)
             pam-service-session
 
             pam-entry
+            pam-entry?
             pam-entry-control
             pam-entry-module
             pam-entry-arguments
 
             pam-limits-entry
+            pam-limits-entry?
             pam-limits-entry-domain
             pam-limits-entry-type
             pam-limits-entry-item

base-commit: 00245fdcd4909d7e6b20fe88f5d089717115adc1
-- 
2.45.2
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Wed, 21 Aug 2024 08:21:03 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v2 3/4] services: iptables: Provide a default value.
Date: Wed, 21 Aug 2024 10:19:26 +0200

There doesn't seem to be a reason to force users to write

(service iptables-service-type
         (iptables-configuration))

instead of simply

(service iptables-service-type)

This patch provides a default value for the iptables-service-type.

* gnu/services/networking.scm (iptables-service-type): Set default-value.

Change-Id: I93b6c544dfb064c7a0a999549dff61007a38f842
---
 gnu/services/networking.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 12d8934e43..c70fea7813 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -2055,6 +2055,7 @@ (define (iptables-shepherd-service config)
 (define iptables-service-type
   (service-type
    (name 'iptables)
+   (default-value (iptables-configuration))
    (description
     "Run @command{iptables-restore}, setting up the specified rules.")
    (extensions
-- 
2.45.2
Information forwarded to pelzflorian <at> pelzflorian.de, ludo <at> gnu.org, matt <at> excalamus.com, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Wed, 21 Aug 2024 08:21:04 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v2 4/4] services: Add rootless-podman-service-type.
Date: Wed, 21 Aug 2024 10:19:27 +0200

* 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 <goodoldpaul <at> autistici.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 <goodoldpaul <at> autistici.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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) string<?)))
+             marionette))
+
+          (test-equal "/sys/fs/cgroup has correct permissions"
+            '("cgroup" "cgroup")
+            (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))
+
+          (test-equal "Load oci image and run it (unprivileged)"
+            '("hello world" "hi!" "JSON!" #o1777)
+            (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 "dummy")))
+                       (setuid (passwd:uid (getpw "dummy")))
+
+                       (let* ((loaded (slurp ,(string-append #$podman
+                                                             "/bin/podman")
+                                             "load" "-i"
+                                             ,#$oci-tarball))
+                              (repository&tag "localhost/guile-guest:latest")
+                              (response1 (slurp
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never"
+                                          "--entrypoint" "bin/Guile"
+                                          repository&tag
+                                          "/aa.scm"))
+                              (response2 (slurp ;default entry point
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never" repository&tag
+                                          "-c" "'(display \"hi!\")'"))
+
+                              ;; Check whether (json) is in $GUILE_LOAD_PATH.
+                              (response3 (slurp ;default entry point + environment
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never" repository&tag
+                                          "-c" "'(use-modules (json))
+  (display (json-string->scm (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
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Fri, 23 Aug 2024 11:41:01 GMT) Full text and rfc822 format available.

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

From: paul <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Subject: Re: Add rootless-podman-service-type
Date: Fri, 23 Aug 2024 13:39:36 +0200

Dear Guixers,
I'm sending a v3. The only fix in this revision is that instead of 
exporting the (non-existing) pam-service-name? procedure, the 
pam-service? predicate is rightly exposed with the other pam-service* 
procedures.

Thank you for your work,

giacomo
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Fri, 23 Aug 2024 11:43:01 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v3 1/4] system: pam: Export pam records predicates.
Date: Fri, 23 Aug 2024 13:40:54 +0200

* gnu/system/pam.scm: Export pam-service-name?, pam-entry? and pam-limits-entry?.

Change-Id: I609acfcaae85b4969dc385b72b307e470f5a246e
---
 gnu/system/pam.scm | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index a035a92e25..07b84b04ef 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -34,6 +34,7 @@ (define-module (gnu system pam)
   #:use-module ((guix utils) #:select (%current-system))
   #:use-module (gnu packages linux)
   #:export (pam-service
+            pam-service?
             pam-service-name
             pam-service-account
             pam-service-auth
@@ -41,11 +42,13 @@ (define-module (gnu system pam)
             pam-service-session
 
             pam-entry
+            pam-entry?
             pam-entry-control
             pam-entry-module
             pam-entry-arguments
 
             pam-limits-entry
+            pam-limits-entry?
             pam-limits-entry-domain
             pam-limits-entry-type
             pam-limits-entry-item

base-commit: 00245fdcd4909d7e6b20fe88f5d089717115adc1
-- 
2.45.2
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Fri, 23 Aug 2024 11:43:02 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v3 2/4] services: pam: Allow extension of pam limits.
Date: Fri, 23 Aug 2024 13:40:55 +0200

* gnu/services/pam.scm (pam-limits-service-type): Allow extension of pam
limits rules from users and services.

Change-Id: I93a363d1a2887493d52ef3ae32fc9721f81ddfa8
---
 gnu/services/base.scm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 4b5b103cc3..e4e59da433 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1680,6 +1680,8 @@ (define pam-limits-service-type
 
     (service-type
      (name 'limits)
+     (compose concatenate)
+     (extend append)
      (extensions
       (list (service-extension pam-root-service-type
                                (lambda (config)
-- 
2.45.2
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Fri, 23 Aug 2024 11:43:02 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v3 3/4] services: iptables: Provide a default value.
Date: Fri, 23 Aug 2024 13:40:56 +0200

There doesn't seem to be a reason to force users to write

(service iptables-service-type
         (iptables-configuration))

instead of simply

(service iptables-service-type)

This patch provides a default value for the iptables-service-type.

* gnu/services/networking.scm (iptables-service-type): Set default-value.

Change-Id: I93b6c544dfb064c7a0a999549dff61007a38f842
---
 gnu/services/networking.scm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 12d8934e43..c70fea7813 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -2055,6 +2055,7 @@ (define (iptables-shepherd-service config)
 (define iptables-service-type
   (service-type
    (name 'iptables)
+   (default-value (iptables-configuration))
    (description
     "Run @command{iptables-restore}, setting up the specified rules.")
    (extensions
-- 
2.45.2
Information forwarded to pelzflorian <at> pelzflorian.de, ludo <at> gnu.org, matt <at> excalamus.com, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Fri, 23 Aug 2024 11:43:03 GMT) Full text and rfc822 format available.

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

From: Giacomo Leidi <goodoldpaul <at> autistici.org>
To: 72740 <at> debbugs.gnu.org
Cc: Giacomo Leidi <goodoldpaul <at> autistici.org>
Subject: [PATCH v3 4/4] services: Add rootless-podman-service-type.
Date: Fri, 23 Aug 2024 13:40:57 +0200

* 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 <goodoldpaul <at> autistici.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 <goodoldpaul <at> autistici.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(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) string<?)))
+             marionette))
+
+          (test-equal "/sys/fs/cgroup has correct permissions"
+            '("cgroup" "cgroup")
+            (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))
+
+          (test-equal "Load oci image and run it (unprivileged)"
+            '("hello world" "hi!" "JSON!" #o1777)
+            (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 "dummy")))
+                       (setuid (passwd:uid (getpw "dummy")))
+
+                       (let* ((loaded (slurp ,(string-append #$podman
+                                                             "/bin/podman")
+                                             "load" "-i"
+                                             ,#$oci-tarball))
+                              (repository&tag "localhost/guile-guest:latest")
+                              (response1 (slurp
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never"
+                                          "--entrypoint" "bin/Guile"
+                                          repository&tag
+                                          "/aa.scm"))
+                              (response2 (slurp ;default entry point
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never" repository&tag
+                                          "-c" "'(display \"hi!\")'"))
+
+                              ;; Check whether (json) is in $GUILE_LOAD_PATH.
+                              (response3 (slurp ;default entry point + environment
+                                          ,(string-append #$podman "/bin/podman")
+                                          "run" "--pull" "never" repository&tag
+                                          "-c" "'(use-modules (json))
+  (display (json-string->scm (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
Reply sent to Ludovic Courtès <ludo <at> gnu.org>:
You have taken responsibility. (Wed, 18 Dec 2024 16:23:02 GMT) Full text and rfc822 format available.
Notification sent to paul <goodoldpaul <at> autistici.org>:
bug acknowledged by developer. (Wed, 18 Dec 2024 16:23:02 GMT) Full text and rfc822 format available.

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

From: Ludovic Courtès <ludo <at> gnu.org>
To: Giacomo Leidi <goodoldpaul <at> autistici.org>
Cc: 72740-done <at> debbugs.gnu.org, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>,
 Florian Pelz <pelzflorian <at> pelzflorian.de>,
 Matthew Trzcinski <matt <at> excalamus.com>
Subject: Re: bug#72740: Add rootless-podman-service-type
Date: Wed, 18 Dec 2024 17:21:50 +0100

[Message part 1 (text/plain, inline)]
Hi,

Giacomo Leidi <goodoldpaul <at> autistici.org> skribis:

> * 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

Applied at long last, with the changes below to the manual.

Thank you!

Ludo’.


[Message part 2 (text/x-patch, inline)]
diff --git a/doc/guix.texi b/doc/guix.texi
index a05fa68c05..ee2002a712 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41295,18 +41295,24 @@ Miscellaneous Services
 @cindex Rootless Podman
 @subsubheading Rootless Podman Service
 
+@cindex rootless podman, container management tool
+@cindex podman, rootless
+@cindex container management, podman
 The @code{(gnu services containers)} module provides the following service.
 
 
-@cindex Rootless Podman, container management tool
 @defvar rootless-podman-service-type
+This is the service type for @url{https://podman.io, Podman} is a
+container management tool.
 
-@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.
+In addition to providing a drop-in replacement for Docker, Podman offers
+the ability to run containers in ``root-less'' mode, meaning that regular users can
+deploy containers without elevated privileges.  It does so mainly by leveraging
+two Linux kernel features: unprivileged user namespaces, and subordinate
+user and group IDs (@pxref{subordinate-user-group-ids, the subordinate
+user and group ID service}).
 
-The @code{rootless-podman-service-type} sets up the Guix System to allow
+The @code{rootless-podman-service-type} sets up the system to allow
 unprivileged users to run @command{podman} commands:
 
 @lisp
@@ -41325,14 +41331,14 @@ Miscellaneous Services
                                         "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")))))))))
+    (append (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")))))))
+            %base-services)))
 @end lisp
 
 The @code{iptables-service-type} is required for Podman to be able to setup its
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Sun, 29 Dec 2024 10:37:01 GMT) Full text and rfc822 format available.

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

From: Ludovic Courtès <ludo <at> gnu.org>
To: Giacomo Leidi <goodoldpaul <at> autistici.org>
Cc: 72740 <at> debbugs.gnu.org, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>,
 Florian Pelz <pelzflorian <at> pelzflorian.de>,
 Matthew Trzcinski <matt <at> excalamus.com>
Subject: Re: bug#72740: Add rootless-podman-service-type
Date: Sun, 29 Dec 2024 11:36:37 +0100

Hi Giacomo,

I noticed that the test is currently failing:

--8<---------------cut here---------------start------------->8---
shepherd: Service rootless-podman-shared-root-fs has been started.
shepherd: Starting service cgroups2-fs-owner...
shepherd: Service cgroups2-fs-owner started.
shepherd: Service cgroups2-fs-owner running with value #<<process> id: 178 command: ("/gnu/store/vq4rfvdj6xbrpclwmpdvp6ydxsggwvkh-cgroups2-fs-owner-entrypoint")>.
shepherd: Service cgroups2-limits has been started.
shepherd: Starting service cgroups2-fs-owner...
shepherd: Service cgroups2-fs-owner has been started.
ice-9/eval.scm:159:9: In procedure car: Wrong type (expecting pair): ()
Getting image source signatures
Copying blob 2e9a3fc88c27 [=>-----------------] 11.8MiB / 138.8MiB | 170.3 MiB/s
[1A[JCopying blob 2e9a3fc88c27 [==>----------------] 23.8MiB / 138.8MiB | 171.4 MiB/s

[…]

Test begin:
  test-name: "/sys/fs/cgroup/cgroup.subtree_control content is sound"
  source-file: "/gnu/store/mdx7id4501d4sj71zlgdx9qa31f0rspp-rootless-podman-test-builder"
  source-line: 1
  source-form: (test-equal "/sys/fs/cgroup/cgroup.subtree_control content is sound" (list "cpu" "cpuset" "memory" "pids") (marionette-eval (quasiquote (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 (quote ()))) (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 (unquote (string-append "/gnu/store/fk39d3y3zyr6ajyzy8d6ghd0sj524cs5-coreutils-9.1" "/bin/cat")) "/sys/fs/cgroup/cgroup.subtree_control"))) (sort-list (string-split (first response1) #\space) string<?)))) marionette))
Test end:
  result-kind: fail
  actual-value: #f
  expected-value: ("cpu" "cpuset" "memory" "pids")
--8<---------------cut here---------------end--------------->8---

(From <https://ci.guix.gnu.org/build/7694600/details>.)

Notice the “Wrong type” error.

Could you take a look?

Ludo’.
Information forwarded to guix-patches <at> gnu.org:
bug#72740; Package guix-patches. (Sun, 29 Dec 2024 21:59:02 GMT) Full text and rfc822 format available.

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

From: paul <goodoldpaul <at> autistici.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 72740 <at> debbugs.gnu.org, Maxim Cournoyer <maxim.cournoyer <at> gmail.com>,
 Florian Pelz <pelzflorian <at> pelzflorian.de>,
 Matthew Trzcinski <matt <at> excalamus.com>
Subject: Re: bug#72740: Add rootless-podman-service-type
Date: Sun, 29 Dec 2024 22:58:17 +0100

[Message part 1 (text/plain, inline)]
Hi Ludo' ,

it works on my laptop (I'm trying on commit 
0d4af3c55c7fd75f03a0b6ecc059720657268ff3 ), so I believe it is just a 
matter of increasing timeouts, I'm creating a new patch to increase them

GC Warning: pthread_getattr_np or pthread_attr_getstack failed for main thread
GC Warning: Could not open /proc/stat
Welcome, this is GNU's early boot Guile.
Use 'gnu.repl' for an initrd REPL.

loading kernel modules...
Guix_image: clean, 74861/192000 files, 529473/768000 blocks
loading '/gnu/store/88p4hfc4bb3vgbdl5wbzp32iz5paddk5-system/boot'...
making '/gnu/store/88p4hfc4bb3vgbdl5wbzp32iz5paddk5-system' the current system...
populating /etc from /gnu/store/xzdyagi33ab00lzcanr9day1pym4s116-etc...
setting up privileged programs in '/run/privileged/bin'...
Please wait while gathering entropy to generate the key pair;
this may take time...
creating /etc/machine-id...
[    9.126087] udevd[96]: specified group 'sgx' unknown
[    9.513326] udevd[96]: no sender credentials received, message ignored
[   11.933576] Error: Driver 'pcspkr' is already registered, aborting...
Dec 29 22:54:06 localhost vmunix: [    9.126087] udevd[96]: specified group 'sgx' unknown
Dec 29 22:54:06 localhost vmunix: [    9.513326] udevd[96]: no sender credentials received, message ignored
Dec 29 22:54:06 localhost vmunix: [   11.933576] Error: Driver 'pcspkr' is already registered, aborting...


This is the GNU system.  Welcome.
komputilo login: Getting image source signatures
Copying blob 2e9a3fc88c27 done   |
Copying config 6143ce0196 done   |
Writing manifest to image destination
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;       or pass the --no-auto-compile argument to disable.
;;; compiling /aa.scm
;;; compiled /.cache/guile/ccache/3.0-LE-8-4.6/gnu/store/94fibvjivrc2phgm90kc6ka3jjysgg6h-guest-script-0/a.scm.go
shepherd: Starting service cgroups2-fs-owner...
shepherd: Service cgroups2-fs-owner started.
shepherd: Service cgroups2-fs-owner running with value #<<process> id: 180 command: ("/gnu/store/89mgs6sgfgd7vhcb8w7j6fsz6vpwp4.
shepherd: Service user-homes has been started.
shepherd: Service rootless-podman-shared-root-fs has been started.
shepherd: Service cgroups2-limits has been started.
shepherd: Starting service cgroups2-fs-owner...
shepherd: Service cgroups2-fs-owner has been started.
QEMU runs as PID 18
connected to QEMU's monitor
read QEMU monitor prompt
connected to guest REPL
%%%% Starting test rootless-podman  (Writing full log to "/gnu/store/6ga9q0nwl3ccwpkba73rmls41vg86b20-rootless-podman-test/root)
marionette is ready
PASS: service started
PASS: /sys/fs/cgroup/cgroup.subtree_control content is sound
PASS: /sys/fs/cgroup has correct permissions
PASS: Load oci image and run it (unprivileged)
# of expected passes      4
successfully built /gnu/store/3h3xhr7wdnd8w79bfarqfhjfwgzd91ad-rootless-podman-test.drv
/gnu/store/6ga9q0nwl3ccwpkba73rmls41vg86b20-rootless-podman-test



Thank you for bringing this up,

cheers

giacomo


[Message part 2 (text/html, inline)]
bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Mon, 27 Jan 2025 12:24:09 GMT) Full text and rfc822 format available.
This bug report was last modified 194 days ago.

Previous Next

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