GNU bug report logs - #75658
Non-deterministic Gash error in ‘gcc-mesboot-4.9.4’

Previous Next

Full log

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

From: Ludovic Courtès <ludo <at> gnu.org>
To: Timothy Sample <samplet <at> ngyro.com>
Cc: 75658 <at> debbugs.gnu.org, Janneke Nieuwenhuizen <janneke <at> gnu.org>
Subject: Re: bug#75658: Non-deterministic Gash error in
 ‘gcc-mesboot-4.9.4’
Date: Sun, 16 Mar 2025 22:32:03 +0100

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

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

> But this illustrates another problem: in the child process, right before
> ‘execve’, the finalization thread may be restarted, in which case it
> creates a new pipe.
>
> In the example below, the finalization pipe is on FDs 9 and 7, but
> ‘install-current-ports!’ blindly dups to FD 7, thereby closing one end
> of the finalization pipe that was just created:

The hack below addresses that (mostly) by reserving low-number file
descriptors before the signal and finalization threads create their
pipe.  (In practice, we can only reserve FDs above 5; FDs 3 and 4 are
the “sleep pipe” I believe.)

It seems to be good enough though.

Thoughts?

Ludo’.

[Message part 2 (text/x-patch, inline)]

diff --git a/gash/shell.scm b/gash/shell.scm
index 3611067..68e74e7 100644
--- a/gash/shell.scm
+++ b/gash/shell.scm
@@ -68,14 +68,13 @@ not a @code{file-port?}, its corresponding file descriptor will refer
 to @file{/dev/null}."
   ;; XXX: Input/output ports?  Closing other FDs?
   (for-each (lambda (i)
-              (match ((fd->current-port i))
-                ((? file-port? port)
-                 (dup port i))
-                ((? input-port? port)
-                 (dup (open-file "/dev/null" "r") i))
-                ((? output-port? port)
-                 (dup (open-file "/dev/null" "w") i))
-                (_ #t)))
+              (gc)
+              (let ((current-port (fd->current-port i)))
+                (match (current-port)
+                  ((? file-port? port)
+                   (let ((new (dup port i)))
+                     (redirect-port port new)))
+                  (#f #t))))
             (iota *fd-count*)))
 
 (define (exec-utility bindings path name args)
@@ -89,8 +88,14 @@ to @file{/dev/null}."
     ;; the buffer) produces its output.
     (flush-all-ports)
     (match (primitive-fork)
-      (0 (install-current-ports!)
-         (apply execle path utility-env name args))
+      (0
+       (dynamic-wind
+         (lambda ()
+           (install-current-ports!))
+         (lambda ()
+           (apply execle path utility-env name args))
+         (lambda ()
+           (primitive-exit 127))))
       (pid (match-let (((pid . status) (waitpid pid)))
              (set-status! (status:exit-val status)))))))
 
@@ -182,7 +187,10 @@ if it is our responsibility to close the port."
   (define* (make-processed-redir fd target #:optional (open-flags 0))
     (let ((port (match target
                   ((? port?) target)
-                  ((? string?) (open target open-flags))
+                  ((? string?)
+                   (let ((port (open target open-flags)))
+                     (set-port-revealed! port 10)
+                     port))
                   ;; TODO: Verify open-flags.
                   ((? integer?) ((fd->current-port target)))
                   (#f #f))))
@@ -213,6 +221,7 @@ if it is our responsibility to close the port."
      (make-processed-redir fd #f))
     (('<< (? integer? fd) text)
      (let ((port (tmpfile)))
+       (set-port-revealed! port 10)
        (display text port)
        (seek port 0 SEEK_SET)
        (make-processed-redir fd port)))))
@@ -264,6 +273,7 @@ process."
          (lambda () #t)
          (lambda ()
            (restore-signals)
+           (gc)
            (set-atexit! #f)
            ;; We need to preserve the status given to 'exit', so we
            ;; catch the 'quit' key here.
diff --git a/scripts/gash.in b/scripts/gash.in
index f851c1d..57506ba 100644
--- a/scripts/gash.in
+++ b/scripts/gash.in
@@ -21,5 +21,13 @@
 ;;; along with Gash.  If not, see <http://www.gnu.org/licenses/>.
 
 (define (main args)
+  ;; Reserve file descriptors 5 to 12 (roughly) before the signal and
+  ;; finalization threads grab them so that a script willing to use
+  ;; them can do so without breaking Guile.
+  (let loop ((i 3))
+    (when (<= i 10)
+      (open-fdes "/dev/null" (logior O_RDONLY O_CLOEXEC))
+      (loop (+ i 1))))
+
   (setenv "SHELL" ((compose canonicalize-path car command-line)))
-  ((@ (gash gash) main) (command-line)))
+  ((module-ref (resolve-interface '(gash gash)) 'main) (command-line)))

Previous Next

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