From d50c1eee6e446d385357f4d7079d700ed3275d74 Mon Sep 17 00:00:00 2001 From: simonmar 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 fa10b4c..d4bc43f 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 3348306..36b0f24 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 0a69421..a0c2453 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; } -- 1.7.10.4