X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FProcess.hs;h=f2e937eec455d0777478abf1ce8aafc463b24aa7;hb=1da40dc4745cb83dec6c2a41ec944b2084902266;hp=51fd2c3e4e308470ea55372a4a4a1bf37b9be04a;hpb=b0968b64c77ee590c277c2986a630d3ba97dacff;p=haskell-directory.git

diff --git a/System/Process.hs b/System/Process.hs
index 51fd2c3..f2e937e 100644
--- a/System/Process.hs
+++ b/System/Process.hs
@@ -51,7 +51,7 @@ import System.Process.Internals
 
 import Foreign
 import Foreign.C 
-import System.IO 	( IOMode(..), Handle )
+import System.IO 	( IOMode(..), Handle, hClose )
 import System.Exit	( ExitCode(..) )
 
 import System.Posix.Internals
@@ -81,10 +81,11 @@ runCommand string = do
 
 {- | Runs a raw command, optionally specifying 'Handle's from which to
      take the @stdin@, @stdout@ and @stderr@ channels for the new
-     process.  
+     process (otherwise these handles are inherited from the current
+     process).
 
      Any 'Handle's passed to 'runProcess' are placed immediately in the 
-     closed state, so may no longer be referenced by the Haskell process.
+     closed state.
 -}
 runProcess
   :: FilePath			-- ^ Filename of the executable
@@ -96,19 +97,19 @@ runProcess
   -> Maybe Handle		-- ^ Handle to use for @stderr@
   -> IO ProcessHandle
 
+runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
-
-runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
- = runProcessPosix "runProcess" cmd args mb_cwd mb_env 
+  h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env 
 	mb_stdin mb_stdout mb_stderr
 	Nothing Nothing
-
 #else
-
-runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr =
-  runProcessWin32 "runProcess" cmd args mb_cwd mb_env 
+  h <- runProcessWin32 "runProcess" cmd args mb_cwd mb_env 
 	mb_stdin mb_stdout mb_stderr ""
 #endif
+  maybe (return ()) hClose mb_stdin
+  maybe (return ()) hClose mb_stdout
+  maybe (return ()) hClose mb_stderr
+  return h
 
 -- ----------------------------------------------------------------------------
 -- runInteractiveCommand
@@ -167,7 +168,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 +203,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
@@ -228,18 +230,31 @@ fdToHandle pfd mode = do
 
 {- | Waits for the specified process to terminate, and returns its exit code.
    
-     GHC Note: in order to call waitForProcess without blocking all the
+     GHC Note: in order to call @waitForProcess@ without blocking all the
      other threads in the system, you must compile the program with
      @-threaded@.
 -}
 waitForProcess
   :: ProcessHandle
   -> IO ExitCode
-waitForProcess (ProcessHandle handle) = do
-  code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
-  if (code == 0) 
-    then return ExitSuccess
-    else return (ExitFailure (fromIntegral code))
+waitForProcess ph = do
+  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
@@ -253,25 +268,43 @@ 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) =
-  throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
+terminateProcess ph = do
+  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
 
-{- | Verifies whether the process is completed and if it is then returns the exit code.
-   If the process is still running the function returns Nothing
+{- | 
+This is a non-blocking version of 'waitForProcess'.  If the process is
+still running, 'Nothing' is returned.  If the process has exited, then
+@'Just' e@ is returned where @e@ is the exit code of the process.
+Subsequent calls to @getProcessExitStatus@ always return @'Just'
+'ExitSuccess'@, regardless of what the original exit code was.
 -}
 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
-getProcessExitCode (ProcessHandle handle) =
-  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)))
+getProcessExitCode ph = do
+  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