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   runProcess1 "runProcess" cmd args mb_cwd mb_env
 110         mb_stdin mb_stdout mb_stderr ""
 111
 112 runProcessWin32 fun cmd args mb_cwd mb_env
 113         mb_stdin mb_stdout mb_stderr extra_cmdline
 114  = withFilePathException cmd $
 115      withHandle_ fun (fromMaybe stdin  mb_stdin)  $ \hndStdInput  ->
 116      withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
 117      withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
 118      maybeWith withCEnvironment mb_env $ \pEnv -> do
 119      maybeWith withCString      mb_cwd $ \pWorkDir -> do
 120        let cmdline = translate cmd ++
 121                    concat (map ((' ':) . translate) args) ++
 122                    (if null extra_cmdline then "" else ' ':extra_cmdline)
 123        withCString cmdline $ \pcmdline -> do
 124          proc_handle <- throwErrnoIfMinus1 fun
 125                           (c_runProcess pcmdline pWorkDir pEnv
 126                                 (haFD hndStdInput)
 127                                 (haFD hndStdOutput)
 128                                 (haFD hndStdError))
 129          return (ProcessHandle proc_handle)
 130
 131 foreign import ccall unsafe "runProcess"
 132   c_runProcess
 133         :: CString
 134         -> CString
 135         -> Ptr ()
 136         -> FD
 137         -> FD
 138         -> FD
 139         -> IO PHANDLE
 140
 141      -- Set the standard HANDLEs for the child process appropriately.  NOTE:
 142      -- this relies on the HANDLEs being inheritable.  By default, the
 143      -- runtime open() function creates inheritable handles (unless O_NOINHERIT
 144      -- is specified).  But perhaps we should DuplicateHandle() to make sure
 145      -- the handle is inheritable?
 146 #endif
 147
 148 -- ----------------------------------------------------------------------------
 149 -- runInteractiveCommand
 150
 151 {- | Runs a command using the shell, and returns 'Handle's that may
 152      be used to communicate with the process via its @stdin@, @stdout@,
 153      and @stderr@ respectively.
 154 -}
 155 runInteractiveCommand
 156   :: String
 157   -> IO (Handle,Handle,Handle,ProcessHandle)
 158
 159 runInteractiveCommand string = do
 160   (cmd,args) <- commandToProcess string
 161 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 162   runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing
 163 #else
 164   runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args
 165 #endif
 166
 167 -- ----------------------------------------------------------------------------
 168 -- runInteractiveProcess
 169
 170 {- | Runs a raw command, and returns 'Handle's that may be used to communicate
 171      with the process via its @stdin@, @stdout@ and @stderr@ respectively.
 172
 173     For example, to start a process and feed a string to its stdin:
 174
 175 >   (inp,out,err,pid) <- runInteractiveProcess "..."
 176 >   forkIO (hPutStr inp str)
 177 -}
 178 runInteractiveProcess
 179   :: FilePath                   -- ^ Filename of the executable
 180   -> [String]                   -- ^ Arguments to pass to the executable
 181   -> Maybe FilePath             -- ^ Optional path to the working directory
 182   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
 183   -> IO (Handle,Handle,Handle,ProcessHandle)
 184
 185 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 186
 187 runInteractiveProcess cmd args mb_cwd mb_env =
 188   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env
 189
 190 runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
 191   withFilePathException cmd $
 192    alloca $ \ pfdStdInput  ->
 193    alloca $ \ pfdStdOutput ->
 194    alloca $ \ pfdStdError  ->
 195    maybeWith withCEnvironment mb_env $ \pEnv ->
 196    maybeWith withCString mb_cwd $ \pWorkDir ->
 197    withMany withCString (cmd:args) $ \cstrs ->
 198    withArray0 nullPtr cstrs $ \pargs -> do
 199      proc_handle <- throwErrnoIfMinus1 fun
 200                           (c_runInteractiveProcess pargs pWorkDir pEnv
 201                                 pfdStdInput pfdStdOutput pfdStdError)
 202      hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 203      hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 204      hndStdError  <- fdToHandle pfdStdError  ReadMode
 205      return (hndStdInput, hndStdOutput, hndStdError, ProcessHandle proc_handle)
 206
 207 foreign import ccall unsafe "runInteractiveProcess"
 208   c_runInteractiveProcess
 209         ::  Ptr CString
 210         -> CString
 211         -> Ptr CString
 212         -> Ptr FD
 213         -> Ptr FD
 214         -> Ptr FD
 215         -> IO PHANDLE
 216
 217 #else
 218
 219 runInteractiveProcess cmd args mb_cwd mb_env =
 220   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""
 221
 222 runInteractiveProcess1 fun cmd args workDir env extra_cmdline
 223  = withFilePathException cmd $ do
 224      let cmdline = translate cmd ++
 225                        concat (map ((' ':) . translate) args) ++
 226                        (if null extra_cmdline then "" else ' ':extra_cmdline)
 227      withCString cmdline $ \pcmdline ->
 228       alloca $ \ pfdStdInput  ->
 229       alloca $ \ pfdStdOutput ->
 230       alloca $ \ pfdStdError  -> do
 231       maybeWith withCEnvironment env $ \pEnv -> do
 232       maybeWith withCString workDir $ \pWorkDir -> do
 233         proc_handle <- throwErrnoIfMinus1 fun $
 234                              c_runInteractiveProcess pcmdline pWorkDir pEnv
 235                                   pfdStdInput pfdStdOutput pfdStdError
 236         hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 237         hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 238         hndStdError  <- fdToHandle pfdStdError  ReadMode
 239         return (hndStdInput, hndStdOutput, hndStdError,
 240                 ProcessHandle proc_handle)
 241
 242 foreign import ccall unsafe "runInteractiveProcess"
 243   c_runInteractiveProcess
 244         :: CString
 245         -> CString
 246         -> Ptr ()
 247         -> Ptr FD
 248         -> Ptr FD
 249         -> Ptr FD
 250         -> IO PHANDLE
 251
 252 #endif
 253
 254 fdToHandle :: Ptr FD -> IOMode -> IO Handle
 255 fdToHandle pfd mode = do
 256   fd <- peek pfd
 257   openFd fd (Just Stream)
 258      False{-not a socket-}
 259      ("fd:" ++ show fd) mode True{-binary-}
 260
 261 -- ----------------------------------------------------------------------------
 262 -- waitForProcess
 263
 264 {- | Waits for the specified process to terminate, and returns its exit code.
 265
 266      GHC Note: in order to call waitForProcess without blocking all the
 267      other threads in the system, you must compile the program with
 268      @-threaded@.
 269 -}
 270 waitForProcess
 271   :: ProcessHandle
 272   -> IO ExitCode
 273 waitForProcess (ProcessHandle handle) = do
 274   code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
 275   if (code == 0)
 276     then return ExitSuccess
 277     else return (ExitFailure (fromIntegral code))
 278
 279 -- ----------------------------------------------------------------------------
 280 -- terminateProcess
 281
 282 -- | Attempts to terminate the specified process.  This function should
 283 -- not be used under normal circumstances - no guarantees are given regarding
 284 -- how cleanly the process is terminated.  To check whether the process
 285 -- has indeed terminated, use 'getProcessExitCode'.
 286 --
 287 -- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
 288 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
 289 -- an exit code of 1.
 290 terminateProcess :: ProcessHandle -> IO ()
 291 terminateProcess (ProcessHandle pid) =
 292   throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
 293
 294 -- ----------------------------------------------------------------------------
 295 -- getProcessExitCode
 296
 297 {- | Verifies whether the process is completed and if it is then returns the exit code.
 298    If the process is still running the function returns Nothing
 299 -}
 300 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
 301 getProcessExitCode (ProcessHandle handle) =
 302   alloca $ \pExitCode -> do
 303     res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
 304     code <- peek pExitCode
 305     if res == 0
 306       then return Nothing
 307       else if code == 0
 308              then return (Just ExitSuccess)
 309              else return (Just (ExitFailure (fromIntegral code)))
 310
 311 -- ----------------------------------------------------------------------------
 312 -- Interface to C bits
 313
 314 foreign import ccall unsafe "terminateProcess"
 315   c_terminateProcess
 316         :: PHANDLE
 317         -> IO CInt
 318
 319 foreign import ccall unsafe "getProcessExitCode"
 320   c_getProcessExitCode
 321         :: PHANDLE
 322         -> Ptr CInt
 323         -> IO CInt
 324
 325 foreign import ccall safe "waitForProcess" -- NB. safe - can block
 326   c_waitForProcess
 327         :: PHANDLE
 328         -> IO CInt
 329
 330 -- ------------------------------------------------------------------------
 331 -- Passing commands to the OS on Windows
 332
 333 {-
 334 On Windows this is tricky.  We use CreateProcess, passing a single
 335 command-line string (lpCommandLine) as its argument.  (CreateProcess
 336 is well documented on http://msdn.microsoft/com.)
 337
 338       - It parses the beginning of the string to find the command. If the
 339         file name has embedded spaces, it must be quoted, using double
 340         quotes thus
 341                 "foo\this that\cmd" arg1 arg2
 342
 343       - The invoked command can in turn access the entire lpCommandLine string,
 344         and the C runtime does indeed do so, parsing it to generate the
 345         traditional argument vector argv[0], argv[1], etc.  It does this
 346         using a complex and arcane set of rules which are described here:
 347
 348            http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
 349
 350         (if this URL stops working, you might be able to find it by
 351         searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
 352         the code in the Microsoft C runtime that does this translation
 353         is shipped with VC++).
 354
 355 Our goal in runProcess is to take a command filename and list of
 356 arguments, and construct a string which inverts the translatsions
 357 described above, such that the program at the other end sees exactly
 358 the same arguments in its argv[] that we passed to rawSystem.
 359
 360 This inverse translation is implemented by 'translate' below.
 361
 362 Here are some pages that give informations on Windows-related
 363 limitations and deviations from Unix conventions:
 364
 365     http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
 366     Command lines and environment variables effectively limited to 8191
 367     characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
 368
 369     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
 370     Command-line substitution under Windows XP. IIRC these facilities (or at
 371     least a large subset of them) are available on Win NT and 2000. Some
 372     might be available on Win 9x.
 373
 374     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
 375     How CMD.EXE processes command lines.
 376
 377
 378 Note: CreateProcess does have a separate argument (lpApplicationName)
 379 with which you can specify the command, but we have to slap the
 380 command into lpCommandLine anyway, so that argv[0] is what a C program
 381 expects (namely the application name).  So it seems simpler to just
 382 use lpCommandLine alone, which CreateProcess supports.
 383 -}
 384
 385 #if defined(mingw32_HOST_OS)
 386
 387 -- Translate command-line arguments for passing to CreateProcess().
 388 translate :: String -> String
 389 translate str = '"' : snd (foldr escape (True,"\"") str)
 390   where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
 391         escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
 392         escape '\\' (False, str) = (False, '\\' : str)
 393         escape c    (b,     str) = (False, c : str)
 394         -- See long comment above for what this function is trying to do.
 395         --
 396         -- The Bool passed back along the string is True iff the
 397         -- rest of the string is a sequence of backslashes followed by
 398         -- a double quote.
 399
 400 #endif