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 Data.Maybe       ( fromMaybe )
  55 import System.IO        ( IOMode(..), Handle )
  56 import System.Exit      ( ExitCode(..) )
  57 import Control.Exception ( handle, throwIO )
  58
  59 import System.Posix.Internals
  60 import GHC.IOBase       ( haFD, FD, Exception(..), IOException(..) )
  61 import GHC.Handle       ( stdin, stdout, stderr, withHandle_, openFd )
  62
  63 -- ----------------------------------------------------------------------------
  64 -- runCommand
  65
  66 {- | Runs a command using the shell.
  67  -}
  68 runCommand
  69   :: String
  70   -> IO ProcessHandle
  71
  72 runCommand string = do
  73   (cmd,args) <- commandToProcess string
  74 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
  75   runProcess1 "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing
  76 #else
  77   runProcess1 "runCommand" cmd [] Nothing Nothing Nothing Nothing Nothing args
  78 #endif
  79
  80 -- ----------------------------------------------------------------------------
  81 -- runProcess
  82
  83 {- | Runs a raw command, optionally specifying 'Handle's from which to
  84      take the @stdin@, @stdout@ and @stderr@ channels for the new
  85      process.
  86
  87      Any 'Handle's passed to 'runProcess' are placed immediately in the
  88      closed state, so may no longer be referenced by the Haskell process.
  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 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 101
 102 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
 103  = runProcess1 "runProcess" cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
 104
 105 runProcess1 fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
 106  = withFilePathException cmd $
 107      withHandle_ fun (fromMaybe stdin  mb_stdin)  $ \hndStdInput  ->
 108      withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
 109      withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
 110      maybeWith withCEnvironment mb_env $ \pEnv ->
 111      maybeWith withCString mb_cwd $ \pWorkDir ->
 112      withMany withCString (cmd:args) $ \cstrs ->
 113      withArray0 nullPtr cstrs $ \pargs -> do
 114          ph <- throwErrnoIfMinus1 fun
 115                 (c_runProcess pargs pWorkDir pEnv
 116                         (haFD hndStdInput)
 117                         (haFD hndStdOutput)
 118                         (haFD hndStdError))
 119          return (ProcessHandle ph)
 120
 121 foreign import ccall unsafe "runProcess"
 122   c_runProcess
 123         :: Ptr CString                  -- args
 124         -> CString                      -- working directory (or NULL)
 125         -> Ptr CString                  -- env (or NULL)
 126         -> FD                           -- stdin
 127         -> FD                           -- stdout
 128         -> FD                           -- stderr
 129         -> IO PHANDLE
 130
 131 #else
 132
 133 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr =
 134   runProcess1 "runProcess" cmd args mb_cwd mb_env
 135         mb_stdin mb_stdout mb_stderr ""
 136
 137 runProcess1 fun cmd args mb_cwd mb_env
 138         mb_stdin mb_stdout mb_stderr extra_cmdline
 139  = withFilePathException cmd $
 140      withHandle_ fun (fromMaybe stdin  mb_stdin)  $ \hndStdInput  ->
 141      withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
 142      withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
 143      maybeWith withCEnvironment mb_env $ \pEnv -> do
 144      maybeWith withCString      mb_cwd $ \pWorkDir -> do
 145        let cmdline = translate cmd ++
 146                    concat (map ((' ':) . translate) args) ++
 147                    (if null extra_cmdline then "" else ' ':extra_cmdline)
 148        withCString cmdline $ \pcmdline -> do
 149          proc_handle <- throwErrnoIfMinus1 fun
 150                           (c_runProcess pcmdline pWorkDir pEnv
 151                                 (haFD hndStdInput)
 152                                 (haFD hndStdOutput)
 153                                 (haFD hndStdError))
 154          return (ProcessHandle proc_handle)
 155
 156 foreign import ccall unsafe "runProcess"
 157   c_runProcess
 158         :: CString
 159         -> CString
 160         -> Ptr ()
 161         -> FD
 162         -> FD
 163         -> FD
 164         -> IO PHANDLE
 165
 166      -- Set the standard HANDLEs for the child process appropriately.  NOTE:
 167      -- this relies on the HANDLEs being inheritable.  By default, the
 168      -- runtime open() function creates inheritable handles (unless O_NOINHERIT
 169      -- is specified).  But perhaps we should DuplicateHandle() to make sure
 170      -- the handle is inheritable?
 171 #endif
 172
 173 -- ----------------------------------------------------------------------------
 174 -- runInteractiveCommand
 175
 176 {- | Runs a command using the shell, and returns 'Handle's that may
 177      be used to communicate with the process via its @stdin@, @stdout@,
 178      and @stderr@ respectively.
 179 -}
 180 runInteractiveCommand
 181   :: String
 182   -> IO (Handle,Handle,Handle,ProcessHandle)
 183
 184 runInteractiveCommand string = do
 185   (cmd,args) <- commandToProcess string
 186 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 187   runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing
 188 #else
 189   runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args
 190 #endif
 191
 192 -- ----------------------------------------------------------------------------
 193 -- runInteractiveProcess
 194
 195 {- | Runs a raw command, and returns 'Handle's that may be used to communicate
 196      with the process via its @stdin@, @stdout@ and @stderr@ respectively.
 197
 198     For example, to start a process and feed a string to its stdin:
 199
 200 >   (in,out,err,pid) <- runInteractiveProcess "..."
 201 >   forkIO (hPutStr in str)
 202 -}
 203 runInteractiveProcess
 204   :: FilePath                   -- ^ Filename of the executable
 205   -> [String]                   -- ^ Arguments to pass to the executable
 206   -> Maybe FilePath             -- ^ Optional path to the working directory
 207   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
 208   -> IO (Handle,Handle,Handle,ProcessHandle)
 209
 210 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 211
 212 runInteractiveProcess cmd args mb_cwd mb_env =
 213   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env
 214
 215 runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
 216   withFilePathException cmd $
 217    alloca $ \ pfdStdInput  ->
 218    alloca $ \ pfdStdOutput ->
 219    alloca $ \ pfdStdError  ->
 220    maybeWith withCEnvironment mb_env $ \pEnv ->
 221    maybeWith withCString mb_cwd $ \pWorkDir ->
 222    withMany withCString (cmd:args) $ \cstrs ->
 223    withArray0 nullPtr cstrs $ \pargs -> do
 224      proc_handle <- throwErrnoIfMinus1 fun
 225                           (c_runInteractiveProcess pargs pWorkDir pEnv
 226                                 pfdStdInput pfdStdOutput pfdStdError)
 227      hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 228      hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 229      hndStdError  <- fdToHandle pfdStdError  ReadMode
 230      return (hndStdInput, hndStdOutput, hndStdError, ProcessHandle proc_handle)
 231
 232 foreign import ccall unsafe "runInteractiveProcess"
 233   c_runInteractiveProcess
 234         ::  Ptr CString
 235         -> CString
 236         -> Ptr CString
 237         -> Ptr FD
 238         -> Ptr FD
 239         -> Ptr FD
 240         -> IO PHANDLE
 241
 242 #else
 243
 244 runInteractiveProcess cmd args mb_cwd mb_env =
 245   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""
 246
 247 runInteractiveProcess1 fun cmd args workDir env extra_cmdline
 248  = withFilePathException cmd $ do
 249      let cmdline = translate cmd ++
 250                        concat (map ((' ':) . translate) args) ++
 251                        (if null extra_cmdline then "" else ' ':extra_cmdline)
 252      withCString cmdline $ \pcmdline ->
 253       alloca $ \ pfdStdInput  ->
 254       alloca $ \ pfdStdOutput ->
 255       alloca $ \ pfdStdError  -> do
 256       maybeWith withCEnvironment env $ \pEnv -> do
 257       maybeWith withCString workDir $ \pWorkDir -> do
 258         proc_handle <- throwErrnoIfMinus1 fun $
 259                              c_runInteractiveProcess pcmdline pWorkDir pEnv
 260                                   pfdStdInput pfdStdOutput pfdStdError
 261         hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 262         hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 263         hndStdError  <- fdToHandle pfdStdError  ReadMode
 264         return (hndStdInput, hndStdOutput, hndStdError,
 265                 ProcessHandle proc_handle)
 266
 267 foreign import ccall unsafe "runInteractiveProcess"
 268   c_runInteractiveProcess
 269         :: CString
 270         -> CString
 271         -> Ptr ()
 272         -> Ptr FD
 273         -> Ptr FD
 274         -> Ptr FD
 275         -> IO PHANDLE
 276
 277 #endif
 278
 279 fdToHandle :: Ptr FD -> IOMode -> IO Handle
 280 fdToHandle pfd mode = do
 281   fd <- peek pfd
 282   openFd fd (Just Stream)
 283      False{-not a socket-}
 284      ("fd:" ++ show fd) mode True{-binary-}
 285
 286 -- ----------------------------------------------------------------------------
 287 -- waitForProcess
 288
 289 {- | Waits for the specified process to terminate, and returns its exit code.
 290
 291      GHC Note: in order to call waitForProcess without blocking all the
 292      other threads in the system, you must compile the program with
 293      @-threaded@.
 294 -}
 295 waitForProcess
 296   :: ProcessHandle
 297   -> IO ExitCode
 298 waitForProcess (ProcessHandle handle) = do
 299   code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
 300   if (code == 0)
 301     then return ExitSuccess
 302     else return (ExitFailure (fromIntegral code))
 303
 304 -- ----------------------------------------------------------------------------
 305 -- terminateProcess
 306
 307 -- | Attempts to terminate the specified process.  This function should
 308 -- not be used under normal circumstances - no guarantees are given regarding
 309 -- how cleanly the process is terminated.  To check whether the process
 310 -- has indeed terminated, use 'getProcessExitCode'.
 311 --
 312 -- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
 313 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
 314 -- an exit code of 1.
 315 terminateProcess :: ProcessHandle -> IO ()
 316 terminateProcess (ProcessHandle pid) =
 317   throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
 318
 319 -- ----------------------------------------------------------------------------
 320 -- getProcessExitCode
 321
 322 {- | Verifies whether the process is completed and if it is then returns the exit code.
 323    If the process is still running the function returns Nothing
 324 -}
 325 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
 326 getProcessExitCode (ProcessHandle handle) =
 327   alloca $ \pExitCode -> do
 328     res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
 329     code <- peek pExitCode
 330     if res == 0
 331       then return Nothing
 332       else if code == 0
 333              then return (Just ExitSuccess)
 334              else return (Just (ExitFailure (fromIntegral code)))
 335
 336 -- ----------------------------------------------------------------------------
 337 -- commandToProcess
 338
 339 {- | Turns a shell command into a raw command.  Usually this involves
 340      wrapping it in an invocation of the shell.
 341
 342    There's a difference in the signature of commandToProcess between
 343    the Windows and Unix versions.  On Unix, exec takes a list of strings,
 344    and we want to pass our command to /bin/sh as a single argument.
 345
 346    On Windows, CreateProcess takes a single string for the command,
 347    which is later decomposed by cmd.exe.  In this case, we just want
 348    to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line.  The
 349    command-line translation that we normally do for arguments on
 350    Windows isn't required (or desirable) here.
 351 -}
 352
 353 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 354
 355 commandToProcess
 356   :: String
 357   -> IO (FilePath,[String])
 358 commandToProcess string = return ("/bin/sh", ["-c", string])
 359
 360 #else
 361
 362 commandToProcess
 363   :: String
 364   -> IO (FilePath,String)
 365 commandToProcess string = do
 366   sysDir <- allocaBytes 1024 (\pdir -> c_getSystemDirectory pdir 1024 >> peekCString pdir)
 367   return (sysDir ++ "\\CMD.EXE", "/c " ++ string)
 368         -- We don't want to put the cmd into a single
 369         -- argument, because cmd.exe will not try to split it up.  Instead,
 370         -- we just tack the command on the end of the cmd.exe command line,
 371         -- which partly works.  There seem to be some quoting issues, but
 372         -- I don't have the energy to find+fix them right now (ToDo). --SDM
 373
 374 foreign import stdcall unsafe "GetSystemDirectoryA"
 375   c_getSystemDirectory
 376         :: CString
 377         -> CInt
 378         -> IO CInt
 379
 380 #endif
 381
 382 -- ----------------------------------------------------------------------------
 383 -- Utils
 384
 385 withFilePathException :: FilePath -> IO a -> IO a
 386 withFilePathException fpath act = handle mapEx act
 387   where
 388     mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath))
 389     mapEx e                                       = throwIO e
 390
 391 #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
 392 withCEnvironment :: [(String,String)] -> (Ptr CString  -> IO a) -> IO a
 393 withCEnvironment env act =
 394   let env' = map (\(name, val) -> name ++ ('=':val)) env
 395   in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
 396 #else
 397 withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a
 398 withCEnvironment env act =
 399   let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env
 400   in withCString env' (act . castPtr)
 401 #endif
 402
 403
 404 -- ----------------------------------------------------------------------------
 405 -- Interface to C bits
 406
 407 foreign import ccall unsafe "terminateProcess"
 408   c_terminateProcess
 409         :: PHANDLE
 410         -> IO CInt
 411
 412 foreign import ccall unsafe "getProcessExitCode"
 413   c_getProcessExitCode
 414         :: PHANDLE
 415         -> Ptr CInt
 416         -> IO CInt
 417
 418 foreign import ccall safe "waitForProcess" -- NB. safe - can block
 419   c_waitForProcess
 420         :: PHANDLE
 421         -> IO CInt
 422
 423 -- ------------------------------------------------------------------------
 424 -- Passing commands to the OS on Windows
 425
 426 {-
 427 On Windows this is tricky.  We use CreateProcess, passing a single
 428 command-line string (lpCommandLine) as its argument.  (CreateProcess
 429 is well documented on http://msdn.microsoft/com.)
 430
 431       - It parses the beginning of the string to find the command. If the
 432         file name has embedded spaces, it must be quoted, using double
 433         quotes thus
 434                 "foo\this that\cmd" arg1 arg2
 435
 436       - The invoked command can in turn access the entire lpCommandLine string,
 437         and the C runtime does indeed do so, parsing it to generate the
 438         traditional argument vector argv[0], argv[1], etc.  It does this
 439         using a complex and arcane set of rules which are described here:
 440
 441            http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
 442
 443         (if this URL stops working, you might be able to find it by
 444         searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
 445         the code in the Microsoft C runtime that does this translation
 446         is shipped with VC++).
 447
 448 Our goal in runProcess is to take a command filename and list of
 449 arguments, and construct a string which inverts the translatsions
 450 described above, such that the program at the other end sees exactly
 451 the same arguments in its argv[] that we passed to rawSystem.
 452
 453 This inverse translation is implemented by 'translate' below.
 454
 455 Here are some pages that give informations on Windows-related
 456 limitations and deviations from Unix conventions:
 457
 458     http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
 459     Command lines and environment variables effectively limited to 8191
 460     characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
 461
 462     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
 463     Command-line substitution under Windows XP. IIRC these facilities (or at
 464     least a large subset of them) are available on Win NT and 2000. Some
 465     might be available on Win 9x.
 466
 467     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
 468     How CMD.EXE processes command lines.
 469
 470
 471 Note: CreateProcess does have a separate argument (lpApplicationName)
 472 with which you can specify the command, but we have to slap the
 473 command into lpCommandLine anyway, so that argv[0] is what a C program
 474 expects (namely the application name).  So it seems simpler to just
 475 use lpCommandLine alone, which CreateProcess supports.
 476 -}
 477
 478 #if defined(mingw32_HOST_OS)
 479
 480 -- Translate command-line arguments for passing to CreateProcess().
 481 translate :: String -> String
 482 translate str = '"' : snd (foldr escape (True,"\"") str)
 483   where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
 484         escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
 485         escape '\\' (False, str) = (False, '\\' : str)
 486         escape c    (b,     str) = (False, c : str)
 487         -- See long comment above for what this function is trying to do.
 488         --
 489         -- The Bool passed back along the string is True iff the
 490         -- rest of the string is a sequence of backslashes followed by
 491         -- a double quote.
 492
 493 #endif