build/syscalls: Introduce new safe-clone and use it.

* guix/build/syscalls.scm (without-automatic-finalization): Accept multiple
expressions.
(without-garbage-collection): New syntax.
(without-threads): Likewise.
(ensure-signal-delivery-thread, safe-clone): New procedures.
* tests/syscalls.scm: ("clone and unshare triggers EINVAL")
("safe-clone and unshare succeeds"): New tests.
* gnu/build/linux-container.scm (run-container): Adjust to use 'safe-clone'.

Relates-to: #1169
Change-Id: I044c11a899e24e547a7aed97f30c8e7250ab5363

1 files changed, 35 insertions, 1 deletions

diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 879c3e4f254..a0483e68f08 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2020 Simon South <simon@simonsouth.net>
 ;;; Copyright © 2020 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2025 Maxim Cournoyer <maxim@guixotic.coop>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,8 @@
   #:use-module (srfi srfi-71)
   #:use-module (system foreign)
   #:use-module ((ice-9 ftw) #:select (scandir))
-  #:use-module (ice-9 match))
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 threads))
 
 ;; Test the (guix build syscalls) module, although there's not much that can
 ;; actually be tested without being root.
@@ -158,6 +160,38 @@
     (lambda args
       (system-error-errno args))))
 
+(define child-thunk
+  (lambda ()
+    (gc)                                ;spawn GC threads
+    (primitive-exit
+     (catch 'system-error
+       (lambda ()
+         (unshare CLONE_THREAD)
+         0)                             ;no error
+       (lambda args
+         (system-error-errno args))))))
+
+(define parent-proc
+  (lambda (pid)
+    (match (waitpid pid)
+       ((_ . status)
+        (status:exit-val status)))))
+
+(unless perform-container-tests?
+  (test-skip 1))
+(test-equal "clone and unshare triggers EINVAL"
+  EINVAL
+  (match (clone (logior CLONE_NEWUSER SIGCHLD))
+    (0   (child-thunk))
+    (pid (parent-proc pid))))
+
+(unless perform-container-tests?
+  (test-skip 1))
+(test-equal "safe-clone and unshare succeeds"
+  0
+  (safe-clone (logior CLONE_NEWUSER SIGCHLD)
+              child-thunk parent-proc))
+
 (unless perform-container-tests?
   (test-skip 1))
 (test-assert "setns"