{-# OPTIONS_GHC -cpp -fffi #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Process
-- Copyright   :  (c) The University of Glasgow 2004
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  [email protected]
-- Stability   :  experimental
-- Portability :  portable
--
-- Operations for creating and interacting with sub-processes.
--
-- For a simpler, but less powerful, interface, see the "System.Cmd" module.
--
-----------------------------------------------------------------------------

-- ToDo:
--	* Flag to control whether exiting the parent also kills the child.
-- 	* Windows impl of runProcess should close the Handles.
--      * Add system/rawSystem replacements

{- NOTES on createPipe:
 
   createPipe is no longer exported, because of the following problems:

	- it wasn't used to implement runInteractiveProcess on Unix, because
	  the file descriptors for the unused ends of the pipe need to be closed
	  in the child process.

        - on Windows, a special version of createPipe is needed that sets
	  the inheritance flags correctly on the ends of the pipe (see
	  mkAnonPipe below).
-}

module System.Process (
	-- * Running sub-processes
	ProcessHandle,
	runCommand,
	runProcess,
	runInteractiveCommand,
	runInteractiveProcess,

	-- * Process completion
	waitForProcess,
	getProcessExitCode,
	terminateProcess,
 ) where

import Prelude

import System.Process.Internals

import Foreign
import Foreign.C 
import System.IO 	( IOMode(..), Handle, hClose )
import System.Exit	( ExitCode(..) )

import System.Posix.Internals
import GHC.IOBase	( FD )
import GHC.Handle 	( fdToHandle' )

-- ----------------------------------------------------------------------------
-- runCommand

{- | Runs a command using the shell.
 -}
runCommand
  :: String
  -> IO ProcessHandle

runCommand string = do
  (cmd,args) <- commandToProcess string
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
  runProcessPosix "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing
	Nothing Nothing
#else
  runProcessWin32 "runCommand" cmd [] Nothing Nothing Nothing Nothing Nothing args
#endif

-- ----------------------------------------------------------------------------
-- runProcess

{- | Runs a raw command, optionally specifying 'Handle's from which to
     take the @stdin@, @stdout@ and @stderr@ channels for the new
     process (otherwise these handles are inherited from the current
     process).

     Any 'Handle's passed to 'runProcess' are placed immediately in the 
     closed state.
-}
runProcess
  :: FilePath			-- ^ Filename of the executable
  -> [String]			-- ^ Arguments to pass to the executable
  -> Maybe FilePath		-- ^ Optional path to the working directory
  -> Maybe [(String,String)]	-- ^ Optional environment (otherwise inherit)
  -> Maybe Handle		-- ^ Handle to use for @stdin@
  -> Maybe Handle		-- ^ Handle to use for @stdout@
  -> 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__)
  h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env 
	mb_stdin mb_stdout mb_stderr
	Nothing Nothing
#else
  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

{- | Runs a command using the shell, and returns 'Handle's that may
     be used to communicate with the process via its @stdin@, @stdout@,
     and @stderr@ respectively.
-}
runInteractiveCommand
  :: String
  -> IO (Handle,Handle,Handle,ProcessHandle)

runInteractiveCommand string = do
  (cmd,args) <- commandToProcess string
#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
  runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing
#else
  runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args
#endif

-- ----------------------------------------------------------------------------
-- runInteractiveProcess

{- | Runs a raw command, and returns 'Handle's that may be used to communicate
     with the process via its @stdin@, @stdout@ and @stderr@ respectively.

    For example, to start a process and feed a string to its stdin:
   
>   (inp,out,err,pid) <- runInteractiveProcess "..."
>   forkIO (hPutStr inp str)
-}
runInteractiveProcess
  :: FilePath			-- ^ Filename of the executable
  -> [String]			-- ^ Arguments to pass to the executable
  -> Maybe FilePath		-- ^ Optional path to the working directory
  -> Maybe [(String,String)]	-- ^ Optional environment (otherwise inherit)
  -> IO (Handle,Handle,Handle,ProcessHandle)

#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)

runInteractiveProcess cmd args mb_cwd mb_env = 
  runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env

runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
  withFilePathException cmd $
   alloca $ \ pfdStdInput  ->
   alloca $ \ pfdStdOutput ->
   alloca $ \ pfdStdError  ->
   maybeWith withCEnvironment mb_env $ \pEnv ->
   maybeWith withCString mb_cwd $ \pWorkDir ->
   withMany withCString (cmd:args) $ \cstrs ->
   withArray0 nullPtr cstrs $ \pargs -> do
     proc_handle <- throwErrnoIfMinus1 fun
	                  (c_runInteractiveProcess pargs pWorkDir pEnv 
				pfdStdInput pfdStdOutput pfdStdError)
     hndStdInput  <- fdToHandle pfdStdInput  WriteMode
     hndStdOutput <- fdToHandle pfdStdOutput ReadMode
     hndStdError  <- fdToHandle pfdStdError  ReadMode
     ph <- mkProcessHandle proc_handle
     return (hndStdInput, hndStdOutput, hndStdError, ph)

foreign import ccall unsafe "runInteractiveProcess" 
  c_runInteractiveProcess
        ::  Ptr CString
	-> CString
        -> Ptr CString
        -> Ptr FD
        -> Ptr FD
        -> Ptr FD
        -> IO PHANDLE

#else

runInteractiveProcess cmd args mb_cwd mb_env = 
  runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""

runInteractiveProcess1 fun cmd args workDir env extra_cmdline
 = withFilePathException cmd $ do
     let cmdline = translate cmd ++ 
  		       concat (map ((' ':) . translate) args) ++
  		       (if null extra_cmdline then "" else ' ':extra_cmdline)
     withCString cmdline $ \pcmdline ->
      alloca $ \ pfdStdInput  ->
      alloca $ \ pfdStdOutput ->
      alloca $ \ pfdStdError  -> do
      maybeWith withCEnvironment env $ \pEnv -> do
      maybeWith withCString workDir $ \pWorkDir -> do
  	proc_handle <- throwErrnoIfMinus1 fun $
  			     c_runInteractiveProcess pcmdline pWorkDir pEnv
				  pfdStdInput pfdStdOutput pfdStdError
  	hndStdInput  <- fdToHandle pfdStdInput  WriteMode
  	hndStdOutput <- fdToHandle pfdStdOutput ReadMode
  	hndStdError  <- fdToHandle pfdStdError  ReadMode
	ph <- mkProcessHandle proc_handle
  	return (hndStdInput, hndStdOutput, hndStdError, ph)

foreign import ccall unsafe "runInteractiveProcess" 
  c_runInteractiveProcess
        :: CString 
        -> CString
        -> Ptr ()
        -> Ptr FD
        -> Ptr FD
        -> Ptr FD
        -> IO PHANDLE

#endif

fdToHandle :: Ptr FD -> IOMode -> IO Handle
fdToHandle pfd mode = do
  fd <- peek pfd
  fdToHandle' fd (Just (Stream,0,0))
     False{-not a socket-}
     ("fd:" ++ show fd) mode True{-binary-}

-- ----------------------------------------------------------------------------
-- waitForProcess

{- | Waits for the specified process to terminate, and returns its exit code.
   
     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 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

-- | Attempts to terminate the specified process.  This function should
-- not be used under normal circumstances - no guarantees are given regarding
-- how cleanly the process is terminated.  To check whether the process
-- has indeed terminated, use 'getProcessExitCode'.
--
-- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
-- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
-- an exit code of 1.
terminateProcess :: ProcessHandle -> IO ()
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

{- | 
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 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

foreign import ccall unsafe "terminateProcess"
  c_terminateProcess
	:: PHANDLE
	-> IO CInt

foreign import ccall unsafe "getProcessExitCode"
  c_getProcessExitCode
	:: PHANDLE
	-> Ptr CInt
	-> IO CInt

foreign import ccall safe "waitForProcess" -- NB. safe - can block
  c_waitForProcess
	:: PHANDLE
	-> IO CInt