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      False{-not a socket-}
 282      ("fd:" ++ show fd) mode True{-binary-}
 283
 284 -- ----------------------------------------------------------------------------
 285 -- waitForProcess
 286
 287 {- | Waits for the specified process to terminate, and returns its exit code.
 288
 289      GHC Note: in order to call waitForProcess without blocking all the
 290      other threads in the system, you must compile the program with
 291      @-threaded@.
 292 -}
 293 waitForProcess
 294   :: ProcessHandle
 295   -> IO ExitCode
 296 waitForProcess (ProcessHandle handle) = do
 297   code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle)
 298   if (code == 0)
 299     then return ExitSuccess
 300     else return (ExitFailure (fromIntegral code))
 301
 302 -- ----------------------------------------------------------------------------
 303 -- terminateProcess
 304
 305 -- | Attempts to terminate the specified process.  This function should
 306 -- not be used under normal circumstances - no guarantees are given regarding
 307 -- how cleanly the process is terminated.  To check whether the process
 308 -- has indeed terminated, use 'getProcessExitCode'.
 309 --
 310 -- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal.
 311 -- On Windows systems, the Win32 @TerminateProcess@ function is called, passing
 312 -- an exit code of 1.
 313 terminateProcess :: ProcessHandle -> IO ()
 314 terminateProcess (ProcessHandle pid) =
 315   throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid)
 316
 317 -- ----------------------------------------------------------------------------
 318 -- getProcessExitCode
 319
 320 {- | Verifies whether the process is completed and if it is then returns the exit code.
 321    If the process is still running the function returns Nothing
 322 -}
 323 getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode)
 324 getProcessExitCode (ProcessHandle handle) =
 325   alloca $ \pExitCode -> do
 326     res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode)
 327     code <- peek pExitCode
 328     if res == 0
 329       then return Nothing
 330       else if code == 0
 331              then return (Just ExitSuccess)
 332              else return (Just (ExitFailure (fromIntegral code)))
 333
 334 -- ----------------------------------------------------------------------------
 335 -- commandToProcess
 336
 337 {- | Turns a shell command into a raw command.  Usually this involves
 338      wrapping it in an invocation of the shell.
 339
 340    There's a difference in the signature of commandToProcess between
 341    the Windows and Unix versions.  On Unix, exec takes a list of strings,
 342    and we want to pass our command to /bin/sh as a single argument.
 343
 344    On Windows, CreateProcess takes a single string for the command,
 345    which is later decomposed by cmd.exe.  In this case, we just want
 346    to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line.  The
 347    command-line translation that we normally do for arguments on
 348    Windows isn't required (or desirable) here.
 349 -}
 350
 351 #if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
 352
 353 commandToProcess
 354   :: String
 355   -> IO (FilePath,[String])
 356 commandToProcess string = return ("/bin/sh", ["-c", string])
 357
 358 #else
 359
 360 commandToProcess
 361   :: String
 362   -> IO (FilePath,String)
 363 commandToProcess string = do
 364   sysDir <- allocaBytes 1024 (\pdir -> c_getSystemDirectory pdir 1024 >> peekCString pdir)
 365   return (sysDir ++ "\\CMD.EXE", "/c " ++ string)
 366         -- We don't want to put the cmd into a single
 367         -- argument, because cmd.exe will not try to split it up.  Instead,
 368         -- we just tack the command on the end of the cmd.exe command line,
 369         -- which partly works.  There seem to be some quoting issues, but
 370         -- I don't have the energy to find+fix them right now (ToDo). --SDM
 371
 372 foreign import stdcall unsafe "GetSystemDirectoryA"
 373   c_getSystemDirectory
 374         :: CString
 375         -> CInt
 376         -> IO CInt
 377
 378 #endif
 379
 380 -- ----------------------------------------------------------------------------
 381 -- Utils
 382
 383 withFilePathException :: FilePath -> IO a -> IO a
 384 withFilePathException fpath act = handle mapEx act
 385   where
 386     mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath))
 387     mapEx e                                       = throwIO e
 388
 389 #if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__)
 390 withCEnvironment :: [(String,String)] -> (Ptr CString  -> IO a) -> IO a
 391 withCEnvironment env act =
 392   let env' = map (\(name, val) -> name ++ ('=':val)) env
 393   in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
 394 #else
 395 withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a
 396 withCEnvironment env act =
 397   let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env
 398   in withCString env' (act . castPtr)
 399 #endif
 400
 401
 402 -- ----------------------------------------------------------------------------
 403 -- Interface to C bits
 404
 405 foreign import ccall unsafe "terminateProcess"
 406   c_terminateProcess
 407         :: PHANDLE
 408         -> IO CInt
 409
 410 foreign import ccall unsafe "getProcessExitCode"
 411   c_getProcessExitCode
 412         :: PHANDLE
 413         -> Ptr CInt
 414         -> IO CInt
 415
 416 foreign import ccall safe "waitForProcess" -- NB. safe - can block
 417   c_waitForProcess
 418         :: PHANDLE
 419         -> IO CInt
 420
 421 -- ------------------------------------------------------------------------
 422 -- Passing commands to the OS on Windows
 423
 424 {-
 425 On Windows this is tricky.  We use CreateProcess, passing a single
 426 command-line string (lpCommandLine) as its argument.  (CreateProcess
 427 is well documented on http://msdn.microsoft/com.)
 428
 429       - It parses the beginning of the string to find the command. If the
 430         file name has embedded spaces, it must be quoted, using double
 431         quotes thus
 432                 "foo\this that\cmd" arg1 arg2
 433
 434       - The invoked command can in turn access the entire lpCommandLine string,
 435         and the C runtime does indeed do so, parsing it to generate the
 436         traditional argument vector argv[0], argv[1], etc.  It does this
 437         using a complex and arcane set of rules which are described here:
 438
 439            http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp
 440
 441         (if this URL stops working, you might be able to find it by
 442         searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
 443         the code in the Microsoft C runtime that does this translation
 444         is shipped with VC++).
 445
 446 Our goal in runProcess is to take a command filename and list of
 447 arguments, and construct a string which inverts the translatsions
 448 described above, such that the program at the other end sees exactly
 449 the same arguments in its argv[] that we passed to rawSystem.
 450
 451 This inverse translation is implemented by 'translate' below.
 452
 453 Here are some pages that give informations on Windows-related
 454 limitations and deviations from Unix conventions:
 455
 456     http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
 457     Command lines and environment variables effectively limited to 8191
 458     characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):
 459
 460     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
 461     Command-line substitution under Windows XP. IIRC these facilities (or at
 462     least a large subset of them) are available on Win NT and 2000. Some
 463     might be available on Win 9x.
 464
 465     http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
 466     How CMD.EXE processes command lines.
 467
 468
 469 Note: CreateProcess does have a separate argument (lpApplicationName)
 470 with which you can specify the command, but we have to slap the
 471 command into lpCommandLine anyway, so that argv[0] is what a C program
 472 expects (namely the application name).  So it seems simpler to just
 473 use lpCommandLine alone, which CreateProcess supports.
 474 -}
 475
 476 #if defined(mingw32_TARGET_OS)
 477
 478 -- Translate command-line arguments for passing to CreateProcess().
 479 translate :: String -> String
 480 translate str = '"' : snd (foldr escape (True,"\"") str)
 481   where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
 482         escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
 483         escape '\\' (False, str) = (False, '\\' : str)
 484         escape c    (b,     str) = (False, c : str)
 485         -- See long comment above for what this function is trying to do.
 486         --
 487         -- The Bool passed back along the string is True iff the
 488         -- rest of the string is a sequence of backslashes followed by
 489         -- a double quote.
 490
 491 #endif