guix_mirror_bot pushed a commit to branch master
in repository guix.

commit 5373d3b9aaceec999c43b30f9d9e77aa4420c6ea
Author: Maxim Cournoyer <[email protected]>
AuthorDate: Fri Oct 24 10:36:31 2025 +0900

    syscalls: Warn about violated single thread requirement in 'unshare'.
    
    * guix/build/syscalls.scm (thread-count): New procedure.
    (unshare): Add a warning when unshare single thread
    requirement (depending on flags passed) is violated.  Update doc.
    (CLONE_SIGHAND, CLONE_THREAD, CLONE_VM): New variables.
    
    Change-Id: If98a91a0a0d9f7d67e5487b26d2d270f7b2191b1
---
 guix/build/syscalls.scm | 50 +++++++++++++++++++++++++++++++++++++------------
 1 file changed, 38 insertions(+), 12 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 9c64b40d77..3106e4e3d6 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2021 Tobias Geerinckx-Rice <[email protected]>
 ;;; Copyright © 2022 Oleg Pykhalov <[email protected]>
 ;;; Copyright © 2024 Noah Evans <[email protected]>
+;;; Copyright © 2025 Maxim Cournoyer <[email protected]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -41,6 +42,7 @@
   #:use-module (ice-9 regex)
   #:use-module (ice-9 match)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 threads)
   #:export (MS_RDONLY
             MS_NOSUID
             MS_NODEV
@@ -144,6 +146,9 @@
             CLONE_NEWUSER
             CLONE_NEWPID
             CLONE_NEWNET
+            CLONE_SIGHAND
+            CLONE_THREAD
+            CLONE_VM
             clone
             unshare
             setns
@@ -1146,6 +1151,9 @@ caller lacks root privileges."
 (define CLONE_NEWUSER        #x10000000)
 (define CLONE_NEWPID         #x20000000)
 (define CLONE_NEWNET         #x40000000)
+(define CLONE_SIGHAND       #x00000800)
+(define CLONE_THREAD        #x00010000)
+(define CLONE_VM            #x00000100)
 
 (define %set-automatic-finalization-enabled?!
   ;; When using a statically-linked Guile, for instance in the initrd, we
@@ -1215,22 +1223,40 @@ are shared between the parent and child processes."
                    (list err))
             ret)))))
 
+(define (thread-count)
+  "Return the complete thread count of the current process.  Unlike
+`all-threads', this also counts the Guile signal delivery, and finalizer
+threads."
+  (scandir "/proc/self/task"
+           (negate (cut member <> '("." "..")))))
+
 (define unshare
   (let ((proc (syscall->procedure int "unshare" (list int))))
     (lambda (flags)
       "Disassociate the current process from parts of its execution context
-according to FLAGS, which must be a logical or of CLONE_NEW* constants.
-
-Note that CLONE_NEWUSER requires that the calling process be single-threaded,
-which is possible if and only if libgc is running a single marker thread; this
-can be achieved by setting the GC_MARKERS environment variable to 1.  If the
-calling process is multi-threaded, this throws to 'system-error' with EINVAL."
-      (let-values (((ret err)
-                    (without-automatic-finalization (proc flags))))
-        (unless (zero? ret)
-          (throw 'system-error "unshare" "~a: ~A"
-                 (list flags (strerror err))
-                 (list err)))))))
+according to FLAGS, which must be a logical or of CLONE_* constants.  When
+CLONE_NEWUSER, CLONE_SIGHAND, CLONE_THREAD or CLONE_VM are specified, this
+wrapper verifies the caller's environment is single-threaded.  If this
+requirement is not met, it produces a warning and throws to 'system-error'
+with EINVAL."
+      (let* ((require-single-thread? (logtest (logior CLONE_NEWUSER
+                                                      CLONE_SIGHAND
+                                                      CLONE_THREAD
+                                                      CLONE_VM)
+                                              flags))
+             (warn/maybe (lambda ()
+                           (when (and require-single-thread?
+                                      (< 1 (length (thread-count))))
+                             (format (current-warning-port)
+                                     "warning: unshare single-thread \
+requirement violated~%")))))
+        (let-values (((ret err) (begin
+                                  (warn/maybe)
+                                  (proc flags))))
+          (unless (zero? ret)
+            (throw 'system-error "unshare" "~a: ~A"
+                   (list flags (strerror err))
+                   (list err))))))))
 
 (define setns
   ;; Some systems may be using an old (pre-2.14) version of glibc where there

Reply via email to