From: simonmar Date: Wed, 29 Sep 2004 15:50:53 +0000 (+0000) Subject: [project @ 2004-09-29 15:50:51 by simonmar] X-Git-Tag: nhc98-1-18-release~238 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=edad1f42b5dfea7aaf640aaae808c14e6138551a;p=ghc-base.git [project @ 2004-09-29 15:50:51 by simonmar] Process reorganisation: the System.Process library moves into base, and System.Cmd is re-implemented in terms of it. Thanks to Krasimir Angelov, we have a version of System.Process that doesn't rely on the unix or Win32 libraries. Normally using unix/Win32 would be the right thing, but since we want to implement System.Cmd on top of this, and GHC uses System.Cmd, we can't introduce a bunch of .hsc dependencies into GHC's bootstrap libraries. So, the new version is larger, but has fewer dependencies. I imagine it shouldn't be too hard to port to other compilers. --- diff --git a/Makefile b/Makefile index d15b13e..8661f0c 100644 --- a/Makefile +++ b/Makefile @@ -26,6 +26,7 @@ ALL_DIRS = \ System/Mem \ System/IO \ System/Posix \ + System/Process \ Text \ Text/Html \ Text/PrettyPrint \ diff --git a/System/Cmd.hs b/System/Cmd.hs index 5838f85..ceb0bbe 100644 --- a/System/Cmd.hs +++ b/System/Cmd.hs @@ -22,11 +22,9 @@ module System.Cmd import Prelude #ifdef __GLASGOW_HASKELL__ -import Foreign -import Foreign.C -import System.Exit -import GHC.IOBase -#include "ghcconfig.h" +import System.Process +import System.Exit ( ExitCode ) +import GHC.IOBase ( ioException, IOException(..), IOErrorType(..) ) #endif #ifdef __HUGS__ @@ -63,19 +61,12 @@ passes the command to the Windows command interpreter (@CMD.EXE@ or #ifdef __GLASGOW_HASKELL__ system :: String -> IO ExitCode system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing) -system cmd = - withCString cmd $ \s -> do - status <- throwErrnoIfMinus1 "system" (primSystem s) - case status of - 0 -> return ExitSuccess - n -> return (ExitFailure n) - -foreign import ccall unsafe "systemCmd" primSystem :: CString -> IO Int - --- --------------------------------------------------------------------------- --- rawSystem - --- rawSystem is in a separate file, so we can #include it various places. -#include "RawSystem.hs-inc" - +system cmd = do + p <- runCommand cmd + waitForProcess p + +rawSystem :: String -> [String] -> IO ExitCode +rawSystem cmd args = do + p <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing + waitForProcess p #endif /* __GLASGOW_HASKELL__ */ diff --git a/System/Process.hsc b/System/Process.hsc new file mode 100644 index 0000000..e349d9b --- /dev/null +++ b/System/Process.hsc @@ -0,0 +1,493 @@ +{-# OPTIONS -cpp -fffi #-} +----------------------------------------------------------------------------- +-- | +-- Module : System.Process +-- Copyright : (c) The University of Glasgow 2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Operations for creating and interacting with sub-processes. +-- +----------------------------------------------------------------------------- + +-- ToDo: +-- * Flag to control whether exiting the parent also kills the child. +-- * Windows impl of runProcess should close the Handles. +-- * Add system/rawSystem replacements + +{- NOTES on createPipe: + + createPipe is no longer exported, because of the following problems: + + - it wasn't used to implement runInteractiveProcess on Unix, because + the file descriptors for the unused ends of the pipe need to be closed + in the child process. + + - on Windows, a special version of createPipe is needed that sets + the inheritance flags correctly on the ends of the pipe (see + mkAnonPipe below). +-} + +module System.Process ( + -- * Running sub-processes + ProcessHandle, + runCommand, + runProcess, + runInteractiveCommand, + runInteractiveProcess, + + -- * Process completion + waitForProcess, + getProcessExitCode, + terminateProcess, + ) where + +import System.Process.Internals + +import Foreign +import Foreign.C +import Data.Maybe ( fromMaybe ) +import System.IO ( IOMode(..), Handle ) +import System.Exit ( ExitCode(..) ) +import Control.Exception ( handle, throwIO ) + +import System.Posix.Internals +import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) ) +import GHC.Handle ( stdin, stdout, stderr, withHandle_, openFd ) + +-- ---------------------------------------------------------------------------- +-- runCommand + +{- | Runs a command using the shell. + -} +runCommand + :: String + -> IO ProcessHandle + +runCommand string = do + (cmd,args) <- commandToProcess string +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) + runProcess1 "runProcess" cmd args Nothing Nothing Nothing Nothing Nothing +#else + runProcess1 "runProcess" cmd [] Nothing Nothing Nothing Nothing Nothing args +#endif + +-- ---------------------------------------------------------------------------- +-- runProcess + +{- | Runs a raw command, optionally specifying 'Handle's from which to + take the @stdin@, @stdout@ and @stderr@ channels for the new + process. + + Any 'Handle's passed to 'runProcess' are placed immediately in the + closed state, so may no longer be referenced by the Haskell process. +-} +runProcess + :: FilePath -- ^ Filename of the executable + -> [String] -- ^ Arguments to pass to the executable + -> Maybe FilePath -- ^ Optional path to the working directory + -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit) + -> Maybe Handle -- ^ Handle to use for @stdin@ + -> Maybe Handle -- ^ Handle to use for @stdout@ + -> Maybe Handle -- ^ Handle to use for @stderr@ + -> IO ProcessHandle + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) + +runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr + = runProcess1 "runProcess" cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr + +runProcess1 fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr + = withFilePathException cmd $ + withHandle_ fun (fromMaybe stdin mb_stdin) $ \hndStdInput -> + withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput -> + withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError -> + maybeWith withCEnvironment mb_env $ \pEnv -> + maybeWith withCString mb_cwd $ \pWorkDir -> + withMany withCString (cmd:args) $ \cstrs -> + withArray0 nullPtr cstrs $ \pargs -> do + ph <- throwErrnoIfMinus1 fun + (c_runProcess pargs pWorkDir pEnv + (haFD hndStdInput) + (haFD hndStdOutput) + (haFD hndStdError)) + return (ProcessHandle ph) + +foreign import ccall unsafe "runProcess" + c_runProcess + :: Ptr CString -- args + -> CString -- working directory (or NULL) + -> Ptr CString -- env (or NULL) + -> FD -- stdin + -> FD -- stdout + -> FD -- stderr + -> IO PHANDLE + +#else + +runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = + runProcess1 "runProcess" cmd args mb_cwd mb_env + mb_stdin mb_stdout mb_stderr "" + +runProcess1 fun cmd args mb_cwd mb_env + mb_stdin mb_stdout mb_stderr extra_cmdline + = withFilePathException cmd $ + withHandle_ fun (fromMaybe stdin mb_stdin) $ \hndStdInput -> + withHandle_ fun (fromMaybe stdout mb_stdout) $ \hndStdOutput -> + withHandle_ fun (fromMaybe stderr mb_stderr) $ \hndStdError -> + maybeWith withCEnvironment mb_env $ \pEnv -> do + maybeWith withCString mb_cwd $ \pWorkDir -> do + let cmdline = translate cmd ++ + concat (map ((' ':) . translate) args) ++ + (if null extra_cmdline then "" else ' ':extra_cmdline) + withCString cmdline $ \pcmdline -> do + proc_handle <- throwErrnoIfMinus1 fun + (c_runProcess pcmdline pWorkDir pEnv + (haFD hndStdInput) + (haFD hndStdOutput) + (haFD hndStdError)) + return (ProcessHandle proc_handle) + +foreign import ccall unsafe "runProcess" + c_runProcess + :: CString + -> CString + -> Ptr () + -> FD + -> FD + -> FD + -> IO PHANDLE + + -- Set the standard HANDLEs for the child process appropriately. NOTE: + -- this relies on the HANDLEs being inheritable. By default, the + -- runtime open() function creates inheritable handles (unless O_NOINHERIT + -- is specified). But perhaps we should DuplicateHandle() to make sure + -- the handle is inheritable? +#endif + +-- ---------------------------------------------------------------------------- +-- runInteractiveCommand + +{- | Runs a command using the shell, and returns 'Handle's that may + be used to communicate with the process via its @stdin@, @stdout@, + and @stderr@ respectively. +-} +runInteractiveCommand + :: String + -> IO (Handle,Handle,Handle,ProcessHandle) + +runInteractiveCommand string = do + (cmd,args) <- commandToProcess string +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) + runInteractiveProcess1 "runInteractiveCommand" cmd args Nothing Nothing +#else + runInteractiveProcess1 "runInteractiveCommand" cmd [] Nothing Nothing args +#endif + +-- ---------------------------------------------------------------------------- +-- runInteractiveProcess + +{- | Runs a raw command, and returns 'Handle's that may be used to communicate + with the process via its @stdin@, @stdout@ and @stderr@ respectively. + + For example, to start a process and feed a string to its stdin: + +> (in,out,err,pid) <- runInteractiveProcess "..." +> forkIO (hPutStr in str) +-} +runInteractiveProcess + :: FilePath -- ^ Filename of the executable + -> [String] -- ^ Arguments to pass to the executable + -> Maybe FilePath -- ^ Optional path to the working directory + -> Maybe [(String,String)] -- ^ Optional environment (otherwise inherit) + -> IO (Handle,Handle,Handle,ProcessHandle) + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) + +runInteractiveProcess cmd args mb_cwd mb_env = + runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env + +runInteractiveProcess1 fun cmd args mb_cwd mb_env = do + withFilePathException cmd $ + alloca $ \ pfdStdInput -> + alloca $ \ pfdStdOutput -> + alloca $ \ pfdStdError -> + maybeWith withCEnvironment mb_env $ \pEnv -> + maybeWith withCString mb_cwd $ \pWorkDir -> + withMany withCString (cmd:args) $ \cstrs -> + withArray0 nullPtr cstrs $ \pargs -> do + proc_handle <- throwErrnoIfMinus1 fun + (c_runInteractiveProcess pargs pWorkDir pEnv + pfdStdInput pfdStdOutput pfdStdError) + hndStdInput <- fdToHandle pfdStdInput WriteMode + hndStdOutput <- fdToHandle pfdStdOutput ReadMode + hndStdError <- fdToHandle pfdStdError ReadMode + return (hndStdInput, hndStdOutput, hndStdError, ProcessHandle proc_handle) + +foreign import ccall unsafe "runInteractiveProcess" + c_runInteractiveProcess + :: Ptr CString + -> CString + -> Ptr CString + -> Ptr FD + -> Ptr FD + -> Ptr FD + -> IO PHANDLE + +#else + +runInteractiveProcess cmd args mb_cwd mb_env = + runInteractiveProcess1 "runInteractiveProcess" cmd args mb_cwd mb_env "" + +runInteractiveProcess1 fun cmd args workDir env extra_cmdline + = withFilePathException cmd $ do + let cmdline = translate cmd ++ + concat (map ((' ':) . translate) args) ++ + (if null extra_cmdline then "" else ' ':extra_cmdline) + withCString cmdline $ \pcmdline -> + alloca $ \ pfdStdInput -> + alloca $ \ pfdStdOutput -> + alloca $ \ pfdStdError -> do + maybeWith withCEnvironment env $ \pEnv -> do + maybeWith withCString workDir $ \pWorkDir -> do + proc_handle <- throwErrnoIfMinus1 fun $ + c_runInteractiveProcess pcmdline pWorkDir pEnv + pfdStdInput pfdStdOutput pfdStdError + hndStdInput <- fdToHandle pfdStdInput WriteMode + hndStdOutput <- fdToHandle pfdStdOutput ReadMode + hndStdError <- fdToHandle pfdStdError ReadMode + return (hndStdInput, hndStdOutput, hndStdError, + ProcessHandle proc_handle) + +foreign import ccall unsafe "runInteractiveProcess" + c_runInteractiveProcess + :: CString + -> CString + -> Ptr () + -> Ptr FD + -> Ptr FD + -> Ptr FD + -> IO PHANDLE + +#endif + +fdToHandle :: Ptr FD -> IOMode -> IO Handle +fdToHandle pfd mode = do + fd <- peek pfd + openFd fd (Just Stream) +#if __GLASGOW_HASKELL__ >= 603 + False{-not a socket-} +#endif + ("fd:" ++ show fd) mode True{-binary-} False{-no truncate-} + +-- ---------------------------------------------------------------------------- +-- waitForProcess + +{- | Waits for the specified process to terminate, and returns its exit code. + + GHC Note: in order to call waitForProcess without blocking all the + other threads in the system, you must compile the program with + @-threaded@. +-} +waitForProcess + :: ProcessHandle + -> IO ExitCode +waitForProcess (ProcessHandle handle) = do + code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess handle) + if (code == 0) + then return ExitSuccess + else return (ExitFailure (fromIntegral code)) + +-- ---------------------------------------------------------------------------- +-- terminateProcess + +-- | Attempts to terminate the specified process. This function should +-- not be used under normal circumstances - no guarantees are given regarding +-- how cleanly the process is terminated. To check whether the process +-- has indeed terminated, use 'getProcessExitCode'. +-- +-- On Unix systems, 'terminateProcess' sends the process the SIGKILL signal. +-- On Windows systems, the Win32 @TerminateProcess@ function is called, passing +-- an exit code of 1. +terminateProcess :: ProcessHandle -> IO () +terminateProcess (ProcessHandle pid) = + throwErrnoIfMinus1_ "terminateProcess" (c_terminateProcess pid) + +-- ---------------------------------------------------------------------------- +-- getProcessExitCode + +{- | Verifies whether the process is completed and if it is then returns the exit code. + If the process is still running the function returns Nothing +-} +getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) +getProcessExitCode (ProcessHandle handle) = + alloca $ \pExitCode -> do + res <- throwErrnoIfMinus1 "getProcessExitCode" (c_getProcessExitCode handle pExitCode) + code <- peek pExitCode + if res == 0 + then return Nothing + else if code == 0 + then return (Just ExitSuccess) + else return (Just (ExitFailure (fromIntegral code))) + +-- ---------------------------------------------------------------------------- +-- commandToProcess + +{- | Turns a shell command into a raw command. Usually this involves + wrapping it in an invocation of the shell. + + There's a difference in the signature of commandToProcess between + the Windows and Unix versions. On Unix, exec takes a list of strings, + and we want to pass our command to /bin/sh as a single argument. + + On Windows, CreateProcess takes a single string for the command, + which is later decomposed by cmd.exe. In this case, we just want + to prepend "c:\WINDOWS\CMD.EXE /c" to our command line. The + command-line translation that we normally do for arguments on + Windows isn't required (or desirable) here. +-} + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) + +commandToProcess + :: String + -> IO (FilePath,[String]) +commandToProcess string = return ("/bin/sh", ["-c", string]) + +#else + +commandToProcess + :: String + -> IO (FilePath,String) +commandToProcess string = do + sysDir <- allocaBytes 1024 (\pdir -> c_getSystemDirectory pdir 1024 >> peekCString pdir) + return (sysDir ++ "\\CMD.EXE", "/c " ++ string) + -- We don't want to put the cmd into a single + -- argument, because cmd.exe will not try to split it up. Instead, + -- we just tack the command on the end of the cmd.exe command line, + -- which partly works. There seem to be some quoting issues, but + -- I don't have the energy to find+fix them right now (ToDo). --SDM + +foreign import stdcall unsafe "GetSystemDirectoryA" + c_getSystemDirectory + :: CString + -> CInt + -> IO CInt + +#endif + +-- ---------------------------------------------------------------------------- +-- Utils + +withFilePathException :: FilePath -> IO a -> IO a +withFilePathException fpath act = handle mapEx act + where + mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath)) + mapEx e = throwIO e + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) +withCEnvironment :: [(String,String)] -> (Ptr CString -> IO a) -> IO a +withCEnvironment env act = + let env' = map (\(name, val) -> name ++ ('=':val)) env + in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act) +#else +withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a +withCEnvironment env act = + let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env + in withCString env' (act . castPtr) +#endif + + +-- ---------------------------------------------------------------------------- +-- Interface to C bits + +foreign import ccall unsafe "terminateProcess" + c_terminateProcess + :: PHANDLE + -> IO CInt + +foreign import ccall unsafe "getProcessExitCode" + c_getProcessExitCode + :: PHANDLE + -> Ptr CInt + -> IO CInt + +foreign import ccall safe "waitForProcess" -- NB. safe - can block + c_waitForProcess + :: PHANDLE + -> IO CInt + +-- ------------------------------------------------------------------------ +-- Passing commands to the OS on Windows + +{- +On Windows this is tricky. We use CreateProcess, passing a single +command-line string (lpCommandLine) as its argument. (CreateProcess +is well documented on http://msdn.microsoft/com.) + + - It parses the beginning of the string to find the command. If the + file name has embedded spaces, it must be quoted, using double + quotes thus + "foo\this that\cmd" arg1 arg2 + + - The invoked command can in turn access the entire lpCommandLine string, + and the C runtime does indeed do so, parsing it to generate the + traditional argument vector argv[0], argv[1], etc. It does this + using a complex and arcane set of rules which are described here: + + http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp + + (if this URL stops working, you might be able to find it by + searching for "Parsing C Command-Line Arguments" on MSDN. Also, + the code in the Microsoft C runtime that does this translation + is shipped with VC++). + +Our goal in runProcess is to take a command filename and list of +arguments, and construct a string which inverts the translatsions +described above, such that the program at the other end sees exactly +the same arguments in its argv[] that we passed to rawSystem. + +This inverse translation is implemented by 'translate' below. + +Here are some pages that give informations on Windows-related +limitations and deviations from Unix conventions: + + http://support.microsoft.com/default.aspx?scid=kb;en-us;830473 + Command lines and environment variables effectively limited to 8191 + characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x): + + http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp + Command-line substitution under Windows XP. IIRC these facilities (or at + least a large subset of them) are available on Win NT and 2000. Some + might be available on Win 9x. + + http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp + How CMD.EXE processes command lines. + + +Note: CreateProcess does have a separate argument (lpApplicationName) +with which you can specify the command, but we have to slap the +command into lpCommandLine anyway, so that argv[0] is what a C program +expects (namely the application name). So it seems simpler to just +use lpCommandLine alone, which CreateProcess supports. +-} + +#if defined(mingw32_TARGET_OS) + +-- Translate command-line arguments for passing to CreateProcess(). +translate :: String -> String +translate str = '"' : snd (foldr escape (True,"\"") str) + where escape '"' (b, str) = (True, '\\' : '"' : str) + escape '\\' (True, str) = (True, '\\' : '\\' : str) + escape '\\' (False, str) = (False, '\\' : str) + escape c (b, str) = (False, c : str) + -- See long comment above for what this function is trying to do. + -- + -- The Bool passed back along the string is True iff the + -- rest of the string is a sequence of backslashes followed by + -- a double quote. + +#endif diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs new file mode 100644 index 0000000..09aa376 --- /dev/null +++ b/System/Process/Internals.hs @@ -0,0 +1,43 @@ +{-# OPTIONS -cpp -fffi #-} +----------------------------------------------------------------------------- +-- | +-- Module : System.Process.Internals +-- Copyright : (c) The University of Glasgow 2004 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : experimental +-- Portability : portable +-- +-- Operations for creating and interacting with sub-processes. +-- +----------------------------------------------------------------------------- + +-- #hide +module System.Process.Internals ( + ProcessHandle(..), PHANDLE, + ) where + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) +import System.Posix.Types ( CPid ) +#else +import Data.Word ( Word32 ) +#endif + +-- ---------------------------------------------------------------------------- +-- ProcessHandle type + +{- | A handle to a process, which can be used to wait for termination + of the process using 'waitForProcess'. + + None of the process-creation functions in this library wait for + termination: they all return a 'ProcessHandle' which may be used + to wait for the process later. +-} +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) +type PHANDLE = CPid +#else +type PHANDLE = Word32 +#endif + +newtype ProcessHandle = ProcessHandle PHANDLE diff --git a/cbits/Makefile b/cbits/Makefile index 024734e..0bf0133 100644 --- a/cbits/Makefile +++ b/cbits/Makefile @@ -1,4 +1,4 @@ -# $Id: Makefile,v 1.11 2004/08/16 11:08:47 simonmar Exp $ +# $Id: Makefile,v 1.12 2004/09/29 15:50:51 simonmar Exp $ TOP = ../.. include $(TOP)/mk/boilerplate.mk @@ -14,7 +14,7 @@ SRC_CC_OPTS += -Iregex EXCLUDED_SRCS += regex/engine.c endif -EXCLUDED_SRCS += ilxstubs.c +EXCLUDED_SRCS += rawSystem.c ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32" EXCLUDED_SRCS += consUtils.c diff --git a/cbits/execvpe.c b/cbits/execvpe.c new file mode 100644 index 0000000..f19f9d7 --- /dev/null +++ b/cbits/execvpe.c @@ -0,0 +1,170 @@ +/* ----------------------------------------------------------------------------- + (c) The University of Glasgow 1995-2004 + + Our low-level exec() variant. + -------------------------------------------------------------------------- */ + +/* Evidently non-Posix. */ +/* #include "PosixSource.h" */ + +#include +#include +#include +#include +#include + +/* + * We want the search semantics of execvp, but we want to provide our + * own environment, like execve. The following copyright applies to + * this code, as it is a derivative of execvp: + *- + * Copyright (c) 1991 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. All advertising materials mentioning features or use of this software + * must display the following acknowledgement: + * This product includes software developed by the University of + * California, Berkeley and its contributors. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +int +execvpe(char *name, char **argv, char **envp) +{ + register int lp, ln; + register char *p; + int eacces=0, etxtbsy=0; + char *bp, *cur, *path, *buf = 0; + + /* If it's an absolute or relative path name, it's easy. */ + if (strchr(name, '/')) { + bp = (char *) name; + cur = path = buf = NULL; + goto retry; + } + + /* Get the path we're searching. */ + if (!(path = getenv("PATH"))) { +#ifdef HAVE_CONFSTR + ln = confstr(_CS_PATH, NULL, 0); + if ((cur = path = malloc(ln + 1)) != NULL) { + path[0] = ':'; + (void) confstr (_CS_PATH, path + 1, ln); + } +#else + if ((cur = path = malloc(1 + 1)) != NULL) { + path[0] = ':'; + path[1] = '\0'; + } +#endif + } else + cur = path = strdup(path); + + if (path == NULL || (bp = buf = malloc(strlen(path)+strlen(name)+2)) == NULL) + goto done; + + while (cur != NULL) { + p = cur; + if ((cur = strchr(cur, ':')) != NULL) + *cur++ = '\0'; + + /* + * It's a SHELL path -- double, leading and trailing colons mean the current + * directory. + */ + if (!*p) { + p = "."; + lp = 1; + } else + lp = strlen(p); + ln = strlen(name); + + memcpy(buf, p, lp); + buf[lp] = '/'; + memcpy(buf + lp + 1, name, ln); + buf[lp + ln + 1] = '\0'; + + retry: + (void) execve(bp, argv, envp); + switch (errno) { + case EACCES: + eacces = 1; + break; + case ENOENT: + break; + case ENOEXEC: + { + register size_t cnt; + register char **ap; + + for (cnt = 0, ap = (char **) argv; *ap; ++ap, ++cnt) + ; + if ((ap = malloc((cnt + 2) * sizeof(char *))) != NULL) { + memcpy(ap + 2, argv + 1, cnt * sizeof(char *)); + + ap[0] = "sh"; + ap[1] = bp; + (void) execve("/bin/sh", ap, envp); + free(ap); + } + goto done; + } + case ETXTBSY: + if (etxtbsy < 3) + (void) sleep(++etxtbsy); + goto retry; + default: + goto done; + } + } + if (eacces) + errno = EACCES; + else if (!errno) + errno = ENOENT; + done: + if (path) + free(path); + if (buf) + free(buf); + return (-1); +} + + +/* Copied verbatim from ghc/lib/std/cbits/system.c. */ +void pPrPr_disableITimers (void) +{ +# ifdef HAVE_SETITIMER + /* Reset the itimers in the child, so it doesn't get plagued + * by SIGVTALRM interrupts. + */ + struct timeval tv_null = { 0, 0 }; + struct itimerval itv; + itv.it_interval = tv_null; + itv.it_value = tv_null; + setitimer(ITIMER_REAL, &itv, NULL); + setitimer(ITIMER_VIRTUAL, &itv, NULL); + setitimer(ITIMER_PROF, &itv, NULL); +# endif +} diff --git a/cbits/rawSystem.c b/cbits/rawSystem.c index 0aac633..7af7747 100644 --- a/cbits/rawSystem.c +++ b/cbits/rawSystem.c @@ -1,6 +1,11 @@ /* * (c) The University of Glasgow 1994-2004 * + * WARNING: this file is here for backwards compatibility only. It is + * not included as part of the base package, but is #included into the + * compiler and the runghc utility when building either of these with + * an old version of GHC. + * * shell-less system Runtime Support (see System.Cmd.rawSystem). */ diff --git a/cbits/runProcess.c b/cbits/runProcess.c new file mode 100644 index 0000000..efe9ea9 --- /dev/null +++ b/cbits/runProcess.c @@ -0,0 +1,543 @@ +/* ---------------------------------------------------------------------------- + (c) The University of Glasgow 2004 + + Support for System.Process + ------------------------------------------------------------------------- */ + +#include "HsBase.h" + +#if defined(mingw32_TARGET_OS) +#include +#include +#endif + +#ifdef HAVE_VFORK_H +#include +#endif + +#ifdef HAVE_VFORK +#define fork vfork +#endif + +#ifdef HAVE_SIGNAL_H +#include +#endif + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) +/* ---------------------------------------------------------------------------- + UNIX versions + ------------------------------------------------------------------------- */ + +int +runProcess (char *const args[], char *workingDirectory, char **environment, + int fdStdInput, int fdStdOutput, int fdStdError) +{ + int pid; + struct sigaction dfl; + + switch(pid = fork()) + { + case -1: + return -1; + + case 0: + { + pPrPr_disableITimers(); + + if (workingDirectory) { + chdir (workingDirectory); + } + + /* + * Restore SIGINT and SIGQUIT to default actions + * + * Glyn Clemments writes: + * For your purposes, runProcess + waitForProcess is probably + * the way to go. Except that runProcess appears to be missing + * the usual signal handling. system() ignores SIGINT and + * SIGQUIT in the parent, and resets them to their defaults in + * the child; it also blocks SIGCHLD in the parent. runProcess + * may need to do something similar; it should probably at + * least reset SIGINT and SIGQUIT in the child, in case they + * are ignored in the parent. The parent can set up its own + * signal handling, but the only place it can control the + * child's signal handling is between the fork() and the + * exec(), so if runProcess doesn't do it, it won't get done. + */ + dfl.sa_handler = SIG_DFL; + (void)sigemptyset(&dfl.sa_mask); + dfl.sa_flags = 0; + (void)sigaction(SIGINT, &dfl, NULL); + (void)sigaction(SIGQUIT, &dfl, NULL); + + dup2 (fdStdInput, STDIN_FILENO); + dup2 (fdStdOutput, STDOUT_FILENO); + dup2 (fdStdError, STDERR_FILENO); + + if (environment) { + execvpe(args[0], args, environment); + } else { + execvp(args[0], args); + } + } + _exit(127); + } + + return pid; +} + +ProcHandle +runInteractiveProcess (char *const args[], + char *workingDirectory, char **environment, + int *pfdStdInput, int *pfdStdOutput, int *pfdStdError) +{ + int pid; + int fdStdInput[2], fdStdOutput[2], fdStdError[2]; + + pipe(fdStdInput); + pipe(fdStdOutput); + pipe(fdStdError); + + switch(pid = fork()) + { + case -1: + close(fdStdInput[0]); + close(fdStdInput[1]); + close(fdStdOutput[0]); + close(fdStdOutput[1]); + close(fdStdError[0]); + close(fdStdError[1]); + return -1; + + case 0: + { + pPrPr_disableITimers(); + + if (workingDirectory) { + chdir (workingDirectory); + } + + dup2 (fdStdInput[0], STDIN_FILENO); + dup2 (fdStdOutput[1], STDOUT_FILENO); + dup2 (fdStdError[1], STDERR_FILENO); + + close(fdStdInput[0]); + close(fdStdInput[1]); + close(fdStdOutput[0]); + close(fdStdOutput[1]); + close(fdStdError[0]); + close(fdStdError[1]); + + /* the child */ + if (environment) { + execvpe(args[0], args, environment); + } else { + execvp(args[0], args); + } + } + _exit(127); + + default: + close(fdStdInput[0]); + close(fdStdOutput[1]); + close(fdStdError[1]); + + *pfdStdInput = fdStdInput[1]; + *pfdStdOutput = fdStdOutput[0]; + *pfdStdError = fdStdError[0]; + break; + } + + return pid; +} + +int +terminateProcess (ProcHandle handle) +{ + return (kill(handle, SIGTERM) == 0); +} + +int +getProcessExitCode (ProcHandle handle, int *pExitCode) +{ + int wstat; + + *pExitCode = 0; + + if (waitpid(handle, &wstat, WNOHANG) > 0) + { + if (WIFEXITED(wstat)) + { + *pExitCode = WEXITSTATUS(wstat); + return 1; + } + else + if (WIFSIGNALED(wstat)) + { + errno = EINTR; + return -1; + } + else + { + /* This should never happen */ + } + } + + return 0; +} + +int waitForProcess (ProcHandle handle) +{ + int wstat; + + while (waitpid(handle, &wstat, 0) < 0) + { + if (errno != EINTR) + { + return -1; + } + } + + if (WIFEXITED(wstat)) + return WEXITSTATUS(wstat); + else + if (WIFSIGNALED(wstat)) + { + errno = EINTR; + } + else + { + /* This should never happen */ + } + + return -1; +} + +#else +/* ---------------------------------------------------------------------------- + Win32 versions + ------------------------------------------------------------------------- */ + +/* -------------------- WINDOWS VERSION --------------------- */ + +/* This is the error table that defines the mapping between OS error + codes and errno values */ + +struct errentry { + unsigned long oscode; /* OS return value */ + int errnocode; /* System V error code */ +}; + +static struct errentry errtable[] = { + { ERROR_INVALID_FUNCTION, EINVAL }, /* 1 */ + { ERROR_FILE_NOT_FOUND, ENOENT }, /* 2 */ + { ERROR_PATH_NOT_FOUND, ENOENT }, /* 3 */ + { ERROR_TOO_MANY_OPEN_FILES, EMFILE }, /* 4 */ + { ERROR_ACCESS_DENIED, EACCES }, /* 5 */ + { ERROR_INVALID_HANDLE, EBADF }, /* 6 */ + { ERROR_ARENA_TRASHED, ENOMEM }, /* 7 */ + { ERROR_NOT_ENOUGH_MEMORY, ENOMEM }, /* 8 */ + { ERROR_INVALID_BLOCK, ENOMEM }, /* 9 */ + { ERROR_BAD_ENVIRONMENT, E2BIG }, /* 10 */ + { ERROR_BAD_FORMAT, ENOEXEC }, /* 11 */ + { ERROR_INVALID_ACCESS, EINVAL }, /* 12 */ + { ERROR_INVALID_DATA, EINVAL }, /* 13 */ + { ERROR_INVALID_DRIVE, ENOENT }, /* 15 */ + { ERROR_CURRENT_DIRECTORY, EACCES }, /* 16 */ + { ERROR_NOT_SAME_DEVICE, EXDEV }, /* 17 */ + { ERROR_NO_MORE_FILES, ENOENT }, /* 18 */ + { ERROR_LOCK_VIOLATION, EACCES }, /* 33 */ + { ERROR_BAD_NETPATH, ENOENT }, /* 53 */ + { ERROR_NETWORK_ACCESS_DENIED, EACCES }, /* 65 */ + { ERROR_BAD_NET_NAME, ENOENT }, /* 67 */ + { ERROR_FILE_EXISTS, EEXIST }, /* 80 */ + { ERROR_CANNOT_MAKE, EACCES }, /* 82 */ + { ERROR_FAIL_I24, EACCES }, /* 83 */ + { ERROR_INVALID_PARAMETER, EINVAL }, /* 87 */ + { ERROR_NO_PROC_SLOTS, EAGAIN }, /* 89 */ + { ERROR_DRIVE_LOCKED, EACCES }, /* 108 */ + { ERROR_BROKEN_PIPE, EPIPE }, /* 109 */ + { ERROR_DISK_FULL, ENOSPC }, /* 112 */ + { ERROR_INVALID_TARGET_HANDLE, EBADF }, /* 114 */ + { ERROR_INVALID_HANDLE, EINVAL }, /* 124 */ + { ERROR_WAIT_NO_CHILDREN, ECHILD }, /* 128 */ + { ERROR_CHILD_NOT_COMPLETE, ECHILD }, /* 129 */ + { ERROR_DIRECT_ACCESS_HANDLE, EBADF }, /* 130 */ + { ERROR_NEGATIVE_SEEK, EINVAL }, /* 131 */ + { ERROR_SEEK_ON_DEVICE, EACCES }, /* 132 */ + { ERROR_DIR_NOT_EMPTY, ENOTEMPTY }, /* 145 */ + { ERROR_NOT_LOCKED, EACCES }, /* 158 */ + { ERROR_BAD_PATHNAME, ENOENT }, /* 161 */ + { ERROR_MAX_THRDS_REACHED, EAGAIN }, /* 164 */ + { ERROR_LOCK_FAILED, EACCES }, /* 167 */ + { ERROR_ALREADY_EXISTS, EEXIST }, /* 183 */ + { ERROR_FILENAME_EXCED_RANGE, ENOENT }, /* 206 */ + { ERROR_NESTING_NOT_ALLOWED, EAGAIN }, /* 215 */ + { ERROR_NOT_ENOUGH_QUOTA, ENOMEM } /* 1816 */ +}; + +/* size of the table */ +#define ERRTABLESIZE (sizeof(errtable)/sizeof(errtable[0])) + +/* The following two constants must be the minimum and maximum + values in the (contiguous) range of Exec Failure errors. */ +#define MIN_EXEC_ERROR ERROR_INVALID_STARTING_CODESEG +#define MAX_EXEC_ERROR ERROR_INFLOOP_IN_RELOC_CHAIN + +/* These are the low and high value in the range of errors that are + access violations */ +#define MIN_EACCES_RANGE ERROR_WRITE_PROTECT +#define MAX_EACCES_RANGE ERROR_SHARING_BUFFER_EXCEEDED + +static void maperrno (void) +{ + int i; + DWORD dwErrorCode; + + dwErrorCode = GetLastError(); + + /* check the table for the OS error code */ + for (i = 0; i < ERRTABLESIZE; ++i) + { + if (dwErrorCode == errtable[i].oscode) + { + errno = errtable[i].errnocode; + return; + } + } + + /* The error code wasn't in the table. We check for a range of */ + /* EACCES errors or exec failure errors (ENOEXEC). Otherwise */ + /* EINVAL is returned. */ + + if (dwErrorCode >= MIN_EACCES_RANGE && dwErrorCode <= MAX_EACCES_RANGE) + errno = EACCES; + else + if (dwErrorCode >= MIN_EXEC_ERROR && dwErrorCode <= MAX_EXEC_ERROR) + errno = ENOEXEC; + else + errno = EINVAL; +} + +/* + * Function: mkAnonPipe + * + * Purpose: create an anonymous pipe with read and write ends being + * optionally (non-)inheritable. + */ +static BOOL +mkAnonPipe (HANDLE* pHandleIn, BOOL isInheritableIn, + HANDLE* pHandleOut, BOOL isInheritableOut) +{ + HANDLE hTemporaryIn = NULL; + HANDLE hTemporaryOut = NULL; + BOOL status; + SECURITY_ATTRIBUTES sec_attrs; + + /* Create inheritable security attributes */ + sec_attrs.nLength = sizeof(SECURITY_ATTRIBUTES); + sec_attrs.lpSecurityDescriptor = NULL; + sec_attrs.bInheritHandle = TRUE; + + /* Create the anon pipe with both ends inheritable */ + if (!CreatePipe(&hTemporaryIn, &hTemporaryOut, &sec_attrs, 0)) + { + maperrno(); + *pHandleIn = NULL; + *pHandleOut = NULL; + return FALSE; + } + + if (isInheritableIn) + *pHandleIn = hTemporaryIn; + else + { + /* Make the read end non-inheritable */ + status = DuplicateHandle(GetCurrentProcess(), hTemporaryIn, + GetCurrentProcess(), pHandleIn, + 0, + FALSE, /* non-inheritable */ + DUPLICATE_SAME_ACCESS); + CloseHandle(hTemporaryIn); + if (!status) + { + maperrno(); + *pHandleIn = NULL; + *pHandleOut = NULL; + CloseHandle(hTemporaryOut); + return FALSE; + } + } + + if (isInheritableOut) + *pHandleOut = hTemporaryOut; + else + { + /* Make the write end non-inheritable */ + status = DuplicateHandle(GetCurrentProcess(), hTemporaryOut, + GetCurrentProcess(), pHandleOut, + 0, + FALSE, /* non-inheritable */ + DUPLICATE_SAME_ACCESS); + CloseHandle(hTemporaryOut); + if (!status) + { + maperrno(); + *pHandleIn = NULL; + *pHandleOut = NULL; + CloseHandle(*pHandleIn); + return FALSE; + } + } + + return TRUE; +} + +ProcHandle +runProcess (char *cmd, char *workingDirectory, void *environment, + int fdStdInput, int fdStdOutput, int fdStdError) +{ + STARTUPINFO sInfo; + PROCESS_INFORMATION pInfo; + DWORD flags; + + ZeroMemory(&sInfo, sizeof(sInfo)); + sInfo.cb = sizeof(sInfo); + sInfo.dwFlags = STARTF_USESTDHANDLES; + sInfo.hStdInput = (HANDLE) _get_osfhandle(fdStdInput); + sInfo.hStdOutput= (HANDLE) _get_osfhandle(fdStdOutput); + sInfo.hStdError = (HANDLE) _get_osfhandle(fdStdError); + + if (sInfo.hStdOutput != GetStdHandle(STD_OUTPUT_HANDLE) && + sInfo.hStdError != GetStdHandle(STD_ERROR_HANDLE)) + flags = CREATE_NO_WINDOW; // Run without console window only when both output and error are redirected + else + flags = 0; + + if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, flags, environment, workingDirectory, &sInfo, &pInfo)) + { + maperrno(); + return -1; + } + + CloseHandle(pInfo.hThread); + return (ProcHandle)pInfo.hProcess; +} + +ProcHandle +runInteractiveProcess (char *cmd, char *workingDirectory, void *environment, + int *pfdStdInput, int *pfdStdOutput, int *pfdStdError) +{ + STARTUPINFO sInfo; + PROCESS_INFORMATION pInfo; + HANDLE hStdInputRead, hStdInputWrite; + HANDLE hStdOutputRead, hStdOutputWrite; + HANDLE hStdErrorRead, hStdErrorWrite; + + if (!mkAnonPipe(&hStdInputRead, TRUE, &hStdInputWrite, FALSE)) + return -1; + + if (!mkAnonPipe(&hStdOutputRead, FALSE, &hStdOutputWrite, TRUE)) + { + CloseHandle(hStdInputRead); + CloseHandle(hStdInputWrite); + return -1; + } + + if (!mkAnonPipe(&hStdErrorRead, FALSE, &hStdErrorWrite, TRUE)) + { + CloseHandle(hStdInputRead); + CloseHandle(hStdInputWrite); + CloseHandle(hStdOutputRead); + CloseHandle(hStdOutputWrite); + return -1; + } + + ZeroMemory(&sInfo, sizeof(sInfo)); + sInfo.cb = sizeof(sInfo); + sInfo.dwFlags = STARTF_USESTDHANDLES; + sInfo.hStdInput = hStdInputRead; + sInfo.hStdOutput= hStdOutputWrite; + sInfo.hStdError = hStdErrorWrite; + + if (!CreateProcess(NULL, cmd, NULL, NULL, TRUE, CREATE_NO_WINDOW, environment, workingDirectory, &sInfo, &pInfo)) + { + maperrno(); + CloseHandle(hStdInputRead); + CloseHandle(hStdInputWrite); + CloseHandle(hStdOutputRead); + CloseHandle(hStdOutputWrite); + CloseHandle(hStdErrorRead); + CloseHandle(hStdErrorWrite); + return -1; + } + CloseHandle(pInfo.hThread); + + // Close the ends of the pipes that were inherited by the + // child process. This is important, otherwise we won't see + // EOF on these pipes when the child process exits. + CloseHandle(hStdInputRead); + CloseHandle(hStdOutputWrite); + CloseHandle(hStdErrorWrite); + + *pfdStdInput = _open_osfhandle((intptr_t) hStdInputWrite, _O_WRONLY); + *pfdStdOutput = _open_osfhandle((intptr_t) hStdOutputRead, _O_RDONLY); + *pfdStdError = _open_osfhandle((intptr_t) hStdErrorRead, _O_RDONLY); + + return (int) pInfo.hProcess; +} + +int +terminateProcess (ProcHandle handle) +{ + if (!TerminateProcess((HANDLE) handle, 1)) { + maperrno(); + return -1; + } + + CloseHandle((HANDLE) handle); + return 0; +} + +int +getProcessExitCode (ProcHandle handle, int *pExitCode) +{ + *pExitCode = 0; + + if (WaitForSingleObject((HANDLE) handle, 1) == WAIT_OBJECT_0) + { + if (GetExitCodeProcess((HANDLE) handle, (DWORD *) pExitCode) == 0) + { + maperrno(); + return -1; + } + + CloseHandle((HANDLE) handle); + return 1; + } + + return 0; +} + +int +waitForProcess (ProcHandle handle) +{ + DWORD retCode; + + if (WaitForSingleObject((HANDLE) handle, INFINITE) == WAIT_OBJECT_0) + { + if (GetExitCodeProcess((HANDLE) handle, &retCode) == 0) + { + maperrno(); + return -1; + } + + CloseHandle((HANDLE) handle); + return retCode; + } + + maperrno(); + return -1; +} + +#endif // Win32 diff --git a/cbits/system.c b/cbits/system.c deleted file mode 100644 index 34a6f23..0000000 --- a/cbits/system.c +++ /dev/null @@ -1,80 +0,0 @@ -/* - * (c) The University of Glasgow 2002 - * - * $Id: system.c,v 1.8 2003/07/02 13:27:35 stolz Exp $ - * - * system Runtime Support - */ - -/* The itimer stuff in this module is non-posix */ -// #include "PosixSource.h" - -#include "HsBase.h" - -#if defined(mingw32_TARGET_OS) -#include -#include -#endif - -#ifdef HAVE_VFORK_H -#include -#endif - -#ifdef HAVE_VFORK -#define fork vfork -#endif - -HsInt -systemCmd(HsAddr cmd) -{ - /* -------------------- WINDOWS VERSION --------------------- */ -#if defined(mingw32_TARGET_OS) || defined(cygwin32_TARGET_OS) - return system(cmd); -#else - /* -------------------- UNIX VERSION --------------------- */ - int pid; - int wstat; - - switch(pid = fork()) { - case -1: - { - return -1; - } - case 0: - { -#ifdef HAVE_SETITIMER - /* Reset the itimers in the child, so it doesn't get plagued - * by SIGVTALRM interrupts. - */ - struct timeval tv_null = { 0, 0 }; - struct itimerval itv; - itv.it_interval = tv_null; - itv.it_value = tv_null; - setitimer(ITIMER_REAL, &itv, NULL); - setitimer(ITIMER_VIRTUAL, &itv, NULL); - setitimer(ITIMER_PROF, &itv, NULL); -#endif - - /* the child */ - execl("/bin/sh", "sh", "-c", cmd, NULL); - _exit(127); - } - } - - while (waitpid(pid, &wstat, 0) < 0) { - if (errno != EINTR) { - return -1; - } - } - - if (WIFEXITED(wstat)) - return WEXITSTATUS(wstat); - else if (WIFSIGNALED(wstat)) { - errno = EINTR; - } - else { - /* This should never happen */ - } - return -1; -#endif -} diff --git a/include/HsBase.h b/include/HsBase.h index 2e27492..c4f0116 100644 --- a/include/HsBase.h +++ b/include/HsBase.h @@ -1,6 +1,6 @@ /* ----------------------------------------------------------------------------- * - * (c) The University of Glasgow 2001-2002 + * (c) The University of Glasgow 2001-2004 * * Definitions for package `base' which are visible in Haskell land. * @@ -109,6 +109,8 @@ #include "lockFile.h" #include "dirUtils.h" +#include "runProcess.h" + #if defined(mingw32_TARGET_OS) #include #include @@ -116,16 +118,6 @@ #include #endif -/* in system.c */ -HsInt systemCmd(HsAddr cmd); - -/* in rawSystem.c */ -#if defined(mingw32_TARGET_OS) -HsInt rawSystem(HsAddr cmd); -#else -HsInt rawSystem(HsAddr cmd, HsAddr args); -#endif - /* in inputReady.c */ int inputReady(int fd, int msecs, int isSock); @@ -135,6 +127,10 @@ void writeErrString__(HsAddr msg, HsInt len); /* in Signals.c */ extern HsInt nocldstop; +/* in execvpe.c */ +extern int execvpe(char *name, char *const argv[], char **envp); +extern void pPrPr_disableITimers (void); + /* ----------------------------------------------------------------------------- 64-bit operations, defined in longlong.c -------------------------------------------------------------------------- */ diff --git a/include/runProcess.h b/include/runProcess.h new file mode 100644 index 0000000..fbbd4a5 --- /dev/null +++ b/include/runProcess.h @@ -0,0 +1,44 @@ +/* ---------------------------------------------------------------------------- + (c) The University of Glasgow 2004 + + Interface for code in runProcess.c (providing support for System.Process) + ------------------------------------------------------------------------- */ + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) +typedef pid_t ProcHandle; +#else +// Should really be intptr_t, but we don't have that type on the Haskell side +typedef long ProcHandle; +#endif + +#if !defined(mingw32_TARGET_OS) && !defined(__MINGW32__) + +extern ProcHandle runProcess( char *const args[], + char *workingDirectory, char **environment, + int fdStdInput, int fdStdOutput, int fdStdError); + +extern ProcHandle runInteractiveProcess( char *const args[], + char *workingDirectory, + char **environment, + int *pfdStdInput, + int *pfdStdOutput, + int *pfdStdError); + +#else + +extern ProcHandle runProcess( char *cmd, + char *workingDirectory, void *environment, + int fdStdInput, int fdStdOutput, int fdStdError); + +extern ProcHandle runInteractiveProcess( char *cmd, + char *workingDirectory, + void *environment, + int *pfdStdInput, + int *pfdStdOutput, + int *pfdStdError); + +#endif + +extern int terminateProcess( ProcHandle handle ); +extern int getProcessExitCode( ProcHandle handle, int *pExitCode ); +extern int waitForProcess( ProcHandle handle );