{-# LANGUAGE BangPatterns #-}{-# LANGUAGE CPP #-}
#include <ghcplatform.h>
moduleSystem.Process.Posix(mkProcessHandle ,translateInternal ,createProcess_Internal ,withCEnvironment ,closePHANDLE ,startDelegateControlC ,endDelegateControlC ,stopDelegateControlC ,isDefaultSignal ,ignoreSignal ,defaultSignal ,c_execvpe,pPrPr_disableITimers,createPipeInternal ,createPipeInternalFd ,interruptProcessGroupOfInternal ,runInteractiveProcess_lock )whereimportControl.ConcurrentimportControl.ExceptionimportData.BitsimportForeign.CimportForeign.MarshalimportForeign.PtrimportForeign.StorableimportSystem.IO.UnsafeimportControl.MonadimportData.CharimportSystem.IOimportSystem.Posix.Process.Internals(pPrPr_disableITimers,c_execvpe)importSystem.Posix.TypesimportSystem.Posix.InternalsimportGHC.IO.ExceptionimportSystem.Posix.SignalsasSigimportqualifiedSystem.Posix.IOasPosiximportSystem.Posix.Process(getProcessGroupIDOf)importSystem.Process.Common hiding(mb_delegate_ctlc )
#if defined(wasm32_HOST_ARCH)
importSystem.IO.Error
#endif

#include "HsProcessConfig.h"
#include "processFlags.h"
mkProcessHandle ::PHANDLE ->Bool->IOProcessHandle mkProcessHandle :: PHANDLE -> Bool -> IO ProcessHandle
mkProcessHandle PHANDLE
p Bool
mb_delegate_ctlc =doMVar ProcessHandle__
m <-ProcessHandle__ -> IO (MVar ProcessHandle__)
forall a. a -> IO (MVar a)
newMVar(PHANDLE -> ProcessHandle__
OpenHandle PHANDLE
p )MVar ()
l <-() -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar()ProcessHandle -> IO ProcessHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(MVar ProcessHandle__ -> Bool -> MVar () -> ProcessHandle
ProcessHandle MVar ProcessHandle__
m Bool
mb_delegate_ctlc MVar ()
l )closePHANDLE ::PHANDLE ->IO()closePHANDLE :: PHANDLE -> IO ()
closePHANDLE PHANDLE
_=() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return()-- ------------------------------------------------------------------------------ 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.
-}commandToProcess ::CmdSpec ->(FilePath,[String])commandToProcess :: CmdSpec -> (FilePath, [FilePath])
commandToProcess (ShellCommand FilePath
string )=(FilePath
"/bin/sh",[FilePath
"-c",FilePath
string ])commandToProcess (RawCommand FilePath
cmd [FilePath]
args )=(FilePath
cmd ,[FilePath]
args )translateInternal ::String->StringtranslateInternal :: FilePath -> FilePath
translateInternal FilePath
""=FilePath
"''"translateInternal FilePath
str -- goodChar is a pessimistic predicate, such that if an argument is-- non-empty and only contains goodChars, then there is no need to-- do any quoting or escaping|(Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
allChar -> Bool
goodChar FilePath
str =FilePath
str |Bool
otherwise=Char
'\''Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:(Char -> FilePath -> FilePath) -> FilePath -> FilePath -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldrChar -> FilePath -> FilePath
escape FilePath
"'"FilePath
str whereescape :: Char -> FilePath -> FilePath
escape Char
'\''=FilePath -> FilePath -> FilePath
showStringFilePath
"'\\''"escape Char
c =Char -> FilePath -> FilePath
showCharChar
c goodChar :: Char -> Bool
goodChar Char
c =Char -> Bool
isAlphaNumChar
c Bool -> Bool -> Bool
||Char
c Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`FilePath
"-_.,/"-- ------------------------------------------------------------------------------ UtilswithCEnvironment ::[(String,String)]->(PtrCString->IOa )->IOa withCEnvironment :: forall a. [(FilePath, FilePath)] -> (Ptr CString -> IO a) -> IO a
withCEnvironment [(FilePath, FilePath)]
envir Ptr CString -> IO a
act =letenv' :: [FilePath]
env' =((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map(\(FilePath
name ,FilePath
val )->FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++(Char
'='Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
val ))[(FilePath, FilePath)]
envir in(FilePath -> (CString -> IO a) -> IO a)
-> [FilePath] -> ([CString] -> IO a) -> IO a
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withManyFilePath -> (CString -> IO a) -> IO a
forall a. FilePath -> (CString -> IO a) -> IO a
withFilePath[FilePath]
env' (\[CString]
pEnv ->CString -> [CString] -> (Ptr CString -> IO a) -> IO a
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0CString
forall a. Ptr a
nullPtr[CString]
pEnv Ptr CString -> IO a
act )-- ------------------------------------------------------------------------------- POSIX runProcess with signal handling in the childcreateProcess_Internal ::String->CreateProcess ->IOProcRetHandles createProcess_Internal :: FilePath -> CreateProcess -> IO ProcRetHandles
createProcess_Internal FilePath
fun CreateProcess {cmdspec :: CreateProcess -> CmdSpec
cmdspec =CmdSpec
cmdsp ,cwd :: CreateProcess -> Maybe FilePath
cwd =Maybe FilePath
mb_cwd ,env :: CreateProcess -> Maybe [(FilePath, FilePath)]
env =Maybe [(FilePath, FilePath)]
mb_env ,std_in :: CreateProcess -> StdStream
std_in =StdStream
mb_stdin ,std_out :: CreateProcess -> StdStream
std_out =StdStream
mb_stdout ,std_err :: CreateProcess -> StdStream
std_err =StdStream
mb_stderr ,close_fds :: CreateProcess -> Bool
close_fds =Bool
mb_close_fds ,create_group :: CreateProcess -> Bool
create_group =Bool
mb_create_group ,delegate_ctlc :: CreateProcess -> Bool
delegate_ctlc =Bool
mb_delegate_ctlc ,detach_console :: CreateProcess -> Bool
detach_console =Bool
mb_detach_console ,create_new_console :: CreateProcess -> Bool
create_new_console =Bool
mb_create_new_console ,new_session :: CreateProcess -> Bool
new_session =Bool
mb_new_session ,child_group :: CreateProcess -> Maybe GroupID
child_group =Maybe GroupID
mb_child_group ,child_user :: CreateProcess -> Maybe UserID
child_user =Maybe UserID
mb_child_user }=dolet(FilePath
cmd ,[FilePath]
args )=CmdSpec -> (FilePath, [FilePath])
commandToProcess CmdSpec
cmdsp FilePath -> IO ProcRetHandles -> IO ProcRetHandles
forall a. FilePath -> IO a -> IO a
withFilePathException FilePath
cmd (IO ProcRetHandles -> IO ProcRetHandles)
-> IO ProcRetHandles -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$(Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca((Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr FD
pfdStdInput ->(Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca((Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr FD
pfdStdOutput ->(Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca((Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr FD -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr FD
pfdStdError ->(Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca((Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr CString
pFailedDoing ->([(FilePath, FilePath)]
 -> (Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> Maybe [(FilePath, FilePath)]
-> (Ptr CString -> IO ProcRetHandles)
-> IO ProcRetHandles
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith[(FilePath, FilePath)]
-> (Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a. [(FilePath, FilePath)] -> (Ptr CString -> IO a) -> IO a
withCEnvironment Maybe [(FilePath, FilePath)]
mb_env ((Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr CString
pEnv ->(FilePath -> (CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> Maybe FilePath
-> (CString -> IO ProcRetHandles)
-> IO ProcRetHandles
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWithFilePath -> (CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a. FilePath -> (CString -> IO a) -> IO a
withFilePathMaybe FilePath
mb_cwd ((CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\CString
pWorkDir ->(GroupID
 -> (Ptr GroupID -> IO ProcRetHandles) -> IO ProcRetHandles)
-> Maybe GroupID
-> (Ptr GroupID -> IO ProcRetHandles)
-> IO ProcRetHandles
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWithGroupID -> (Ptr GroupID -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
withMaybe GroupID
mb_child_group ((Ptr GroupID -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr GroupID -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr GroupID
pChildGroup ->(UserID -> (Ptr UserID -> IO ProcRetHandles) -> IO ProcRetHandles)
-> Maybe UserID
-> (Ptr UserID -> IO ProcRetHandles)
-> IO ProcRetHandles
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWithUserID -> (Ptr UserID -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
withMaybe UserID
mb_child_user ((Ptr UserID -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr UserID -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr UserID
pChildUser ->FilePath -> (CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a. FilePath -> (CString -> IO a) -> IO a
withFilePathFilePath
cmd ((CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\CString
cmdstr ->(FilePath -> (CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> [FilePath]
-> ([CString] -> IO ProcRetHandles)
-> IO ProcRetHandles
forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withManyFilePath -> (CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a. FilePath -> (CString -> IO a) -> IO a
withCString[FilePath]
args (([CString] -> IO ProcRetHandles) -> IO ProcRetHandles)
-> ([CString] -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\[CString]
argstrs ->doletcstrs :: [CString]
cstrs =CString
cmdstr CString -> [CString] -> [CString]
forall a. a -> [a] -> [a]
:[CString]
argstrs CString
-> [CString]
-> (Ptr CString -> IO ProcRetHandles)
-> IO ProcRetHandles
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0CString
forall a. Ptr a
nullPtr[CString]
cstrs ((Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles)
-> (Ptr CString -> IO ProcRetHandles) -> IO ProcRetHandles
forall a b. (a -> b) -> a -> b
$\Ptr CString
pargs ->doFD
fdin <-FilePath -> FD -> StdStream -> IO FD
mbFd FilePath
fun FD
fd_stdin StdStream
mb_stdin FD
fdout <-FilePath -> FD -> StdStream -> IO FD
mbFd FilePath
fun FD
fd_stdout StdStream
mb_stdout FD
fderr <-FilePath -> FD -> StdStream -> IO FD
mbFd FilePath
fun FD
fd_stderr StdStream
mb_stderr Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenBool
mb_delegate_ctlc IO ()
startDelegateControlC letflags :: FD
flags =(ifBool
mb_close_fds thenRUN_PROCESS_IN_CLOSE_FDSelse0)FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(ifBool
mb_create_group thenRUN_PROCESS_IN_NEW_GROUPelse0)FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(ifBool
mb_detach_console thenRUN_PROCESS_DETACHEDelse0)FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(ifBool
mb_create_new_console thenRUN_PROCESS_NEW_CONSOLEelse0)FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(ifBool
mb_new_session thenRUN_PROCESS_NEW_SESSIONelse0)FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(ifBool
mb_delegate_ctlc thenRESET_INT_QUIT_HANDLERSelse0)-- See the comment on runInteractiveProcess_lockPHANDLE
proc_handle <-MVar () -> (() -> IO PHANDLE) -> IO PHANDLE
forall a b. MVar a -> (a -> IO b) -> IO b
withMVarMVar ()
runInteractiveProcess_lock ((() -> IO PHANDLE) -> IO PHANDLE)
-> (() -> IO PHANDLE) -> IO PHANDLE
forall a b. (a -> b) -> a -> b
$\()
_->Ptr CString
-> CString
-> Ptr CString
-> FD
-> FD
-> FD
-> Ptr FD
-> Ptr FD
-> Ptr FD
-> Ptr GroupID
-> Ptr UserID
-> FD
-> Ptr CString
-> IO PHANDLE
c_runInteractiveProcess Ptr CString
pargs CString
pWorkDir Ptr CString
pEnv FD
fdin FD
fdout FD
fderr Ptr FD
pfdStdInput Ptr FD
pfdStdOutput Ptr FD
pfdStdError Ptr GroupID
pChildGroup Ptr UserID
pChildUser FD
flags Ptr CString
pFailedDoing Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(PHANDLE
proc_handle PHANDLE -> PHANDLE -> Bool
forall a. Eq a => a -> a -> Bool
==-PHANDLE
1)(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$doCString
cFailedDoing <-Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peekPtr CString
pFailedDoing FilePath
failedDoing <-CString -> IO FilePath
peekCStringCString
cFailedDoing Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
whenBool
mb_delegate_ctlc IO ()
stopDelegateControlC FilePath -> IO ()
forall a. FilePath -> IO a
throwErrno(FilePath
fun FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
": "FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
failedDoing )Maybe Handle
hndStdInput <-StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe StdStream
mb_stdin Ptr FD
pfdStdInput IOMode
WriteModeMaybe Handle
hndStdOutput <-StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe StdStream
mb_stdout Ptr FD
pfdStdOutput IOMode
ReadModeMaybe Handle
hndStdError <-StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe StdStream
mb_stderr Ptr FD
pfdStdError IOMode
ReadModeProcessHandle
ph <-PHANDLE -> Bool -> IO ProcessHandle
mkProcessHandle PHANDLE
proc_handle Bool
mb_delegate_ctlc ProcRetHandles -> IO ProcRetHandles
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnProcRetHandles {hStdInput :: Maybe Handle
hStdInput =Maybe Handle
hndStdInput ,hStdOutput :: Maybe Handle
hStdOutput =Maybe Handle
hndStdOutput ,hStdError :: Maybe Handle
hStdError =Maybe Handle
hndStdError ,procHandle :: ProcessHandle
procHandle =ProcessHandle
ph }{-# NOINLINErunInteractiveProcess_lock #-}-- | 'runInteractiveProcess' blocks signals around the fork().-- Since blocking/unblocking of signals is a global state operation, we need to-- ensure mutual exclusion of calls to 'runInteractiveProcess'.-- This lock is exported so that other libraries which also need to fork()-- (and also need to make the same global state changes) can protect their changes-- with the same lock.-- See https://github.com/haskell/process/pull/154.---- @since 1.6.6.0runInteractiveProcess_lock ::MVar()runInteractiveProcess_lock :: MVar ()
runInteractiveProcess_lock =IO (MVar ()) -> MVar ()
forall a. IO a -> a
unsafePerformIO(IO (MVar ()) -> MVar ()) -> IO (MVar ()) -> MVar ()
forall a b. (a -> b) -> a -> b
$() -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar()-- ------------------------------------------------------------------------------ Delegated control-C handling on Unix-- See ticket https://ghc.haskell.org/trac/ghc/ticket/2301-- and http://www.cons.org/cracauer/sigint.html---- While running an interactive console process like ghci or a shell, we want-- to let that process handle Ctl-C keyboard interrupts how it sees fit.-- So that means we need to ignore the SIGINT/SIGQUIT Unix signals while we're-- running such programs. And then if/when they do terminate, we need to check-- if they terminated due to SIGINT/SIGQUIT and if so then we behave as if we-- got the Ctl-C then, by throwing the UserInterrupt exception.---- If we run multiple programs like this concurrently then we have to be-- careful to avoid messing up the signal handlers. We keep a count and only-- restore when the last one has finished.{-# NOINLINErunInteractiveProcess_delegate_ctlc #-}runInteractiveProcess_delegate_ctlc ::MVar(Maybe(Int,Sig.Handler,Sig.Handler))runInteractiveProcess_delegate_ctlc :: MVar (Maybe (Int, Handler, Handler))
runInteractiveProcess_delegate_ctlc =IO (MVar (Maybe (Int, Handler, Handler)))
-> MVar (Maybe (Int, Handler, Handler))
forall a. IO a -> a
unsafePerformIO(IO (MVar (Maybe (Int, Handler, Handler)))
 -> MVar (Maybe (Int, Handler, Handler)))
-> IO (MVar (Maybe (Int, Handler, Handler)))
-> MVar (Maybe (Int, Handler, Handler))
forall a b. (a -> b) -> a -> b
$Maybe (Int, Handler, Handler)
-> IO (MVar (Maybe (Int, Handler, Handler)))
forall a. a -> IO (MVar a)
newMVarMaybe (Int, Handler, Handler)
forall a. Maybe a
NothingstartDelegateControlC ::IO()startDelegateControlC :: IO ()
startDelegateControlC =MVar (Maybe (Int, Handler, Handler))
-> (Maybe (Int, Handler, Handler)
 -> IO (Maybe (Int, Handler, Handler)))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_MVar (Maybe (Int, Handler, Handler))
runInteractiveProcess_delegate_ctlc ((Maybe (Int, Handler, Handler)
 -> IO (Maybe (Int, Handler, Handler)))
 -> IO ())
-> (Maybe (Int, Handler, Handler)
 -> IO (Maybe (Int, Handler, Handler)))
-> IO ()
forall a b. (a -> b) -> a -> b
$\Maybe (Int, Handler, Handler)
delegating ->docaseMaybe (Int, Handler, Handler)
delegating ofMaybe (Int, Handler, Handler)
Nothing->do-- We're going to ignore ^C in the parent while there are any-- processes using ^C delegation.---- If another thread runs another process without using-- delegation while we're doing this then it will inherit the-- ignore ^C status.Handler
old_int <-FD -> Handler -> Maybe SignalSet -> IO Handler
installHandlerFD
sigINTHandler
IgnoreMaybe SignalSet
forall a. Maybe a
NothingHandler
old_quit <-FD -> Handler -> Maybe SignalSet -> IO Handler
installHandlerFD
sigQUITHandler
IgnoreMaybe SignalSet
forall a. Maybe a
NothingMaybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return((Int, Handler, Handler) -> Maybe (Int, Handler, Handler)
forall a. a -> Maybe a
Just(Int
1,Handler
old_int ,Handler
old_quit ))Just(Int
count ,Handler
old_int ,Handler
old_quit )->do-- If we're already doing it, just increment the countlet!count' :: Int
count' =Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Maybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return((Int, Handler, Handler) -> Maybe (Int, Handler, Handler)
forall a. a -> Maybe a
Just(Int
count' ,Handler
old_int ,Handler
old_quit ))stopDelegateControlC ::IO()stopDelegateControlC :: IO ()
stopDelegateControlC =MVar (Maybe (Int, Handler, Handler))
-> (Maybe (Int, Handler, Handler)
 -> IO (Maybe (Int, Handler, Handler)))
-> IO ()
forall a. MVar a -> (a -> IO a) -> IO ()
modifyMVar_MVar (Maybe (Int, Handler, Handler))
runInteractiveProcess_delegate_ctlc ((Maybe (Int, Handler, Handler)
 -> IO (Maybe (Int, Handler, Handler)))
 -> IO ())
-> (Maybe (Int, Handler, Handler)
 -> IO (Maybe (Int, Handler, Handler)))
-> IO ()
forall a b. (a -> b) -> a -> b
$\Maybe (Int, Handler, Handler)
delegating ->docaseMaybe (Int, Handler, Handler)
delegating ofJust(Int
1,Handler
old_int ,Handler
old_quit )->do-- Last process, so restore the old signal handlersHandler
_<-FD -> Handler -> Maybe SignalSet -> IO Handler
installHandlerFD
sigINTHandler
old_int Maybe SignalSet
forall a. Maybe a
NothingHandler
_<-FD -> Handler -> Maybe SignalSet -> IO Handler
installHandlerFD
sigQUITHandler
old_quit Maybe SignalSet
forall a. Maybe a
NothingMaybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnMaybe (Int, Handler, Handler)
forall a. Maybe a
NothingJust(Int
count ,Handler
old_int ,Handler
old_quit )->do-- Not the last, just decrement the countlet!count' :: Int
count' =Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1Maybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return((Int, Handler, Handler) -> Maybe (Int, Handler, Handler)
forall a. a -> Maybe a
Just(Int
count' ,Handler
old_int ,Handler
old_quit ))Maybe (Int, Handler, Handler)
Nothing->Maybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
returnMaybe (Int, Handler, Handler)
forall a. Maybe a
Nothing-- should be impossibleendDelegateControlC ::ExitCode->IO()endDelegateControlC :: ExitCode -> IO ()
endDelegateControlC ExitCode
exitCode =doIO ()
stopDelegateControlC -- And if the process did die due to SIGINT or SIGQUIT then-- we throw our equivalent exception here (synchronously).---- An alternative design would be to throw to the main thread, as the-- normal signal handler does. But since we can be sync here, we do so.-- It allows the code locally to catch it and do something.caseExitCode
exitCode ofExitFailureInt
n |Int -> Bool
forall {p}. Integral p => p -> Bool
isSigIntQuit Int
n ->AsyncException -> IO ()
forall e a. Exception e => e -> IO a
throwIOAsyncException
UserInterruptExitCode
_->() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return()whereisSigIntQuit :: p -> Bool
isSigIntQuit p
n =FD
sig FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
==FD
sigINTBool -> Bool -> Bool
||FD
sig FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
==FD
sigQUITwheresig :: FD
sig =p -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral(-p
n )
#if defined(wasm32_HOST_ARCH)
c_runInteractiveProcess::PtrCString->CString->PtrCString->FD->FD->FD->PtrFD->PtrFD->PtrFD->PtrCGid->PtrCUid->CInt-- flags->PtrCString->IOPHANDLEc_runInteractiveProcess_____________=ioError(ioeSetLocationunsupportedOperation"runInteractiveProcess")
#else
foreignimportccallunsafe"runInteractiveProcess"c_runInteractiveProcess ::PtrCString->CString->PtrCString->FD->FD->FD->PtrFD->PtrFD->PtrFD->PtrCGid->PtrCUid->CInt-- flags->PtrCString->IOPHANDLE 
#endif
ignoreSignal ,defaultSignal ::CLongignoreSignal :: CLong
ignoreSignal =CONST_SIG_IGNdefaultSignal :: CLong
defaultSignal =CONST_SIG_DFLisDefaultSignal ::CLong->BoolisDefaultSignal :: CLong -> Bool
isDefaultSignal =(CLong -> CLong -> Bool
forall a. Eq a => a -> a -> Bool
==CLong
defaultSignal )createPipeInternal ::IO(Handle,Handle)createPipeInternal :: IO (Handle, Handle)
createPipeInternal =do(Fd
readfd ,Fd
writefd )<-IO (Fd, Fd)
Posix.createPipeHandle
readh <-Fd -> IO Handle
Posix.fdToHandleFd
readfd Handle
writeh <-Fd -> IO Handle
Posix.fdToHandleFd
writefd (Handle, Handle) -> IO (Handle, Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(Handle
readh ,Handle
writeh )createPipeInternalFd ::IO(FD,FD)createPipeInternalFd :: IO (FD, FD)
createPipeInternalFd =do(FdFD
readfd ,FdFD
writefd )<-IO (Fd, Fd)
Posix.createPipe(FD, FD) -> IO (FD, FD)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return(FD
readfd ,FD
writefd )interruptProcessGroupOfInternal ::ProcessHandle -- ^ A process in the process group->IO()interruptProcessGroupOfInternal :: ProcessHandle -> IO ()
interruptProcessGroupOfInternal ProcessHandle
ph =doProcessHandle -> (ProcessHandle__ -> IO ()) -> IO ()
forall a. ProcessHandle -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle ProcessHandle
ph ((ProcessHandle__ -> IO ()) -> IO ())
-> (ProcessHandle__ -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$\ProcessHandle__
p_ ->docaseProcessHandle__
p_ ofOpenExtHandle {}->() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return()ClosedHandle ExitCode
_->() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return()OpenHandle PHANDLE
h ->doPHANDLE
pgid <-PHANDLE -> IO PHANDLE
getProcessGroupIDOfPHANDLE
h FD -> PHANDLE -> IO ()
signalProcessGroupFD
sigINTPHANDLE
pgid