forkProcess does not acquire global handle locks
The global I/O handles (stdout
, stdin
, stderr
) all make use an MVar
wrapping a Handle__
, and many I/O functions temporarily take this MVar
(for instance, functions such as hPutStr
include a call to wantWritableHandle
, which uses withHandle_'
, which involves taking the MVar
, executing some operation, and then putting the MVar
back).
Suppose we have a program consisting of two threads A and B, where thread A is doing I/O. If thread B does a call to forkProcess
then it is possible that the fork()
happens at the point that A has just taken, say, the MVar
for stdout
. If this happens, every use of stdout
in the child process will now forever deadlock.
This is not a theoretical scenario. The example code reported by Michael Snoyman a few years ago
http://www.haskell.org/pipermail/haskell-cafe/2012-October/103922.html
exhibits precisely this behaviour: the child process deadlocks (not all the the time, but very frequently), exactly because of this problem.
In forkProcess
we avoid this sort of situation for all of the global RTS locks by acquiring the lock just before the call to fork()
, and then releasing the lock in the parent again and re-initializing the lock in the child. But there are no provisions for Haskell-land locks such as the above MVar
.
In principle we can work around this problem entirely in user-land. Here is a modified version of Michael's code that does not deadlock (at least, it never has in my tests..), that basically takes the same acquire-release*2 trick that forkProcess
does for RTS locks in the lines marked (*)
:
import System.Posix.Process (forkProcess, getProcessID)
import Control.Concurrent (forkIO, threadDelay)
import System.IO (hFlush, stdout)
import System.Posix.Signals (signalProcess, sigKILL)
import Control.Exception (finally)
import Control.Concurrent
import GHC.IO.Handle.Types
import System.IO
main :: IO ()
main = do
mapM_ spawnChild [1..9]
ioLock <- lockIO -- (*)
child <- forkProcess $ do
unlockIO ioLock -- (*)
putStrLn "starting child"
hFlush stdout
loop "child" 0
unlockIO ioLock -- (*)
print ("child pid", child)
hFlush stdout
-- I've commented out the "finally" so that the zombie process stays alive,
-- to prove that it was actually created.
loop "parent" 0 -- `finally` signalProcess sigKILL child
spawnChild :: Int -> IO ()
spawnChild i = do
_ <- forkIO $ loop ("spawnChild " ++ show i) 0
return ()
loop :: String -> Int -> IO ()
loop msg i = do
pid <- getProcessID
print (pid, msg, i)
hFlush stdout
threadDelay 1000000
loop msg (i + 1)
--------------------------------------------------------------------------------
lockIO :: IO Handle__
lockIO =
case stdout of
FileHandle _ m -> takeMVar m
unlockIO :: Handle__ -> IO ()
unlockIO hout =
case stdout of
FileHandle _ m -> putMVar m hout
I guess that any global MVar
or TVar
is suspect when using forkProcess
.
Trac metadata
Trac field | Value |
---|---|
Version | 7.8.2 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |