From d50c1eee6e446d385357f4d7079d700ed3275d74 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Fri, 11 Nov 2005 12:01:58 +0000
Subject: [PATCH] [project @ 2005-11-11 12:01:58 by simonmar] On Windows,
attach a finalizer to the ProcessHandle so that we can call CloseHandle()
when the handle is no longer in use. Previously we were calling
CloseHandle() in waitForProcess and terminateProcess, which prevented making
multiple calls to these functions on the same handle.
---
System/Process.hs | 16 ++++++++++------
System/Process/Internals.hs | 37 ++++++++++++++++++++++++++++++++-----
cbits/runProcess.c | 6 ------
3 files changed, 42 insertions(+), 17 deletions(-)
diff --git a/System/Process.hs b/System/Process.hs
index fa10b4c8..d4bc43f7 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 33483066..36b0f24b 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 0a69421e..a0c2453b 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;
}
--
GitLab