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.
  85
  86      Any 'Handle's passed to 'runProcess' are placed immediately in the
  87      closed state.
  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 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do
 100 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 101   h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env
 102         mb_stdin mb_stdout mb_stderr
 103         Nothing Nothing
 104 #else
 105   h <- runProcessWin32 "runProcess" cmd args mb_cwd mb_env
 106         mb_stdin mb_stdout mb_stderr ""
 107 #endif
 108   maybe (return ()) hClose mb_stdin
 109   maybe (return ()) hClose mb_stdout
 110   maybe (return ()) hClose mb_stderr
 111   return h
 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      ph <- mkProcessHandle proc_handle
 171      return (hndStdInput, hndStdOutput, hndStdError, ph)
 172
 173 foreign import ccall unsafe "runInteractiveProcess"
 174   c_runInteractiveProcess
 175         ::  Ptr CString
 176         -> CString
 177         -> Ptr CString
 178         -> Ptr FD
 179         -> Ptr FD
 180         -> Ptr FD
 181         -> IO PHANDLE
 182
 183 #else
 184
 185 runInteractiveProcess cmd args mb_cwd mb_env =
 186   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""
 187
 188 runInteractiveProcess1 fun cmd args workDir env extra_cmdline
 189  = withFilePathException cmd $ do
 190      let cmdline = translate cmd ++
 191                        concat (map ((' ':) . translate) args) ++
 192                        (if null extra_cmdline then "" else ' ':extra_cmdline)
 193      withCString cmdline $ \pcmdline ->
 194       alloca $ \ pfdStdInput  ->
 195       alloca $ \ pfdStdOutput ->
 196       alloca $ \ pfdStdError  -> do
 197       maybeWith withCEnvironment env $ \pEnv -> do
 198       maybeWith withCString workDir $ \pWorkDir -> do
 199         proc_handle <- throwErrnoIfMinus1 fun $
 200                              c_runInteractiveProcess pcmdline pWorkDir pEnv
 201                                   pfdStdInput pfdStdOutput pfdStdError
 202         hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 203         hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 204         hndStdError  <- fdToHandle pfdStdError  ReadMode
 205         ph <- mkProcessHandle proc_handle
 206         return (hndStdInput, hndStdOutput, hndStdError, ph)
 207
 208 foreign import ccall unsafe "runInteractiveProcess"
 209   c_runInteractiveProcess
 210         :: CString
 211         -> CString
 212         -> Ptr ()
 213         -> Ptr FD
 214         -> Ptr FD
 215         -> Ptr FD
 216         -> IO PHANDLE
 217
 218 #endif
 219
 220 fdToHandle :: Ptr FD -> IOMode -> IO Handle
 221 fdToHandle pfd mode = do
 222   fd <- peek pfd
 223   openFd fd (Just Stream)
 224      False{-not a socket-}
 225      ("fd:" ++ show fd) mode True{-binary-}
 226
 227 -- ----------------------------------------------------------------------------
 228 -- waitForProcess
 229
 230 {- | Waits for the specified process to terminate, and returns its exit code.
 231
 232      GHC Note: in order to call @waitForProcess@ without blocking all the
 233      other threads in the system, you must compile the program with
 234      @-threaded@.
 235 -}
 236 waitForProcess
 237   :: ProcessHandle
 238   -> IO ExitCode
 239 waitForProcess ph = do
 240   handle <- getProcessHandle ph
 241   code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
 242   if (code == 0)
 243     then return ExitSuccess
 244     else return (ExitFailure (fromIntegral code))
 245
 246 -- ----------------------------------------------------------------------------
 247 -- terminateProcess
 248
 249 -- | Attempts to terminate the specified process.  This function should
 250 -- not be used under normal circumstances - no guarantees are given regarding
 251 -- how cleanly the process is terminated.  To check whether the process
 252 -- has indeed terminated, use 'getProcessExitCode'.
 253 --
 254 -- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
 255 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
 256 -- an exit code of 1.
 257 terminateProcess :: ProcessHandle -> IO ()
 258 terminateProcess ph = do
 259   pid <- getProcessHandle ph
 260   throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
 261
 262 -- ----------------------------------------------------------------------------
 263 -- getProcessExitCode
 264
 265 {- |
 266 This is a non-blocking version of 'waitForProcess'.  If the process is
 267 still running, 'Nothing' is returned.  If the process has exited, then
 268 @'Just' e@ is returned where @e@ is the exit code of the process.
 269 Subsequent calls to @getProcessExitStatus@ always return @'Just'
 270 'ExitSuccess'@, regardless of what the original exit code was.
 271 -}
 272 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
 273 getProcessExitCode ph = do
 274   handle <- getProcessHandle ph
 275   alloca $ \pExitCode -> do
 276     res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
 277     code <- peek pExitCode
 278     if res == 0
 279       then return Nothing
 280       else if code == 0
 281              then return (Just ExitSuccess)
 282              else return (Just (ExitFailure (fromIntegral code)))
 283
 284 -- ----------------------------------------------------------------------------
 285 -- Interface to C bits
 286
 287 foreign import ccall unsafe "terminateProcess"
 288   c_terminateProcess
 289         :: PHANDLE
 290         -> IO CInt
 291
 292 foreign import ccall unsafe "getProcessExitCode"
 293   c_getProcessExitCode
 294         :: PHANDLE
 295         -> Ptr CInt
 296         -> IO CInt
 297
 298 foreign import ccall safe "waitForProcess" -- NB. safe - can block
 299   c_waitForProcess
 300         :: PHANDLE
 301         -> IO CInt