[bug#72740] Add rootless-podman-service-type

[bug#72740] Add rootless-podman-service-type

[paul via Guix-patches via]

[-- Attachment #1: Type: text/plain, Size: 1507 bytes --]

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

[-- Attachment #2: Type: text/html, Size: 2424 bytes --]

[bug#72740] [PATCH 1/4] system: pam: Export pam records predicates.

[Giacomo Leidi via Guix-patches via]

* 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

[bug#72740] [PATCH 2/4] services: pam: Allow extension of pam limits.

[Giacomo Leidi via Guix-patches via]

* 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

[bug#72740] [PATCH 3/4] services: iptables: Provide a default value.

[Giacomo Leidi via Guix-patches via]

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

[bug#72740] [PATCH 4/4] services: Add rootless-podman-service-type.

[Giacomo Leidi via Guix-patches via]

* 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@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@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))
+
+\f
+(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

[bug#72740] Add rootless-podman-service-type

[paul via Guix-patches via]

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

[bug#72740] [PATCH v2 1/4] system: pam: Export pam records predicates.

[Giacomo Leidi via Guix-patches via]

* 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

[bug#72740] [PATCH v2 2/4] services: pam: Allow extension of pam limits.

[Giacomo Leidi via Guix-patches via]

* 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

[bug#72740] [PATCH v2 3/4] services: iptables: Provide a default value.

[Giacomo Leidi via Guix-patches via]

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

[bug#72740] [PATCH v2 4/4] services: Add rootless-podman-service-type.

[Giacomo Leidi via Guix-patches via]

* 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@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@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))
+
+\f
+(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

[bug#72740] Add rootless-podman-service-type

[paul via Guix-patches via]

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

[bug#72740] [PATCH v3 1/4] system: pam: Export pam records predicates.

[Giacomo Leidi via Guix-patches via]

* 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

[bug#72740] [PATCH v3 2/4] services: pam: Allow extension of pam limits.

[Giacomo Leidi via Guix-patches via]

* 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

[bug#72740] [PATCH v3 3/4] services: iptables: Provide a default value.

[Giacomo Leidi via Guix-patches via]

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

[bug#72740] [PATCH v3 4/4] services: Add rootless-podman-service-type.

[Giacomo Leidi via Guix-patches via]

* 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@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@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))
+
+\f
+(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

bug#72740: Add rootless-podman-service-type

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 727 bytes --]

Hi,

Giacomo Leidi <goodoldpaul@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’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 2512 bytes --]

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