attempt to work around restrictions with fork() & pthreads

In the child process, call exec() directly instead of using
System.Cmd.system, which involves another fork()/exec() and a
non-blocking wait.  The problem is that in a forked child of a
threaded process, it isn't safe to do much except exec() according to
POSIX.  In fact calling pthread_create() in the child causes the
pthread library to fail with an error on FreeBSD.

1 files changed, 12 insertions, 5 deletions

diff --git a/testsuite/timeout/timeout.hs b/testsuite/timeout/timeout.hs
index d0c66b1a72..81f3ab485e 100644
--- a/testsuite/timeout/timeout.hs
+++ b/testsuite/timeout/timeout.hs
@@ -12,7 +12,7 @@ import System.Process
 import Control.Monad (when)

 #if !defined(mingw32_HOST_OS)

 import System.Process.Internals (mkProcessHandle)

-import System.Posix.Process (forkProcess, createSession)

+import System.Posix.Process (forkProcess, createSession, executeFile)

 import System.Posix.Signals (installHandler, Handler(Catch),

                              signalProcessGroup, sigINT, sigTERM, sigKILL )

 #endif

@@ -30,10 +30,7 @@ main = do
         forkIO (do threadDelay (read secs * 1000000)

                    putMVar m Nothing

                )

-        forkIO (do try (do pid <- forkProcess $ do

-                               createSession

-                               r <- system cmd

-                               exitWith r

+        forkIO (do try (do pid <- systemSession cmd

 			   ph <- mkProcessHandle pid

                            putMVar mp (pid,ph)

                            r <- waitForProcess ph

@@ -51,6 +48,16 @@ main = do
     _other -> do hPutStrLn stderr "timeout: bad arguments"

                  exitWith (ExitFailure 1)

 

+systemSession cmd =  

+ forkProcess $ do

+   createSession

+   executeFile "/bin/sh" False ["-c", cmd] Nothing

+   -- need to use exec() directly here, rather than something like

+   -- System.Process.system, because we are in a forked child and some

+   -- pthread libraries get all upset if you start doing certain

+   -- things in a forked child of a pthread process, such as forking

+   -- more threads.

+

 killProcess pid ph = do

   try (signalProcessGroup sigTERM pid)

   checkReallyDead 10