1 files changed, 60 insertions(+), 53 deletions(-)

M gnu/tests/containers.scm

@@ 1,5 1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;


@@ 97,17 97,65 @@
 
           (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))
+          (marionette-eval
+           '(begin
+              (use-modules (gnu services herd))
+              (wait-for-service 'file-system-/sys/fs/cgroup))
+           marionette)
+
+          (test-assert "services started successfully and /sys/fs/cgroup has correct permissions"
+            (begin
+              (define (run-test)
+                (marionette-eval
+                 `(begin
+                    (use-modules (ice-9 popen)
+                                 (ice-9 match)
+                                 (ice-9 rdelim))
+
+                    (define (read-lines file-or-port)
+                      (define (loop-lines port)
+                        (let loop ((lines '()))
+                          (match (read-line port)
+                            ((? eof-object?)
+                             (reverse lines))
+                            (line
+                             (loop (cons line lines))))))
+
+                      (if (port? file-or-port)
+                          (loop-lines file-or-port)
+                          (call-with-input-file file-or-port
+                            loop-lines)))
+
+                    (define slurp
+                      (lambda args
+                        (let* ((port (apply open-pipe* OPEN_READ args))
+                               (output (read-lines port))
+                               (status (close-pipe port)))
+                          output)))
+                    (let* ((bash
+                            ,(string-append #$bash "/bin/bash"))
+                           (response1
+                            (slurp bash "-c"
+                                   (string-append "ls -la /sys/fs/cgroup | "
+                                                  "grep -E ' \\./?$' | awk '{ print $4 }'")))
+                           (response2 (slurp bash "-c"
+                                             (string-append "ls -l /sys/fs/cgroup/cgroup"
+                                                            ".{procs,subtree_control,threads} | "
+                                                            "awk '{ print $4 }' | sort -u"))))
+                      (list (string-join response1 "\n") (string-join response2 "\n"))))
+                 marionette))
+              ;; Allow services to come up on slower machines
+              (let loop ((attempts 0))
+                (if (= attempts 60)
+                    (error "Services didn't come up after more than 60 seconds")
+                    (if (equal? '("cgroup" "cgroup")
+                                (run-test))
+                        #t
+                        (begin
+                          (sleep 1)
+                          (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+                                  (+ 1 attempts))
+                          (loop (+ 1 attempts))))))))
 
           (test-equal "/sys/fs/cgroup/cgroup.subtree_control content is sound"
             (list "cpu" "cpuset" "memory" "pids")


@@ 144,47 192,6 @@
                   (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