diff --git a/System/Process.hs b/System/Process.hs index fa10b4c8c7e8343736d70f3ca352c54fb07003c8..d4bc43f7717fb9572d6491902e690bd173577b31 100644 --- a/System/Process.hs +++ b/System/Process.hs @@ -167,7 +167,8 @@ runInteractiveProcess1 fun cmd args mb_cwd mb_env = do hndStdInput <- fdToHandle pfdStdInput WriteMode hndStdOutput <- fdToHandle pfdStdOutput ReadMode hndStdError <- fdToHandle pfdStdError ReadMode - return (hndStdInput, hndStdOutput, hndStdError, ProcessHandle proc_handle) + ph <- mkProcessHandle proc_handle + return (hndStdInput, hndStdOutput, hndStdError, ph) foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess @@ -201,8 +202,8 @@ runInteractiveProcess1 fun cmd args workDir env extra_cmdline hndStdInput <- fdToHandle pfdStdInput WriteMode hndStdOutput <- fdToHandle pfdStdOutput ReadMode hndStdError <- fdToHandle pfdStdError ReadMode - return (hndStdInput, hndStdOutput, hndStdError, - ProcessHandle proc_handle) + ph <- mkProcessHandle proc_handle + return (hndStdInput, hndStdOutput, hndStdError, ph) foreign import ccall unsafe "runInteractiveProcess" c_runInteractiveProcess @@ -235,7 +236,8 @@ fdToHandle pfd mode = do waitForProcess :: ProcessHandle -> IO ExitCode -waitForProcess (ProcessHandle handle) = do +waitForProcess ph = do + handle <- getProcessHandle ph code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle) if (code == 0) then return ExitSuccess @@ -253,7 +255,8 @@ waitForProcess (ProcessHandle handle) = do -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing -- an exit code of 1. terminateProcess :: ProcessHandle -> IO () -terminateProcess (ProcessHandle pid) = +terminateProcess ph = do + pid <- getProcessHandle ph throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid) -- ---------------------------------------------------------------------------- @@ -267,7 +270,8 @@ Subsequent calls to @getProcessExitStatus@ always return @'Just' 'ExitSuccess'@, regardless of what the original exit code was. -} getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) -getProcessExitCode (ProcessHandle handle) = +getProcessExitCode ph = do + handle <- getProcessHandle ph alloca $ \pExitCode -> do res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode) code <- peek pExitCode diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs index 33483066d9f807fbc883a3151e615a77977b2569..36b0f24b48772691d1fe9b0acd142c31b4a8e464 100644 --- a/System/Process/Internals.hs +++ b/System/Process/Internals.hs @@ -15,7 +15,7 @@ -- #hide module System.Process.Internals ( - ProcessHandle(..), PHANDLE, + ProcessHandle(..), PHANDLE, getProcessHandle, mkProcessHandle, #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) pPrPr_disableITimers, c_execvpe, # ifdef __GLASGOW_HASKELL__ @@ -40,6 +40,7 @@ import System.Posix.Types ( CPid ) import System.IO ( Handle ) #else import Data.Word ( Word32 ) +import Data.IORef #endif import Data.Maybe ( fromMaybe ) @@ -81,13 +82,39 @@ import System.Directory.Internals ( parseSearchPath, joinFileName ) to wait for the process later. -} #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) + #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) + +foreign import stdcall unsafe "CloseHandle" + c_CloseHandle + :: PHANDLE + -> IO () #endif -newtype ProcessHandle = ProcessHandle PHANDLE - -- ---------------------------------------------------------------------------- #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) @@ -145,7 +172,7 @@ runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr c_runProcess pargs pWorkDir pEnv fd_stdin fd_stdout fd_stderr set_int inthand set_quit quithand - return (ProcessHandle ph) + mkProcessHandle ph foreign import ccall unsafe "runProcess" c_runProcess @@ -187,7 +214,7 @@ runProcessWin32 fun cmd args mb_cwd mb_env proc_handle <- throwErrnoIfMinus1 fun (c_runProcess pcmdline pWorkDir pEnv fd_stdin fd_stdout fd_stderr) - return (ProcessHandle proc_handle) + mkProcessHandle proc_handle foreign import ccall unsafe "runProcess" c_runProcess diff --git a/cbits/runProcess.c b/cbits/runProcess.c index 0a69421e630ee6391c48566790b66f579f580998..a0c2453b2e0dfa4520c020539e112b3d99a718e6 100644 --- a/cbits/runProcess.c +++ b/cbits/runProcess.c @@ -518,8 +518,6 @@ terminateProcess (ProcHandle handle) maperrno(); return -1; } - - CloseHandle((HANDLE) handle); return 0; } @@ -535,8 +533,6 @@ getProcessExitCode (ProcHandle handle, int *pExitCode) maperrno(); return -1; } - - CloseHandle((HANDLE) handle); return 1; } @@ -555,8 +551,6 @@ waitForProcess (ProcHandle handle) maperrno(); return -1; } - - CloseHandle((HANDLE) handle); return retCode; }