System/Process.hs

   1 {-# OPTIONS_GHC -cpp -fffi #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  System.Process
   5 -- Copyright   :  (c) The University of Glasgow 2004
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  experimental
  10 -- Portability :  portable
  11 --
  12 -- Operations for creating and interacting with sub-processes.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 -- ToDo:
  17 --      * Flag to control whether exiting the parent also kills the child.
  18 --      * Windows impl of runProcess should close the Handles.
  19 --      * Add system/rawSystem replacements
  20
  21 {- NOTES on createPipe:
  22
  23    createPipe is no longer exported, because of the following problems:
  24
  25         - it wasn't used to implement runInteractiveProcess on Unix, because
  26           the file descriptors for the unused ends of the pipe need to be closed
  27           in the child process.
  28
  29         - on Windows, a special version of createPipe is needed that sets
  30           the inheritance flags correctly on the ends of the pipe (see
  31           mkAnonPipe below).
  32 -}
  33
  34 module System.Process (
  35         -- * Running sub-processes
  36         ProcessHandle,
  37         runCommand,
  38         runProcess,
  39         runInteractiveCommand,
  40         runInteractiveProcess,
  41
  42         -- * Process completion
  43         waitForProcess,
  44         getProcessExitCode,
  45         terminateProcess,
  46  ) where
  47
  48 import Prelude
  49
  50 import System.Process.Internals
  51
  52 import Foreign
  53 import Foreign.C
  54 import System.IO        ( IOMode(..), Handle, hClose )
  55 import System.Exit      ( ExitCode(..) )
  56
  57 import System.Posix.Internals
  58 import GHC.IOBase       ( FD )
  59 import GHC.Handle       ( openFd )
  60
  61 -- ----------------------------------------------------------------------------
  62 -- runCommand
  63
  64 {- | Runs a command using the shell.
  65  -}
  66 runCommand
  67   :: String
  68   -> IO ProcessHandle
  69
  70 runCommand string = do
  71   (cmd,args) <- commandToProcess string
  72 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
  73   runProcessPosix "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing
  74         Nothing Nothing
  75 #else
  76   runProcessWin32 "runCommand" cmd [] Nothing Nothing Nothing Nothing Nothing args
  77 #endif
  78
  79 -- ----------------------------------------------------------------------------
  80 -- runProcess
  81
  82 {- | Runs a raw command, optionally specifying 'Handle's from which to
  83      take the @stdin@, @stdout@ and @stderr@ channels for the new
  84      process (otherwise these handles are inherited from the current
  85      process).
  86
  87      Any 'Handle's passed to 'runProcess' are placed immediately in the
  88      closed state.
  89 -}
  90 runProcess
  91   :: FilePath                   -- ^ Filename of the executable
  92   -> [String]                   -- ^ Arguments to pass to the executable
  93   -> Maybe FilePath             -- ^ Optional path to the working directory
  94   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
  95   -> Maybe Handle               -- ^ Handle to use for @stdin@
  96   -> Maybe Handle               -- ^ Handle to use for @stdout@
  97   -> Maybe Handle               -- ^ Handle to use for @stderr@
  98   -> IO ProcessHandle
  99
 100 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
 101 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 102   h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env
 103         mb_stdin mb_stdout mb_stderr
 104         Nothing Nothing
 105 #else
 106   h <- runProcessWin32 "runProcess" cmd args mb_cwd mb_env
 107         mb_stdin mb_stdout mb_stderr ""
 108 #endif
 109   maybe (return ()) hClose mb_stdin
 110   maybe (return ()) hClose mb_stdout
 111   maybe (return ()) hClose mb_stderr
 112   return h
 113
 114 -- ----------------------------------------------------------------------------
 115 -- runInteractiveCommand
 116
 117 {- | Runs a command using the shell, and returns 'Handle's that may
 118      be used to communicate with the process via its @stdin@, @stdout@,
 119      and @stderr@ respectively.
 120 -}
 121 runInteractiveCommand
 122   :: String
 123   -> IO (Handle,Handle,Handle,ProcessHandle)
 124
 125 runInteractiveCommand string = do
 126   (cmd,args) <- commandToProcess string
 127 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 128   runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing
 129 #else
 130   runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args
 131 #endif
 132
 133 -- ----------------------------------------------------------------------------
 134 -- runInteractiveProcess
 135
 136 {- | Runs a raw command, and returns 'Handle's that may be used to communicate
 137      with the process via its @stdin@, @stdout@ and @stderr@ respectively.
 138
 139     For example, to start a process and feed a string to its stdin:
 140
 141 >   (inp,out,err,pid) <- runInteractiveProcess "..."
 142 >   forkIO (hPutStr inp str)
 143 -}
 144 runInteractiveProcess
 145   :: FilePath                   -- ^ Filename of the executable
 146   -> [String]                   -- ^ Arguments to pass to the executable
 147   -> Maybe FilePath             -- ^ Optional path to the working directory
 148   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
 149   -> IO (Handle,Handle,Handle,ProcessHandle)
 150
 151 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 152
 153 runInteractiveProcess cmd args mb_cwd mb_env =
 154   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env
 155
 156 runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
 157   withFilePathException cmd $
 158    alloca $ \ pfdStdInput  ->
 159    alloca $ \ pfdStdOutput ->
 160    alloca $ \ pfdStdError  ->
 161    maybeWith withCEnvironment mb_env $ \pEnv ->
 162    maybeWith withCString mb_cwd $ \pWorkDir ->
 163    withMany withCString (cmd:args) $ \cstrs ->
 164    withArray0 nullPtr cstrs $ \pargs -> do
 165      proc_handle <- throwErrnoIfMinus1 fun
 166                           (c_runInteractiveProcess pargs pWorkDir pEnv
 167                                 pfdStdInput pfdStdOutput pfdStdError)
 168      hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 169      hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 170      hndStdError  <- fdToHandle pfdStdError  ReadMode
 171      ph <- mkProcessHandle proc_handle
 172      return (hndStdInput, hndStdOutput, hndStdError, ph)
 173
 174 foreign import ccall unsafe "runInteractiveProcess"
 175   c_runInteractiveProcess
 176         ::  Ptr CString
 177         -> CString
 178         -> Ptr CString
 179         -> Ptr FD
 180         -> Ptr FD
 181         -> Ptr FD
 182         -> IO PHANDLE
 183
 184 #else
 185
 186 runInteractiveProcess cmd args mb_cwd mb_env =
 187   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""
 188
 189 runInteractiveProcess1 fun cmd args workDir env extra_cmdline
 190  = withFilePathException cmd $ do
 191      let cmdline = translate cmd ++
 192                        concat (map ((' ':) . translate) args) ++
 193                        (if null extra_cmdline then "" else ' ':extra_cmdline)
 194      withCString cmdline $ \pcmdline ->
 195       alloca $ \ pfdStdInput  ->
 196       alloca $ \ pfdStdOutput ->
 197       alloca $ \ pfdStdError  -> do
 198       maybeWith withCEnvironment env $ \pEnv -> do
 199       maybeWith withCString workDir $ \pWorkDir -> do
 200         proc_handle <- throwErrnoIfMinus1 fun $
 201                              c_runInteractiveProcess pcmdline pWorkDir pEnv
 202                                   pfdStdInput pfdStdOutput pfdStdError
 203         hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 204         hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 205         hndStdError  <- fdToHandle pfdStdError  ReadMode
 206         ph <- mkProcessHandle proc_handle
 207         return (hndStdInput, hndStdOutput, hndStdError, ph)
 208
 209 foreign import ccall unsafe "runInteractiveProcess"
 210   c_runInteractiveProcess
 211         :: CString
 212         -> CString
 213         -> Ptr ()
 214         -> Ptr FD
 215         -> Ptr FD
 216         -> Ptr FD
 217         -> IO PHANDLE
 218
 219 #endif
 220
 221 fdToHandle :: Ptr FD -> IOMode -> IO Handle
 222 fdToHandle pfd mode = do
 223   fd <- peek pfd
 224   openFd fd (Just Stream)
 225      False{-not a socket-}
 226      ("fd:" ++ show fd) mode True{-binary-}
 227
 228 -- ----------------------------------------------------------------------------
 229 -- waitForProcess
 230
 231 {- | Waits for the specified process to terminate, and returns its exit code.
 232
 233      GHC Note: in order to call @waitForProcess@ without blocking all the
 234      other threads in the system, you must compile the program with
 235      @-threaded@.
 236 -}
 237 waitForProcess
 238   :: ProcessHandle
 239   -> IO ExitCode
 240 waitForProcess ph = do
 241   p_ <- withProcessHandle ph $ \p_ -> return (p_,p_)
 242   case p_ of
 243     ClosedHandle e -> return e
 244     OpenHandle h  -> do
 245         -- don't hold the MVar while we call c_waitForProcess...
 246         -- (XXX but there's a small race window here during which another
 247         -- thread could close the handle or call waitForProcess)
 248         code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess h)
 249         withProcessHandle ph $ \p_ ->
 250           case p_ of
 251             ClosedHandle e -> return (p_,e)
 252             OpenHandle ph  -> do
 253               closePHANDLE ph
 254               let e = if (code == 0)
 255                    then ExitSuccess
 256                    else (ExitFailure (fromIntegral code))
 257               return (ClosedHandle e, e)
 258
 259 -- ----------------------------------------------------------------------------
 260 -- terminateProcess
 261
 262 -- | Attempts to terminate the specified process.  This function should
 263 -- not be used under normal circumstances - no guarantees are given regarding
 264 -- how cleanly the process is terminated.  To check whether the process
 265 -- has indeed terminated, use 'getProcessExitCode'.
 266 --
 267 -- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
 268 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
 269 -- an exit code of 1.
 270 terminateProcess :: ProcessHandle -> IO ()
 271 terminateProcess ph = do
 272   withProcessHandle_ ph $ \p_ ->
 273     case p_ of
 274       ClosedHandle _ -> return p_
 275       OpenHandle h -> do
 276         throwErrnoIfMinus1_ "terminateProcess" $ c_terminateProcess h
 277         return p_
 278         -- does not close the handle, we might want to try terminating it
 279         -- again, or get its exit code.
 280
 281 -- ----------------------------------------------------------------------------
 282 -- getProcessExitCode
 283
 284 {- |
 285 This is a non-blocking version of 'waitForProcess'.  If the process is
 286 still running, 'Nothing' is returned.  If the process has exited, then
 287 @'Just' e@ is returned where @e@ is the exit code of the process.
 288 Subsequent calls to @getProcessExitStatus@ always return @'Just'
 289 'ExitSuccess'@, regardless of what the original exit code was.
 290 -}
 291 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
 292 getProcessExitCode ph = do
 293   withProcessHandle ph $ \p_ ->
 294     case p_ of
 295       ClosedHandle e -> return (p_, Just e)
 296       OpenHandle h ->
 297         alloca $ \pExitCode -> do
 298             res <- throwErrnoIfMinus1 "getProcessExitCode" $
 299                         c_getProcessExitCode h pExitCode
 300             code <- peek pExitCode
 301             if res == 0
 302               then return (p_, Nothing)
 303               else do
 304                    closePHANDLE h
 305                    let e  | code == 0 = ExitSuccess
 306                           | otherwise = ExitFailure (fromIntegral code)
 307                    return (ClosedHandle e, Just e)
 308
 309 -- ----------------------------------------------------------------------------
 310 -- Interface to C bits
 311
 312 foreign import ccall unsafe "terminateProcess"
 313   c_terminateProcess
 314         :: PHANDLE
 315         -> IO CInt
 316
 317 foreign import ccall unsafe "getProcessExitCode"
 318   c_getProcessExitCode
 319         :: PHANDLE
 320         -> Ptr CInt
 321         -> IO CInt
 322
 323 foreign import ccall safe "waitForProcess" -- NB. safe - can block
 324   c_waitForProcess
 325         :: PHANDLE
 326         -> IO CInt