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 )
  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.
  85
  86      Any 'Handle's passed to 'runProcess' are placed immediately in the
  87      closed state, so may no longer be referenced by the Haskell process.
  88 -}
  89 runProcess
  90   :: FilePath                   -- ^ Filename of the executable
  91   -> [String]                   -- ^ Arguments to pass to the executable
  92   -> Maybe FilePath             -- ^ Optional path to the working directory
  93   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
  94   -> Maybe Handle               -- ^ Handle to use for @stdin@
  95   -> Maybe Handle               -- ^ Handle to use for @stdout@
  96   -> Maybe Handle               -- ^ Handle to use for @stderr@
  97   -> IO ProcessHandle
  98
  99 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 100
 101 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
 102  = runProcessPosix "runProcess" cmd args mb_cwd mb_env
 103         mb_stdin mb_stdout mb_stderr
 104         Nothing Nothing
 105
 106 #else
 107
 108 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr =
 109   runProcessWin32 "runProcess" cmd args mb_cwd mb_env
 110         mb_stdin mb_stdout mb_stderr ""
 111 #endif
 112
 113 -- ----------------------------------------------------------------------------
 114 -- runInteractiveCommand
 115
 116 {- | Runs a command using the shell, and returns 'Handle's that may
 117      be used to communicate with the process via its @stdin@, @stdout@,
 118      and @stderr@ respectively.
 119 -}
 120 runInteractiveCommand
 121   :: String
 122   -> IO (Handle,Handle,Handle,ProcessHandle)
 123
 124 runInteractiveCommand string = do
 125   (cmd,args) <- commandToProcess string
 126 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 127   runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing
 128 #else
 129   runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args
 130 #endif
 131
 132 -- ----------------------------------------------------------------------------
 133 -- runInteractiveProcess
 134
 135 {- | Runs a raw command, and returns 'Handle's that may be used to communicate
 136      with the process via its @stdin@, @stdout@ and @stderr@ respectively.
 137
 138     For example, to start a process and feed a string to its stdin:
 139
 140 >   (inp,out,err,pid) <- runInteractiveProcess "..."
 141 >   forkIO (hPutStr inp str)
 142 -}
 143 runInteractiveProcess
 144   :: FilePath                   -- ^ Filename of the executable
 145   -> [String]                   -- ^ Arguments to pass to the executable
 146   -> Maybe FilePath             -- ^ Optional path to the working directory
 147   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
 148   -> IO (Handle,Handle,Handle,ProcessHandle)
 149
 150 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 151
 152 runInteractiveProcess cmd args mb_cwd mb_env =
 153   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env
 154
 155 runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
 156   withFilePathException cmd $
 157    alloca $ \ pfdStdInput  ->
 158    alloca $ \ pfdStdOutput ->
 159    alloca $ \ pfdStdError  ->
 160    maybeWith withCEnvironment mb_env $ \pEnv ->
 161    maybeWith withCString mb_cwd $ \pWorkDir ->
 162    withMany withCString (cmd:args) $ \cstrs ->
 163    withArray0 nullPtr cstrs $ \pargs -> do
 164      proc_handle <- throwErrnoIfMinus1 fun
 165                           (c_runInteractiveProcess pargs pWorkDir pEnv
 166                                 pfdStdInput pfdStdOutput pfdStdError)
 167      hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 168      hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 169      hndStdError  <- fdToHandle pfdStdError  ReadMode
 170      return (hndStdInput, hndStdOutput, hndStdError, ProcessHandle proc_handle)
 171
 172 foreign import ccall unsafe "runInteractiveProcess"
 173   c_runInteractiveProcess
 174         ::  Ptr CString
 175         -> CString
 176         -> Ptr CString
 177         -> Ptr FD
 178         -> Ptr FD
 179         -> Ptr FD
 180         -> IO PHANDLE
 181
 182 #else
 183
 184 runInteractiveProcess cmd args mb_cwd mb_env =
 185   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""
 186
 187 runInteractiveProcess1 fun cmd args workDir env extra_cmdline
 188  = withFilePathException cmd $ do
 189      let cmdline = translate cmd ++
 190                        concat (map ((' ':) . translate) args) ++
 191                        (if null extra_cmdline then "" else ' ':extra_cmdline)
 192      withCString cmdline $ \pcmdline ->
 193       alloca $ \ pfdStdInput  ->
 194       alloca $ \ pfdStdOutput ->
 195       alloca $ \ pfdStdError  -> do
 196       maybeWith withCEnvironment env $ \pEnv -> do
 197       maybeWith withCString workDir $ \pWorkDir -> do
 198         proc_handle <- throwErrnoIfMinus1 fun $
 199                              c_runInteractiveProcess pcmdline pWorkDir pEnv
 200                                   pfdStdInput pfdStdOutput pfdStdError
 201         hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 202         hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 203         hndStdError  <- fdToHandle pfdStdError  ReadMode
 204         return (hndStdInput, hndStdOutput, hndStdError,
 205                 ProcessHandle proc_handle)
 206
 207 foreign import ccall unsafe "runInteractiveProcess"
 208   c_runInteractiveProcess
 209         :: CString
 210         -> CString
 211         -> Ptr ()
 212         -> Ptr FD
 213         -> Ptr FD
 214         -> Ptr FD
 215         -> IO PHANDLE
 216
 217 #endif
 218
 219 fdToHandle :: Ptr FD -> IOMode -> IO Handle
 220 fdToHandle pfd mode = do
 221   fd <- peek pfd
 222   openFd fd (Just Stream)
 223      False{-not a socket-}
 224      ("fd:" ++ show fd) mode True{-binary-}
 225
 226 -- ----------------------------------------------------------------------------
 227 -- waitForProcess
 228
 229 {- | Waits for the specified process to terminate, and returns its exit code.
 230
 231      GHC Note: in order to call waitForProcess without blocking all the
 232      other threads in the system, you must compile the program with
 233      @-threaded@.
 234 -}
 235 waitForProcess
 236   :: ProcessHandle
 237   -> IO ExitCode
 238 waitForProcess (ProcessHandle handle) = do
 239   code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
 240   if (code == 0)
 241     then return ExitSuccess
 242     else return (ExitFailure (fromIntegral code))
 243
 244 -- ----------------------------------------------------------------------------
 245 -- terminateProcess
 246
 247 -- | Attempts to terminate the specified process.  This function should
 248 -- not be used under normal circumstances - no guarantees are given regarding
 249 -- how cleanly the process is terminated.  To check whether the process
 250 -- has indeed terminated, use 'getProcessExitCode'.
 251 --
 252 -- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
 253 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
 254 -- an exit code of 1.
 255 terminateProcess :: ProcessHandle -> IO ()
 256 terminateProcess (ProcessHandle pid) =
 257   throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
 258
 259 -- ----------------------------------------------------------------------------
 260 -- getProcessExitCode
 261
 262 {- | Verifies whether the process is completed and if it is then returns the exit code.
 263    If the process is still running the function returns Nothing
 264 -}
 265 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
 266 getProcessExitCode (ProcessHandle handle) =
 267   alloca $ \pExitCode -> do
 268     res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
 269     code <- peek pExitCode
 270     if res == 0
 271       then return Nothing
 272       else if code == 0
 273              then return (Just ExitSuccess)
 274              else return (Just (ExitFailure (fromIntegral code)))
 275
 276 -- ----------------------------------------------------------------------------
 277 -- Interface to C bits
 278
 279 foreign import ccall unsafe "terminateProcess"
 280   c_terminateProcess
 281         :: PHANDLE
 282         -> IO CInt
 283
 284 foreign import ccall unsafe "getProcessExitCode"
 285   c_getProcessExitCode
 286         :: PHANDLE
 287         -> Ptr CInt
 288         -> IO CInt
 289
 290 foreign import ccall safe "waitForProcess" -- NB. safe - can block
 291   c_waitForProcess
 292         :: PHANDLE
 293         -> IO CInt