:: ProcessHandle
-> IO ExitCode
waitForProcess ph = do
- handle <- getProcessHandle ph
- code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
- if (code == 0)
- then return ExitSuccess
- else return (ExitFailure (fromIntegral code))
+ p_ <- withProcessHandle ph $ \p_ -> return (p_,p_)
+ case p_ of
+ ClosedHandle e -> return e
+ OpenHandle h -> do
+ -- don't hold the MVar while we call c_waitForProcess...
+ -- (XXX but there's a small race window here during which another
+ -- thread could close the handle or call waitForProcess)
+ code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess h)
+ withProcessHandle ph $ \p_ ->
+ case p_ of
+ ClosedHandle e -> return (p_,e)
+ OpenHandle ph -> do
+ closePHANDLE ph
+ let e = if (code == 0)
+ then ExitSuccess
+ else (ExitFailure (fromIntegral code))
+ return (ClosedHandle e, e)
-- ----------------------------------------------------------------------------
-- terminateProcess
-- an exit code of 1.
terminateProcess :: ProcessHandle -> IO ()
terminateProcess ph = do
- pid <- getProcessHandle ph
- throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
+ withProcessHandle_ ph $ \p_ ->
+ case p_ of
+ ClosedHandle _ -> return p_
+ OpenHandle h -> do
+ throwErrnoIfMinus1_ "terminateProcess" $ c_terminateProcess h
+ return p_
+ -- does not close the handle, we might want to try terminating it
+ -- again, or get its exit code.
-- ----------------------------------------------------------------------------
-- getProcessExitCode
-}
getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
getProcessExitCode ph = do
- handle <- getProcessHandle ph
- alloca $ \pExitCode -> do
- res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
- code <- peek pExitCode
- if res == 0
- then return Nothing
- else if code == 0
- then return (Just ExitSuccess)
- else return (Just (ExitFailure (fromIntegral code)))
+ withProcessHandle ph $ \p_ ->
+ case p_ of
+ ClosedHandle e -> return (p_, Just e)
+ OpenHandle h ->
+ alloca $ \pExitCode -> do
+ res <- throwErrnoIfMinus1 "getProcessExitCode" $
+ c_getProcessExitCode h pExitCode
+ code <- peek pExitCode
+ if res == 0
+ then return (p_, Nothing)
+ else do
+ closePHANDLE h
+ let e | code == 0 = ExitSuccess
+ | otherwise = ExitFailure (fromIntegral code)
+ return (ClosedHandle e, Just e)
-- ----------------------------------------------------------------------------
-- Interface to C bits
-- #hide
module System.Process.Internals (
- ProcessHandle(..), PHANDLE, getProcessHandle, mkProcessHandle,
+ ProcessHandle(..), ProcessHandle__(..),
+ PHANDLE, closePHANDLE, mkProcessHandle,
+ withProcessHandle, withProcessHandle_,
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
pPrPr_disableITimers, c_execvpe,
# ifdef __GLASGOW_HASKELL__
import Data.IORef
#endif
+import System.Exit ( ExitCode )
import Data.Maybe ( fromMaybe )
# ifdef __GLASGOW_HASKELL__
import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) )
import Hugs.Exception ( Exception(..), IOException(..) )
# endif
+import Control.Concurrent
import Control.Exception ( handle, throwIO )
import Foreign.C
import Foreign
termination: they all return a 'ProcessHandle' which may be used
to wait for the process later.
-}
+data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode
+newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__)
+
+withProcessHandle
+ :: ProcessHandle
+ -> (ProcessHandle__ -> IO (ProcessHandle__, a))
+ -> IO a
+withProcessHandle (ProcessHandle m) io = modifyMVar m io
+
+withProcessHandle_
+ :: ProcessHandle
+ -> (ProcessHandle__ -> IO ProcessHandle__)
+ -> IO ()
+withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io
+
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
type PHANDLE = CPid
-newtype ProcessHandle = ProcessHandle PHANDLE
-
-getProcessHandle :: ProcessHandle -> IO PHANDLE
-getProcessHandle (ProcessHandle p) = return p
mkProcessHandle :: PHANDLE -> IO ProcessHandle
-mkProcessHandle p = return (ProcessHandle p)
+mkProcessHandle p = do
+ m <- newMVar (OpenHandle p)
+ return (ProcessHandle m)
+
+closePHANDLE :: PHANDLE -> IO ()
+closePHANDLE _ = return ()
#else
type PHANDLE = Word32
-newtype ProcessHandle = ProcessHandle (IORef PHANDLE)
-
-getProcessHandle :: ProcessHandle -> IO PHANDLE
-getProcessHandle (ProcessHandle ior) = readIORef ior
-- On Windows, we have to close this HANDLE when it is no longer required,
-- hence we add a finalizer to it, using an IORef as the box on which to
-- attach the finalizer.
mkProcessHandle :: PHANDLE -> IO ProcessHandle
mkProcessHandle h = do
- ioref <- newIORef h
- mkWeakIORef ioref (c_CloseHandle h)
- return (ProcessHandle ioref)
+ m <- newMVar (OpenHandle h)
+ addMVarFinalizer m (processHandleFinaliser m)
+ return (ProcessHandle m)
+
+processHandleFinaliser m =
+ modifyMVar_ m $ \p_ -> do
+ case p_ of
+ OpenHandle ph -> closePHANDLE ph
+ _ -> return ()
+ return (error "closed process handle")
+
+closePHANDLE :: PHANDLE -> IO ()
+closePHANDLE ph = c_CloseHandle ph
foreign import stdcall unsafe "CloseHandle"
c_CloseHandle