diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,63 @@ +This library (libraries/process) is derived from code from two +sources: + + * Code from the GHC project which is largely (c) The University of + Glasgow, and distributable under a BSD-style license (see below), + + * Code from the Haskell 98 Report which is (c) Simon Peyton Jones + and freely redistributable (but see the full license for + restrictions). + +The full text of these licenses is reproduced below. Both of the +licenses are BSD-style or compatible. + +----------------------------------------------------------------------------- + +The Glasgow Haskell Compiler License + +Copyright 2004, The University Court of the University of Glasgow. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- 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. + +- Neither 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 UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE 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 +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE 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. + +----------------------------------------------------------------------------- + +Code derived from the document "Report on the Programming Language +Haskell 98", is distributed under the following license: + + Copyright (c) 2002 Simon Peyton Jones + + The authors intend this Report to belong to the entire Haskell + community, and so we grant permission to copy and distribute it for + any purpose, provided that it is reproduced in its entirety, + including this Notice. Modified versions of this Report may also be + copied and distributed for any purpose, provided that the modified + version is clearly presented as such, and that it does not claim to + be a definition of the Haskell 98 Language. + +----------------------------------------------------------------------------- diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMainWithHooks defaultUserHooks diff --git a/System/Cmd.hs b/System/Cmd.hs new file mode 100644 --- /dev/null +++ b/System/Cmd.hs @@ -0,0 +1,144 @@ +----------------------------------------------------------------------------- +-- | +-- Module : System.Cmd +-- Copyright : (c) The University of Glasgow 2001 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : provisional +-- Portability : portable +-- +-- Executing an external command. +-- +-- This module provides a simple interface for executing external commands. +-- For a more complex, but more powerful, interface, see the "System.Process" +-- module. +-- +----------------------------------------------------------------------------- + +module System.Cmd + ( system, -- :: String -> IO ExitCode + rawSystem, -- :: FilePath -> [String] -> IO ExitCode + ) where + +import Prelude + +import System.Exit ( ExitCode ) + +#ifdef __GLASGOW_HASKELL__ +import System.Process +import GHC.IOBase ( ioException, IOException(..), IOErrorType(..) ) +#if !defined(mingw32_HOST_OS) +import System.Process.Internals +import System.Posix.Signals +#endif +#endif + +#ifdef __HUGS__ +import Hugs.System +#endif + +#ifdef __NHC__ +import System (system) +#endif + +-- --------------------------------------------------------------------------- +-- system + +{-| +Computation @system cmd@ returns the exit code +produced when the operating system processes the command @cmd@. + +This computation may fail with + + * @PermissionDenied@: The process has insufficient privileges to + perform the operation. + + * @ResourceExhausted@: Insufficient resources are available to + perform the operation. + + * @UnsupportedOperation@: The implementation does not support + system calls. + +On Windows, 'system' is implemented using Windows's native system +call, which ignores the @SHELL@ environment variable, and always +passes the command to the Windows command interpreter (@CMD.EXE@ or +@COMMAND.COM@), hence Unixy shell tricks will not work. +-} +#ifdef __GLASGOW_HASKELL__ +system :: String -> IO ExitCode +system "" = ioException (IOError Nothing InvalidArgument "system" "null command" Nothing) +system str = do +#if mingw32_HOST_OS + p <- runCommand str + waitForProcess p +#else + -- The POSIX version of system needs to do some manipulation of signal + -- handlers. Since we're going to be synchronously waiting for the child, + -- we want to ignore ^C in the parent, but handle it the default way + -- in the child (using SIG_DFL isn't really correct, it should be the + -- original signal handler, but the GHC RTS will have already set up + -- its own handler and we don't want to use that). + old_int <- installHandler sigINT Ignore Nothing + old_quit <- installHandler sigQUIT Ignore Nothing + (cmd,args) <- commandToProcess str + p <- runProcessPosix "runCommand" cmd args Nothing Nothing + Nothing Nothing Nothing + (Just defaultSignal) (Just defaultSignal) + r <- waitForProcess p + installHandler sigINT old_int Nothing + installHandler sigQUIT old_quit Nothing + return r +#endif /* mingw32_HOST_OS */ +#endif /* __GLASGOW_HASKELL__ */ + +{-| +The computation @'rawSystem' cmd args@ runs the operating system command +@cmd@ in such a way that it receives as arguments the @args@ strings +exactly as given, with no funny escaping or shell meta-syntax expansion. +It will therefore behave more portably between operating systems than 'system'. + +The return codes and possible failures are the same as for 'system'. +-} +rawSystem :: String -> [String] -> IO ExitCode +#ifdef __GLASGOW_HASKELL__ +rawSystem cmd args = do + +#if mingw32_HOST_OS + p <- runProcess cmd args Nothing Nothing Nothing Nothing Nothing + waitForProcess p +#else + old_int <- installHandler sigINT Ignore Nothing + old_quit <- installHandler sigQUIT Ignore Nothing + p <- runProcessPosix "rawSystem" cmd args Nothing Nothing + Nothing Nothing Nothing + (Just defaultSignal) (Just defaultSignal) + r <- waitForProcess p + installHandler sigINT old_int Nothing + installHandler sigQUIT old_quit Nothing + return r +#endif + +#elif !mingw32_HOST_OS +-- crude fallback implementation: could do much better than this under Unix +rawSystem cmd args = system (unwords (map translate (cmd:args))) + +translate :: String -> String +translate str = '\'' : foldr escape "'" str + where escape '\'' = showString "'\\''" + escape c = showChar c +#else /* mingw32_HOST_OS && ! __GLASGOW_HASKELL__ */ +# if __HUGS__ +rawSystem cmd args = system (unwords (cmd : map translate args)) +# else +rawSystem cmd args = system (unwords (map translate (cmd:args))) +#endif + +-- copied from System.Process (qv) +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) +#endif diff --git a/System/Process.hs b/System/Process.hs new file mode 100644 --- /dev/null +++ b/System/Process.hs @@ -0,0 +1,328 @@ +{-# OPTIONS_GHC -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. +-- +-- For a simpler, but less powerful, interface, see the "System.Cmd" module. +-- +----------------------------------------------------------------------------- + +-- 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 Prelude + +import System.Process.Internals + +import Foreign +import Foreign.C +import System.IO ( IOMode(..), Handle, hClose ) +import System.Exit ( ExitCode(..) ) + +import System.Posix.Internals +import GHC.IOBase ( FD ) +import GHC.Handle ( fdToHandle' ) + +-- ---------------------------------------------------------------------------- +-- runCommand + +{- | Runs a command using the shell. + -} +runCommand + :: String + -> IO ProcessHandle + +runCommand string = do + (cmd,args) <- commandToProcess string +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) + runProcessPosix "runCommand" cmd args Nothing Nothing Nothing Nothing Nothing + Nothing Nothing +#else + runProcessWin32 "runCommand" 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 (otherwise these handles are inherited from the current + process). + + Any 'Handle's passed to 'runProcess' are placed immediately in the + closed state. +-} +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 + +runProcess cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr = do +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) + h <- runProcessPosix "runProcess" cmd args mb_cwd mb_env + mb_stdin mb_stdout mb_stderr + Nothing Nothing +#else + h <- runProcessWin32 "runProcess" cmd args mb_cwd mb_env + mb_stdin mb_stdout mb_stderr "" +#endif + maybe (return ()) hClose mb_stdin + maybe (return ()) hClose mb_stdout + maybe (return ()) hClose mb_stderr + return h + +-- ---------------------------------------------------------------------------- +-- 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_HOST_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: + +> (inp,out,err,pid) <- runInteractiveProcess "..." +> forkIO (hPutStr inp 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_HOST_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 + ph <- mkProcessHandle proc_handle + return (hndStdInput, hndStdOutput, hndStdError, ph) + +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 + ph <- mkProcessHandle proc_handle + return (hndStdInput, hndStdOutput, hndStdError, ph) + +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 + fdToHandle' fd (Just Stream) + False{-not a socket-} + ("fd:" ++ show fd) mode True{-binary-} + +-- ---------------------------------------------------------------------------- +-- 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 ph = do + p_ <- withProcessHandle ph $ \p_ -> return (p_,p_) + case p_ of + ClosedHandle e -> return e + OpenHandle h -> do + -- don't hold the MVar while we call c_waitForProcess... + -- (XXX but there's a small race window here during which another + -- thread could close the handle or call waitForProcess) + code <- throwErrnoIfMinus1 "waitForProcess" (c_waitForProcess h) + withProcessHandle ph $ \p_ -> + case p_ of + ClosedHandle e -> return (p_,e) + OpenHandle ph -> do + closePHANDLE ph + let e = if (code == 0) + then ExitSuccess + else (ExitFailure (fromIntegral code)) + return (ClosedHandle e, e) + +-- ---------------------------------------------------------------------------- +-- 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 ph = do + withProcessHandle_ ph $ \p_ -> + case p_ of + ClosedHandle _ -> return p_ + OpenHandle h -> do + throwErrnoIfMinus1_ "terminateProcess" $ c_terminateProcess h + return p_ + -- does not close the handle, we might want to try terminating it + -- again, or get its exit code. + +-- ---------------------------------------------------------------------------- +-- getProcessExitCode + +{- | +This is a non-blocking version of 'waitForProcess'. If the process is +still running, 'Nothing' is returned. If the process has exited, then +@'Just' e@ is returned where @e@ is the exit code of the process. +Subsequent calls to @getProcessExitStatus@ always return @'Just' +'ExitSuccess'@, regardless of what the original exit code was. +-} +getProcessExitCode :: ProcessHandle -> IO (Maybe ExitCode) +getProcessExitCode ph = do + withProcessHandle ph $ \p_ -> + case p_ of + ClosedHandle e -> return (p_, Just e) + OpenHandle h -> + alloca $ \pExitCode -> do + res <- throwErrnoIfMinus1 "getProcessExitCode" $ + c_getProcessExitCode h pExitCode + code <- peek pExitCode + if res == 0 + then return (p_, Nothing) + else do + closePHANDLE h + let e | code == 0 = ExitSuccess + | otherwise = ExitFailure (fromIntegral code) + return (ClosedHandle e, Just e) + +-- ---------------------------------------------------------------------------- +-- 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 diff --git a/System/Process/Internals.hs b/System/Process/Internals.hs new file mode 100644 --- /dev/null +++ b/System/Process/Internals.hs @@ -0,0 +1,422 @@ +{-# OPTIONS_GHC -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 ( +#ifndef __HUGS__ + ProcessHandle(..), ProcessHandle__(..), + PHANDLE, closePHANDLE, mkProcessHandle, + withProcessHandle, withProcessHandle_, +#endif +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) + pPrPr_disableITimers, c_execvpe, +# ifdef __GLASGOW_HASKELL__ + runProcessPosix, +# endif + ignoreSignal, defaultSignal, +#else +# ifdef __GLASGOW_HASKELL__ + runProcessWin32, translate, +# endif +#endif +#ifndef __HUGS__ + commandToProcess, +#endif + withFilePathException, withCEnvironment + ) where + +import Prelude -- necessary to get dependencies right + +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +import System.Posix.Types ( CPid ) +import System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe ) +import System.IO ( Handle ) +#else +import Data.Word ( Word32 ) +import Data.IORef +#endif + +import System.Exit ( ExitCode ) +import Data.Maybe ( fromMaybe ) +# ifdef __GLASGOW_HASKELL__ +import GHC.IOBase ( haFD, FD, Exception(..), IOException(..) ) +import GHC.Handle ( stdin, stdout, stderr, withHandle_ ) +# elif __HUGS__ +import Hugs.Exception ( Exception(..), IOException(..) ) +# endif + +import Control.Concurrent +import Control.Exception ( handle, throwIO ) +import Foreign.C +import Foreign + +#if defined(mingw32_HOST_OS) +import Control.Monad ( when ) +import System.Directory ( doesFileExist ) +import Control.Exception ( catchJust, ioErrors ) +import System.IO.Error ( isDoesNotExistError, doesNotExistErrorType, + mkIOError ) +import System.Environment ( getEnv ) +import System.FilePath +#endif + +#ifdef __HUGS__ +{-# CFILES cbits/execvpe.c #-} +#endif + +#include "HsProcessConfig.h" + +#ifndef __HUGS__ +-- ---------------------------------------------------------------------------- +-- 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. +-} +data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode +newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__) + +withProcessHandle + :: ProcessHandle + -> (ProcessHandle__ -> IO (ProcessHandle__, a)) + -> IO a +withProcessHandle (ProcessHandle m) io = modifyMVar m io + +withProcessHandle_ + :: ProcessHandle + -> (ProcessHandle__ -> IO ProcessHandle__) + -> IO () +withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io + +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) + +type PHANDLE = CPid + +mkProcessHandle :: PHANDLE -> IO ProcessHandle +mkProcessHandle p = do + m <- newMVar (OpenHandle p) + return (ProcessHandle m) + +closePHANDLE :: PHANDLE -> IO () +closePHANDLE _ = return () + +#else + +type PHANDLE = Word32 + +-- On Windows, we have to close this HANDLE when it is no longer required, +-- hence we add a finalizer to it, using an IORef as the box on which to +-- attach the finalizer. +mkProcessHandle :: PHANDLE -> IO ProcessHandle +mkProcessHandle h = do + m <- newMVar (OpenHandle h) + addMVarFinalizer m (processHandleFinaliser m) + return (ProcessHandle m) + +processHandleFinaliser m = + modifyMVar_ m $ \p_ -> do + case p_ of + OpenHandle ph -> closePHANDLE ph + _ -> return () + return (error "closed process handle") + +closePHANDLE :: PHANDLE -> IO () +closePHANDLE ph = c_CloseHandle ph + +foreign import stdcall unsafe "CloseHandle" + c_CloseHandle + :: PHANDLE + -> IO () +#endif +#endif /* !__HUGS__ */ + +-- ---------------------------------------------------------------------------- + +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) + +#ifdef __GLASGOW_HASKELL__ +-- ----------------------------------------------------------------------------- +-- POSIX runProcess with signal handling in the child + +runProcessPosix + :: String + -> 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@ + -> Maybe CLong -- handler for SIGINT + -> Maybe CLong -- handler for SIGQUIT + -> IO ProcessHandle + +runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr + mb_sigint mb_sigquit + = withFilePathException cmd $ do + fd_stdin <- withHandle_ fun (fromMaybe stdin mb_stdin) $ return . haFD + fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD + fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD + -- some of these might refer to the same Handle, so don't do + -- nested withHandle_'s (that will deadlock). + maybeWith withCEnvironment mb_env $ \pEnv -> do + maybeWith withCString mb_cwd $ \pWorkDir -> do + withMany withCString (cmd:args) $ \cstrs -> do + let (set_int, inthand) + = case mb_sigint of + Nothing -> (0, 0) + Just hand -> (1, hand) + (set_quit, quithand) + = case mb_sigquit of + Nothing -> (0, 0) + Just hand -> (1, hand) + withArray0 nullPtr cstrs $ \pargs -> do + ph <- throwErrnoIfMinus1 fun $ + c_runProcess pargs pWorkDir pEnv + fd_stdin fd_stdout fd_stderr + set_int inthand set_quit quithand + mkProcessHandle 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 + -> CInt -- non-zero: set child's SIGINT handler + -> CLong -- SIGINT handler + -> CInt -- non-zero: set child's SIGQUIT handler + -> CLong -- SIGQUIT handler + -> IO PHANDLE + +#endif /* __GLASGOW_HASKELL__ */ + +ignoreSignal = CONST_SIG_IGN :: CLong +defaultSignal = CONST_SIG_DFL :: CLong + +#else + +#ifdef __GLASGOW_HASKELL__ + +runProcessWin32 fun cmd args mb_cwd mb_env + mb_stdin mb_stdout mb_stderr extra_cmdline + = withFilePathException cmd $ do + fd_stdin <- withHandle_ fun (fromMaybe stdin mb_stdin) $ return . haFD + fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD + fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD + -- some of these might refer to the same Handle, so don't do + -- nested withHandle_'s (that will deadlock). + 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 + fd_stdin fd_stdout fd_stderr) + mkProcessHandle proc_handle + +foreign import ccall unsafe "runProcess" + c_runProcess + :: CString + -> CString + -> Ptr () + -> FD + -> FD + -> FD + -> IO PHANDLE + +-- ------------------------------------------------------------------------ +-- 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. +-} + +-- 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 /* __GLASGOW_HASKELL__ */ + +#endif + +#ifndef __HUGS__ +-- ---------------------------------------------------------------------------- +-- 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_HOST_OS) && !defined(__MINGW32__) + +commandToProcess + :: String + -> IO (FilePath,[String]) +commandToProcess string = return ("/bin/sh", ["-c", string]) + +#else + +commandToProcess + :: String + -> IO (FilePath,String) +commandToProcess string = do + cmd <- findCommandInterpreter + return (cmd, "/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 + -- (later) Now I don't know what the above comment means. sigh. + +-- Find CMD.EXE (or COMMAND.COM on Win98). We use the same algorithm as +-- system() in the VC++ CRT (Vc7/crt/src/system.c in a VC++ installation). +findCommandInterpreter :: IO FilePath +findCommandInterpreter = do + -- try COMSPEC first + catchJust ioErrors (getEnv "COMSPEC") $ \e -> do + when (not (isDoesNotExistError e)) $ ioError e + + -- try to find CMD.EXE or COMMAND.COM + {- + XXX We used to look at _osver (using cbits) and pick which shell to + use with + let filename | osver .&. 0x8000 /= 0 = "command.com" + | otherwise = "cmd.exe" + We ought to use GetVersionEx instead, but for now we just look for + either filename + -} + path <- getEnv "PATH" + let + -- use our own version of System.Directory.findExecutable, because + -- that assumes the .exe suffix. + search :: [FilePath] -> IO (Maybe FilePath) + search [] = return Nothing + search (d:ds) = do + let path1 = d "cmd.exe" + path2 = d "command.com" + b1 <- doesFileExist path1 + b2 <- doesFileExist path2 + if b1 then return (Just path1) + else if b2 then return (Just path2) + else search ds + -- + mb_path <- search (splitSearchPath path) + + case mb_path of + Nothing -> ioError (mkIOError doesNotExistErrorType + "findCommandInterpreter" Nothing Nothing) + Just cmd -> return cmd +#endif + +#endif /* __HUGS__ */ + +-- ---------------------------------------------------------------------------- +-- 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_HOST_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 + diff --git a/cbits/runProcess.c b/cbits/runProcess.c new file mode 100644 --- /dev/null +++ b/cbits/runProcess.c @@ -0,0 +1,458 @@ +/* ---------------------------------------------------------------------------- + (c) The University of Glasgow 2004 + + Support for System.Process + ------------------------------------------------------------------------- */ + +/* XXX This is a nasty hack; should put everything necessary in this package */ +#include "HsBase.h" + +#include "runProcess.h" + +#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) + +#include "execvpe.h" + +/* ---------------------------------------------------------------------------- + UNIX versions + ------------------------------------------------------------------------- */ + +ProcHandle +runProcess (char *const args[], char *workingDirectory, char **environment, + int fdStdInput, int fdStdOutput, int fdStdError, + int set_inthandler, long inthandler, + int set_quithandler, long quithandler) +{ + int pid; + struct sigaction dfl; + + switch(pid = fork()) + { + case -1: + return -1; + + case 0: + { + pPrPr_disableITimers(); + + if (workingDirectory) { + if (chdir (workingDirectory) < 0) { + // See #1593. The convention for the exit code when + // exec() fails seems to be 127 (gleened from C's + // system()), but there's no equivalent convention for + // chdir(), so I'm picking 126 --SimonM. + _exit(126); + } + } + + /* Set the SIGINT/SIGQUIT signal handlers in the child, if requested + */ + (void)sigemptyset(&dfl.sa_mask); + dfl.sa_flags = 0; + if (set_inthandler) { + dfl.sa_handler = (void *)inthandler; + (void)sigaction(SIGINT, &dfl, NULL); + } + if (set_quithandler) { + dfl.sa_handler = (void *)quithandler; + (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) { + if (chdir (workingDirectory) < 0) { + // See #1593. The convention for the exit code when + // exec() fails seems to be 127 (gleened from C's + // system()), but there's no equivalent convention for + // chdir(), so I'm picking 126 --SimonM. + _exit(126); + } + } + + if (fdStdInput[0] != STDIN_FILENO) { + dup2 (fdStdInput[0], STDIN_FILENO); + close(fdStdInput[0]); + } + + if (fdStdOutput[1] != STDOUT_FILENO) { + dup2 (fdStdOutput[1], STDOUT_FILENO); + close(fdStdOutput[1]); + } + + if (fdStdError[1] != STDERR_FILENO) { + dup2 (fdStdError[1], STDERR_FILENO); + close(fdStdError[1]); + } + + close(fdStdInput[1]); + close(fdStdOutput[0]); + close(fdStdError[0]); + + /* 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, res; + + *pExitCode = 0; + + if ((res = 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 */ + } + } + + if (res == 0) return 0; + + if (errno == ECHILD) + { + *pExitCode = 0; + return 1; + } + + return -1; +} + +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)) + { + return wstat; + } + else + { + /* This should never happen */ + } + + return -1; +} + +#else +/* ---------------------------------------------------------------------------- + Win32 versions + ------------------------------------------------------------------------- */ + +/* -------------------- WINDOWS VERSION --------------------- */ + +/* + * 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.hStdInput = (HANDLE) _get_osfhandle(fdStdInput); + sInfo.hStdOutput= (HANDLE) _get_osfhandle(fdStdOutput); + sInfo.hStdError = (HANDLE) _get_osfhandle(fdStdError); + + if (sInfo.hStdInput == INVALID_HANDLE_VALUE) + sInfo.hStdInput = NULL; + if (sInfo.hStdOutput == INVALID_HANDLE_VALUE) + sInfo.hStdOutput = NULL; + if (sInfo.hStdError == INVALID_HANDLE_VALUE) + sInfo.hStdError = NULL; + + if (sInfo.hStdInput || sInfo.hStdOutput || sInfo.hStdError) + sInfo.dwFlags = STARTF_USESTDHANDLES; + + if (sInfo.hStdInput != GetStdHandle(STD_INPUT_HANDLE) && + 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; + } + 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; + } + 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; + } + return retCode; + } + + maperrno(); + return -1; +} + +#endif /* Win32 */ diff --git a/include/HsProcessConfig.h b/include/HsProcessConfig.h new file mode 100644 --- /dev/null +++ b/include/HsProcessConfig.h @@ -0,0 +1,83 @@ +/* include/HsProcessConfig.h. Generated from HsProcessConfig.h.in by configure. */ +/* include/HsProcessConfig.h.in. Generated from configure.ac by autoheader. */ + +/* The value of SIG_DFL. */ +#define CONST_SIG_DFL -1 + +/* The value of SIG_IGN. */ +#define CONST_SIG_IGN -1 + +/* Define to 1 if you have the `fork' function. */ +#define HAVE_FORK 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_INTTYPES_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_MEMORY_H 1 + +/* Define to 1 if you have the `setitimer' function. */ +#define HAVE_SETITIMER 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SIGNAL_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STDINT_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STDLIB_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STRINGS_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_STRING_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_STAT_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_TYPES_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_SYS_WAIT_H 1 + +/* Define to 1 if you have the header file. */ +#define HAVE_UNISTD_H 1 + +/* Define to 1 if you have the `vfork' function. */ +#define HAVE_VFORK 1 + +/* Define to 1 if you have the header file. */ +/* #undef HAVE_VFORK_H */ + +/* Define to 1 if `fork' works. */ +#define HAVE_WORKING_FORK 1 + +/* Define to 1 if `vfork' works. */ +#define HAVE_WORKING_VFORK 1 + +/* Define to the address where bug reports for this package should be sent. */ +#define PACKAGE_BUGREPORT "libraries@haskell.org" + +/* Define to the full name of this package. */ +#define PACKAGE_NAME "Haskell process package" + +/* Define to the full name and version of this package. */ +#define PACKAGE_STRING "Haskell process package 1.0" + +/* Define to the one symbol short name of this package. */ +#define PACKAGE_TARNAME "process" + +/* Define to the version of this package. */ +#define PACKAGE_VERSION "1.0" + +/* Define to 1 if you have the ANSI C header files. */ +#define STDC_HEADERS 1 + +/* Define to `int' if does not define. */ +/* #undef pid_t */ + +/* Define as `fork' if `vfork' does not work. */ +/* #undef vfork */ diff --git a/include/runProcess.h b/include/runProcess.h new file mode 100644 --- /dev/null +++ b/include/runProcess.h @@ -0,0 +1,74 @@ +/* ---------------------------------------------------------------------------- + (c) The University of Glasgow 2004 + + Interface for code in runProcess.c (providing support for System.Process) + ------------------------------------------------------------------------- */ + +#include "HsProcessConfig.h" +// Otherwise these clash with similar definitions from other packages: +#undef PACKAGE_BUGREPORT +#undef PACKAGE_NAME +#undef PACKAGE_STRING +#undef PACKAGE_TARNAME +#undef PACKAGE_VERSION + +#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) +#include +#include +#endif + +#include +#include + +#ifdef HAVE_VFORK_H +#include +#endif + +#ifdef HAVE_VFORK +#define fork vfork +#endif + +#ifdef HAVE_SIGNAL_H +#include +#endif + +#if !(defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) +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(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32)) + +extern ProcHandle runProcess( char *const args[], + char *workingDirectory, char **environment, + int fdStdInput, int fdStdOutput, int fdStdError, + int set_inthandler, long inthandler, + int set_quithandler, long quithandler); + +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 ); diff --git a/process.cabal b/process.cabal new file mode 100644 --- /dev/null +++ b/process.cabal @@ -0,0 +1,34 @@ +name: process +version: 1.0.0.0 +license: BSD3 +license-file: LICENSE +maintainer: libraries@haskell.org +synopsis: Process libraries +description: + This package contains libraries for dealing with system processes. +extra-tmp-files: + config.log config.status autom4te.cache + include/HsProcessConfig.h +build-type: Configure +cabal-version: >=1.2 + +Library { + exposed-modules: + System.Cmd + System.Process.Internals + if impl(ghc) + exposed-modules: + System.Process + c-sources: + cbits/runProcess.c + include-dirs: include + includes: + runProcess.h + install-includes: + runProcess.h + HsProcessConfig.h + extensions: CPP + build-depends: base, directory, filepath + if !os(windows) + build-depends: unix +}