System/Process.hs

   1 {-# OPTIONS -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 System.Process.Internals
  49
  50 import Foreign
  51 import Foreign.C
  52 import Data.Maybe       ( fromMaybe )
  53 import System.IO        ( IOMode(..), Handle )
  54 import System.Exit      ( ExitCode(..) )
  55 import Control.Exception ( handle, throwIO )
  56
  57 import System.Posix.Internals
  58 import GHC.IOBase       ( haFD, FD, Exception(..), IOException(..) )
  59 import GHC.Handle       ( stdin, stdout, stderr, withHandle_, 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_TARGET_OS) && !defined(__MINGW32__)
  73   runProcess1 "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing
  74 #else
  75   runProcess1 "runCommand" cmd [] Nothing Nothing Nothing Nothing Nothing args
  76 #endif
  77
  78 -- ----------------------------------------------------------------------------
  79 -- runProcess
  80
  81 {- | Runs a raw command, optionally specifying 'Handle's from which to
  82      take the @stdin@, @stdout@ and @stderr@ channels for the new
  83      process.
  84
  85      Any 'Handle's passed to 'runProcess' are placed immediately in the
  86      closed state, so may no longer be referenced by the Haskell process.
  87 -}
  88 runProcess
  89   :: FilePath                   -- ^ Filename of the executable
  90   -> [String]                   -- ^ Arguments to pass to the executable
  91   -> Maybe FilePath             -- ^ Optional path to the working directory
  92   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
  93   -> Maybe Handle               -- ^ Handle to use for @stdin@
  94   -> Maybe Handle               -- ^ Handle to use for @stdout@
  95   -> Maybe Handle               -- ^ Handle to use for @stderr@
  96   -> IO ProcessHandle
  97
  98 #if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
  99
 100 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
 101  = runProcess1 "runProcess" cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
 102
 103 runProcess1 fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
 104  = withFilePathException cmd $
 105      withHandle_ fun (fromMaybe stdin  mb_stdin)  $ \hndStdInput  ->
 106      withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
 107      withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
 108      maybeWith withCEnvironment mb_env $ \pEnv ->
 109      maybeWith withCString mb_cwd $ \pWorkDir ->
 110      withMany withCString (cmd:args) $ \cstrs ->
 111      withArray0 nullPtr cstrs $ \pargs -> do
 112          ph <- throwErrnoIfMinus1 fun
 113                 (c_runProcess pargs pWorkDir pEnv
 114                         (haFD hndStdInput)
 115                         (haFD hndStdOutput)
 116                         (haFD hndStdError))
 117          return (ProcessHandle ph)
 118
 119 foreign import ccall unsafe "runProcess"
 120   c_runProcess
 121         :: Ptr CString                  -- args
 122         -> CString                      -- working directory (or NULL)
 123         -> Ptr CString                  -- env (or NULL)
 124         -> FD                           -- stdin
 125         -> FD                           -- stdout
 126         -> FD                           -- stderr
 127         -> IO PHANDLE
 128
 129 #else
 130
 131 runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr =
 132   runProcess1 "runProcess" cmd args mb_cwd mb_env
 133         mb_stdin mb_stdout mb_stderr ""
 134
 135 runProcess1 fun cmd args mb_cwd mb_env
 136         mb_stdin mb_stdout mb_stderr extra_cmdline
 137  = withFilePathException cmd $
 138      withHandle_ fun (fromMaybe stdin  mb_stdin)  $ \hndStdInput  ->
 139      withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput ->
 140      withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError ->
 141      maybeWith withCEnvironment mb_env $ \pEnv -> do
 142      maybeWith withCString      mb_cwd $ \pWorkDir -> do
 143        let cmdline = translate cmd ++
 144                    concat (map ((' ':) . translate) args) ++
 145                    (if null extra_cmdline then "" else ' ':extra_cmdline)
 146        withCString cmdline $ \pcmdline -> do
 147          proc_handle <- throwErrnoIfMinus1 fun
 148                           (c_runProcess pcmdline pWorkDir pEnv
 149                                 (haFD hndStdInput)
 150                                 (haFD hndStdOutput)
 151                                 (haFD hndStdError))
 152          return (ProcessHandle proc_handle)
 153
 154 foreign import ccall unsafe "runProcess"
 155   c_runProcess
 156         :: CString
 157         -> CString
 158         -> Ptr ()
 159         -> FD
 160         -> FD
 161         -> FD
 162         -> IO PHANDLE
 163
 164      -- Set the standard HANDLEs for the child process appropriately.  NOTE:
 165      -- this relies on the HANDLEs being inheritable.  By default, the
 166      -- runtime open() function creates inheritable handles (unless O_NOINHERIT
 167      -- is specified).  But perhaps we should DuplicateHandle() to make sure
 168      -- the handle is inheritable?
 169 #endif
 170
 171 -- ----------------------------------------------------------------------------
 172 -- runInteractiveCommand
 173
 174 {- | Runs a command using the shell, and returns 'Handle's that may
 175      be used to communicate with the process via its @stdin@, @stdout@,
 176      and @stderr@ respectively.
 177 -}
 178 runInteractiveCommand
 179   :: String
 180   -> IO (Handle,Handle,Handle,ProcessHandle)
 181
 182 runInteractiveCommand string = do
 183   (cmd,args) <- commandToProcess string
 184 #if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
 185   runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing
 186 #else
 187   runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args
 188 #endif
 189
 190 -- ----------------------------------------------------------------------------
 191 -- runInteractiveProcess
 192
 193 {- | Runs a raw command, and returns 'Handle's that may be used to communicate
 194      with the process via its @stdin@, @stdout@ and @stderr@ respectively.
 195
 196     For example, to start a process and feed a string to its stdin:
 197
 198 >   (in,out,err,pid) <- runInteractiveProcess "..."
 199 >   forkIO (hPutStr in str)
 200 -}
 201 runInteractiveProcess
 202   :: FilePath                   -- ^ Filename of the executable
 203   -> [String]                   -- ^ Arguments to pass to the executable
 204   -> Maybe FilePath             -- ^ Optional path to the working directory
 205   -> Maybe [(String,String)]    -- ^ Optional environment (otherwise inherit)
 206   -> IO (Handle,Handle,Handle,ProcessHandle)
 207
 208 #if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
 209
 210 runInteractiveProcess cmd args mb_cwd mb_env =
 211   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env
 212
 213 runInteractiveProcess1 fun cmd args mb_cwd mb_env = do
 214   withFilePathException cmd $
 215    alloca $ \ pfdStdInput  ->
 216    alloca $ \ pfdStdOutput ->
 217    alloca $ \ pfdStdError  ->
 218    maybeWith withCEnvironment mb_env $ \pEnv ->
 219    maybeWith withCString mb_cwd $ \pWorkDir ->
 220    withMany withCString (cmd:args) $ \cstrs ->
 221    withArray0 nullPtr cstrs $ \pargs -> do
 222      proc_handle <- throwErrnoIfMinus1 fun
 223                           (c_runInteractiveProcess pargs pWorkDir pEnv
 224                                 pfdStdInput pfdStdOutput pfdStdError)
 225      hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 226      hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 227      hndStdError  <- fdToHandle pfdStdError  ReadMode
 228      return (hndStdInput, hndStdOutput, hndStdError, ProcessHandle proc_handle)
 229
 230 foreign import ccall unsafe "runInteractiveProcess"
 231   c_runInteractiveProcess
 232         ::  Ptr CString
 233         -> CString
 234         -> Ptr CString
 235         -> Ptr FD
 236         -> Ptr FD
 237         -> Ptr FD
 238         -> IO PHANDLE
 239
 240 #else
 241
 242 runInteractiveProcess cmd args mb_cwd mb_env =
 243   runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env ""
 244
 245 runInteractiveProcess1 fun cmd args workDir env extra_cmdline
 246  = withFilePathException cmd $ do
 247      let cmdline = translate cmd ++
 248                        concat (map ((' ':) . translate) args) ++
 249                        (if null extra_cmdline then "" else ' ':extra_cmdline)
 250      withCString cmdline $ \pcmdline ->
 251       alloca $ \ pfdStdInput  ->
 252       alloca $ \ pfdStdOutput ->
 253       alloca $ \ pfdStdError  -> do
 254       maybeWith withCEnvironment env $ \pEnv -> do
 255       maybeWith withCString workDir $ \pWorkDir -> do
 256         proc_handle <- throwErrnoIfMinus1 fun $
 257                              c_runInteractiveProcess pcmdline pWorkDir pEnv
 258                                   pfdStdInput pfdStdOutput pfdStdError
 259         hndStdInput  <- fdToHandle pfdStdInput  WriteMode
 260         hndStdOutput <- fdToHandle pfdStdOutput ReadMode
 261         hndStdError  <- fdToHandle pfdStdError  ReadMode
 262         return (hndStdInput, hndStdOutput, hndStdError,
 263                 ProcessHandle proc_handle)
 264
 265 foreign import ccall unsafe "runInteractiveProcess"
 266   c_runInteractiveProcess
 267         :: CString
 268         -> CString
 269         -> Ptr ()
 270         -> Ptr FD
 271         -> Ptr FD
 272         -> Ptr FD
 273         -> IO PHANDLE
 274
 275 #endif
 276
 277 fdToHandle :: Ptr FD -> IOMode -> IO Handle
 278 fdToHandle pfd mode = do
 279   fd <- peek pfd
 280   openFd fd (Just Stream)
 281 #if __GLASGOW_HASKELL__ >= 603
 282      False{-not a socket-}
 283 #endif
 284      ("fd:" ++ show fd) mode True{-binary-} False{-no truncate-}
 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_TARGET_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_TARGET_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_TARGET_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