forkProcess :: IO (Maybe ProcessID)
forkProcess
calls fork
, returning
Just pid
to the parent, where pid
is the
ProcessID of the child, and returning Nothing
to the
child.
executeFile :: FilePath -- Command -> Bool -- Search PATH? -> [String] -- Arguments -> Maybe [(String, String)] -- Environment -> IO ()
executeFile cmd args env
calls one of the
execv*
family, depending on whether or not the current
PATH is to be searched for the command, and whether or not an
environment is provided to supersede the process's current
environment. The basename (leading directory names suppressed) of
the command is passed to execv*
as arg[0]
;
the argument list passed to executeFile
therefore begins with arg[1]
.
Search PATH? Supersede environ? Call ~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~ ~~~~~~~ False False execv False True execve True False execvp True True execvpe*
Note that execvpe
is not provided by the POSIX standard, and must
be written by hand. Care must be taken to ensure that the search path
is extracted from the original environment, and not from the
environment to be passed on to the new image.
NOTE: In general, sharing open files between parent and child
processes is potential bug farm, and should be avoided unless you
really depend on this `feature' of POSIX' fork()
semantics. Using
Haskell, there's the extra complication that arguments to
executeFile
might come from files that are read lazily (using
hGetContents
, or some such.) If this is the case, then for your own
sanity, please ensure that the arguments to executeFile
have been
fully evaluated before calling forkProcess
(followed by
executeFile
.) Consider yourself warned :-)
A successful executeFile
overlays the current process image with
a new one, so it only returns on failure.
runProcess :: FilePath -- Command -> [String] -- Arguments -> Maybe [(String, String)] -- Environment (Nothing -> Inherited) -> Maybe FilePath -- Working directory (Nothing -> inherited) -> Maybe Handle -- stdin (Nothing -> inherited) -> Maybe Handle -- stdout (Nothing -> inherited) -> Maybe Handle -- stderr (Nothing -> inherited) -> IO ()
runProcess
is our candidate for the high-level OS-independent
primitive.
runProcess cmd args env wd inhdl outhdl errhdl
runs cmd
(searching the current PATH
) with arguments args
. If
env
is Just pairs
, the command is executed with the
environment specified by pairs
of variables and values;
otherwise, the command is executed with the current environment. If
wd
is Just dir
, the command is executed with working
directory dir
; otherwise, the command is executed in the current
working directory. If {in,out,err
hdl} is Just handle
, the
command is executed with the Fd
for std{in,out,err
}
attached to the specified handle
; otherwise, the Fd
for
std{in,out,err
} is left unchanged.
getProcessStatus :: Bool -- Block? -> Bool -- Stopped processes? -> ProcessID -> IO (Maybe ProcessStatus)
getProcessStatus blk stopped pid
calls waitpid
, returning
Just tc
, the ProcessStatus
for process pid
if it is
available, Nothing
otherwise. If blk
is False
, then
WNOHANG
is set in the options for waitpid
, otherwise not.
If stopped
is True
, then WUNTRACED
is set in the
options for waitpid
, otherwise not.
getGroupProcessStatus :: Bool -- Block? -> Bool -- Stopped processes? -> ProcessGroupID -> IO (Maybe (ProcessID, ProcessStatus))
getGroupProcessStatus blk stopped pgid
calls waitpid
,
returning Just (pid, tc)
, the ProcessID
and
ProcessStatus
for any process in group pgid
if one is
available, Nothing
otherwise. If blk
is False
, then
WNOHANG
is set in the options for waitpid
, otherwise not.
If stopped
is True
, then WUNTRACED
is set in the
options for waitpid
, otherwise not.
getAnyProcessStatus :: Bool -- Block? -> Bool -- Stopped processes? -> IO (Maybe (ProcessID, ProcessStatus))
getAnyProcessStatus blk stopped
calls waitpid
, returning
Just (pid, tc)
, the ProcessID
and ProcessStatus
for any
child process if one is available, Nothing
otherwise. If
blk
is False
, then WNOHANG
is set in the options for
waitpid
, otherwise not. If stopped
is True
, then
WUNTRACED
is set in the options for waitpid
, otherwise not.
exitImmediately :: ExitCode -> IO ()
exitImmediately status
calls _exit
to terminate the process
with the indicated exit status
.
The operation never returns.
getEnvironment :: IO [(String, String)]
getEnvironment
parses the environment variable mapping provided by
environ
, returning (variable, value)
pairs.
The operation never fails.
setEnvironment :: [(String, String)] -> IO ()
setEnvironment
replaces the process environment with the provided
mapping of (variable, value)
pairs.
getEnvVar :: String -> IO String
getEnvVar var
returns the value associated with variable var
in the current environment (identical functionality provided through
standard Haskell library function System.getEnv
).
The operation may fail with:
NoSuchThing
The variable has no mapping in the current environment.
setEnvVar :: String -> String -> IO ()
setEnvVar var val
sets the value associated with variable var
in the current environment to be val
. Any previous mapping is
superseded.
removeEnvVar :: String -> IO ()
removeEnvVar var
removes any value associated with variable var
in the current environment. Deleting a variable for which there is no mapping
does not generate an error.
nullSignal :: Signal nullSignal = 0 backgroundRead, sigTTIN :: Signal backgroundWrite, sigTTOU :: Signal continueProcess, sigCONT :: Signal floatingPointException, sigFPE :: Signal illegalInstruction, sigILL :: Signal internalAbort, sigABRT :: Signal keyboardSignal, sigINT :: Signal keyboardStop, sigTSTP :: Signal keyboardTermination, sigQUIT :: Signal killProcess, sigKILL :: Signal lostConnection, sigHUP :: Signal openEndedPipe, sigPIPE :: Signal processStatusChanged, sigCHLD :: Signal realTimeAlarm, sigALRM :: Signal segmentationViolation, sigSEGV :: Signal softwareStop, sigSTOP :: Signal softwareTermination, sigTERM :: Signal userDefinedSignal1, sigUSR1 :: Signal userDefinedSignal2, sigUSR2 :: Signal signalProcess :: Signal -> ProcessID -> IO ()
signalProcess int pid
calls kill
to signal
process pid
with interrupt signal int
.
raiseSignal :: Signal -> IO ()
raiseSignal int
calls kill
to signal the current process
with interrupt signal int
.
signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
signalProcessGroup int pgid
calls kill
to signal
all processes in group pgid
with interrupt signal int
.
setStoppedChildFlag :: Bool -> IO Bool
setStoppedChildFlag bool
sets a flag which controls whether or
not the NOCLDSTOP
option will be used the next time a signal
handler is installed for SIGCHLD
. If bool
is True
(the
default), NOCLDSTOP
will not be used; otherwise it will be. The
operation never fails.
queryStoppedChildFlag :: IO Bool
queryStoppedChildFlag
queries the flag which
controls whether or not the NOCLDSTOP
option will be used
the next time a signal handler is installed for SIGCHLD
.
If NOCLDSTOP
will be used, it returns False
;
otherwise (the default) it returns True
.
The operation never fails.
emptySignalSet :: SignalSet fullSignalSet :: SignalSet addSignal :: Signal -> SignalSet -> SignalSet deleteSignal :: Signal -> SignalSet -> SignalSet inSignalSet :: Signal -> SignalSet -> Bool installHandler :: Signal -> Handler -> Maybe SignalSet -- other signals to block -> IO Handler -- old handler
installHandler int handler iset
calls sigaction
to install an
interrupt handler for signal int
. If handler
is Default
,
SIG_DFL
is installed; if handler
is Ignore
, SIG_IGN
is
installed; if handler
is Catch action
, a handler is installed
which will invoke action
in a new thread when (or shortly after) the
signal is received. See Chapter 2, The concurrent
package: concurrency support
for details on how to communicate between
threads.
If iset
is Just s
, then the sa_mask
of the sigaction
structure
is set to s
; otherwise it is cleared. The previously installed
signal handler for int
is returned.
getSignalMask :: IO SignalSet
getSignalMask
calls sigprocmask
to determine the
set of interrupts which are currently being blocked.
setSignalMask :: SignalSet -> IO SignalSet
setSignalMask mask
calls sigprocmask
with
SIG_SETMASK
to block all interrupts in mask
. The
previous set of blocked interrupts is returned.
blockSignals :: SignalSet -> IO SignalSet
setSignalMask mask
calls sigprocmask
with
SIG_BLOCK
to add all interrupts in mask
to the
set of blocked interrupts. The previous set of blocked interrupts is returned.
unBlockSignals :: SignalSet -> IO SignalSet
setSignalMask mask
calls sigprocmask
with
SIG_UNBLOCK
to remove all interrupts in mask
from the
set of blocked interrupts. The previous set of blocked interrupts is returned.
getPendingSignals :: IO SignalSet
getPendingSignals
calls sigpending
to obtain
the set of interrupts which have been received but are currently blocked.
awaitSignal :: Maybe SignalSet -> IO ()
awaitSignal iset
suspends execution until an interrupt is received.
If iset
is Just s
, awaitSignal
calls sigsuspend
, installing
s
as the new signal mask before suspending execution; otherwise, it
calls pause
. awaitSignal
returns on receipt of a signal. If you
have installed any signal handlers with installHandler
, it may be
wise to call yield
directly after awaitSignal
to ensure that the
signal handler runs as promptly.
scheduleAlarm :: Int -> IO Int
scheduleAlarm i
calls alarm
to schedule a real time
alarm at least i
seconds in the future.
sleep :: Int -> IO ()
sleep i
calls sleep
to suspend execution of the
program until at least i
seconds have elapsed or a signal is
received.