module RawFilePath.Process.Posix
( createProcessInternal
, withCEnvironment
, closePHANDLE
, startDelegateControlC
, endDelegateControlC
, stopDelegateControlC
, c_execvpe
, pPrPr_disableITimers
, createPipe
, createPipeInternalFd
) where
import RawFilePath.Import
import Data.ByteString.Internal (ByteString(..), memcpy)
import System.Posix.ByteString.FilePath (withFilePath)
import System.Posix.Internals hiding (withFilePath)
import System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe )
import System.Posix.Signals
import qualified System.Posix.Signals as Sig
import qualified System.Posix.IO as Posix
import RawFilePath.Process.Common
#include "processFlags.c"
closePHANDLE :: PHANDLE -> IO ()
closePHANDLE :: PHANDLE -> IO ()
closePHANDLE PHANDLE
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
withManyByteString :: [ByteString] -> (Ptr CString -> IO a) -> IO a
withManyByteString :: [ByteString] -> (Ptr CString -> IO a) -> IO a
withManyByteString [ByteString]
bs Ptr CString -> IO a
action =
Int -> (Ptr Word8 -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
wholeLength ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
buf ->
Int -> (Ptr (Ptr Word8) -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
ptrLength ((Ptr (Ptr Word8) -> IO a) -> IO a)
-> (Ptr (Ptr Word8) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr Word8)
cs -> do
[ByteString] -> Ptr Word8 -> Ptr (Ptr Word8) -> IO ()
copyByteStrings [ByteString]
bs Ptr Word8
buf Ptr (Ptr Word8)
cs
Ptr CString -> IO a
action (Ptr (Ptr Word8) -> Ptr CString
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr Word8)
cs)
where
ptrLength :: Int
ptrLength = ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
bs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Ptr CString -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CString
forall a. HasCallStack => a
undefined :: Ptr CString)
wholeLength :: Int
wholeLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\ (PS ForeignPtr Word8
_ Int
_ Int
l) -> Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [ByteString]
bs)
copyByteStrings :: [ByteString] -> Ptr Word8 -> Ptr (Ptr Word8) -> IO ()
copyByteStrings :: [ByteString] -> Ptr Word8 -> Ptr (Ptr Word8) -> IO ()
copyByteStrings [] Ptr Word8
_ Ptr (Ptr Word8)
cs = Ptr (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Word8)
cs Ptr Word8
forall a. Ptr a
nullPtr
copyByteStrings (PS ForeignPtr Word8
fp Int
o Int
l : [ByteString]
xs) Ptr Word8
buf Ptr (Ptr Word8)
cs = ForeignPtr Word8 -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO ()) -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
p -> do
Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
buf (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
o) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l)
Ptr Word8 -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
buf Int
l (Word8
0 :: Word8)
Ptr (Ptr Word8) -> Ptr Word8 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr Word8)
cs (Ptr Word8
buf :: Ptr Word8)
[ByteString] -> Ptr Word8 -> Ptr (Ptr Word8) -> IO ()
copyByteStrings [ByteString]
xs (Ptr Word8
buf Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
(Ptr (Ptr Word8)
cs Ptr (Ptr Word8) -> Int -> Ptr (Ptr Word8)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Ptr CString -> Int
forall a. Storable a => a -> Int
sizeOf (Ptr CString
forall a. HasCallStack => a
undefined :: Ptr CString))
withCEnvironment :: [(ByteString, ByteString)] -> (Ptr CString -> IO a) -> IO a
withCEnvironment :: [(ByteString, ByteString)] -> (Ptr CString -> IO a) -> IO a
withCEnvironment [(ByteString, ByteString)]
envir Ptr CString -> IO a
act =
let env' :: [ByteString]
env' = ((ByteString, ByteString) -> ByteString)
-> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
name, ByteString
val) -> ByteString
name ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"=" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
val) [(ByteString, ByteString)]
envir
in [ByteString] -> (Ptr CString -> IO a) -> IO a
forall a. [ByteString] -> (Ptr CString -> IO a) -> IO a
withManyByteString [ByteString]
env' Ptr CString -> IO a
act
createProcessInternal
:: (StreamType stdin, StreamType stdout, StreamType stderr)
=> ProcessConf stdin stdout stderr
-> IO (Process stdin stdout stderr)
createProcessInternal :: ProcessConf stdin stdout stderr -> IO (Process stdin stdout stderr)
createProcessInternal ProcessConf{stdin
stdout
stderr
Bool
[ByteString]
Maybe [(ByteString, ByteString)]
Maybe GroupID
Maybe UserID
Maybe ByteString
childUser :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe UserID
childGroup :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe GroupID
newSession :: forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
createNewConsole :: forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
delegateCtlc :: forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
createGroup :: forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
closeFds :: forall stdin stdout stderr. ProcessConf stdin stdout stderr -> Bool
cfgStderr :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stderr
cfgStdout :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stdout
cfgStdin :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> stdin
env :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe [(ByteString, ByteString)]
cwd :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> Maybe ByteString
cmdargs :: forall stdin stdout stderr.
ProcessConf stdin stdout stderr -> [ByteString]
childUser :: Maybe UserID
childGroup :: Maybe GroupID
newSession :: Bool
createNewConsole :: Bool
delegateCtlc :: Bool
createGroup :: Bool
closeFds :: Bool
cfgStderr :: stderr
cfgStdout :: stdout
cfgStdin :: stdin
env :: Maybe [(ByteString, ByteString)]
cwd :: Maybe ByteString
cmdargs :: [ByteString]
..}
= (Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \ Ptr FD
pfdStdInput ->
(Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \ Ptr FD
pfdStdOutput ->
(Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr FD -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \ Ptr FD
pfdStdError ->
(Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \ Ptr CString
pFailedDoing ->
([(ByteString, ByteString)]
-> (Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> Maybe [(ByteString, ByteString)]
-> (Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith [(ByteString, ByteString)]
-> (Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a.
[(ByteString, ByteString)] -> (Ptr CString -> IO a) -> IO a
withCEnvironment Maybe [(ByteString, ByteString)]
env ((Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
pEnv ->
(ByteString
-> (CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> Maybe ByteString
-> (CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith ByteString
-> (CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a. ByteString -> (CString -> IO a) -> IO a
withFilePath Maybe ByteString
cwd ((CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \CString
pWorkDir ->
(GroupID
-> (Ptr GroupID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> Maybe GroupID
-> (Ptr GroupID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith GroupID
-> (Ptr GroupID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe GroupID
childGroup ((Ptr GroupID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr GroupID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \Ptr GroupID
pChildGroup ->
(UserID
-> (Ptr UserID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> Maybe UserID
-> (Ptr UserID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith UserID
-> (Ptr UserID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Maybe UserID
childUser ((Ptr UserID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr UserID -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \Ptr UserID
pChildUser ->
[ByteString]
-> (Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a. [ByteString] -> (Ptr CString -> IO a) -> IO a
withManyByteString [ByteString]
cmdargs ((Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr))
-> (Ptr CString -> IO (Process stdin stdout stderr))
-> IO (Process stdin stdout stderr)
forall a b. (a -> b) -> a -> b
$ \Ptr CString
pargs -> do
FD
fdin <- FD -> stdin -> IO FD
forall c. StreamType c => FD -> c -> IO FD
mbFd FD
fdStdin stdin
cfgStdin
FD
fdout <- FD -> stdout -> IO FD
forall c. StreamType c => FD -> c -> IO FD
mbFd FD
fdStdout stdout
cfgStdout
FD
fderr <- FD -> stderr -> IO FD
forall c. StreamType c => FD -> c -> IO FD
mbFd FD
fdStderr stderr
cfgStderr
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delegateCtlc IO ()
startDelegateControlC
PHANDLE
procHandle <- MVar () -> (() -> IO PHANDLE) -> IO PHANDLE
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ()
runInteractiveProcessLock ((() -> 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
-> 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
(if Bool
delegateCtlc then FD
1 else FD
0)
((if Bool
closeFds then RUN_PROCESS_IN_CLOSE_FDS else 0)
FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(if Bool
createGroup then RUN_PROCESS_IN_NEW_GROUP else 0)
FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(if Bool
createNewConsole then RUN_PROCESS_NEW_CONSOLE else 0)
FD -> FD -> FD
forall a. Bits a => a -> a -> a
.|.(if Bool
newSession then RUN_PROCESS_NEW_SESSION else 0))
Ptr CString
pFailedDoing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PHANDLE
procHandle PHANDLE -> PHANDLE -> Bool
forall a. Eq a => a -> a -> Bool
== -PHANDLE
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
CString
cFailedDoing <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
pFailedDoing
String
failedDoing <- CString -> IO String
peekCString CString
cFailedDoing
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delegateCtlc IO ()
stopDelegateControlC
String -> IO ()
forall a. String -> IO a
throwErrno (ByteString -> String
forall a. Show a => a -> String
show ([ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
cmdargs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
failedDoing)
Maybe Handle
hIn <- stdin -> Ptr FD -> IOMode -> IO (Maybe Handle)
forall c.
StreamType c =>
c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe stdin
cfgStdin Ptr FD
pfdStdInput IOMode
WriteMode
Maybe Handle
hOut <- stdout -> Ptr FD -> IOMode -> IO (Maybe Handle)
forall c.
StreamType c =>
c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe stdout
cfgStdout Ptr FD
pfdStdOutput IOMode
ReadMode
Maybe Handle
hErr <- stderr -> Ptr FD -> IOMode -> IO (Maybe Handle)
forall c.
StreamType c =>
c -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe stderr
cfgStderr Ptr FD
pfdStdError IOMode
ReadMode
MVar ProcessHandle__
mvarProcHandle <- ProcessHandle__ -> IO (MVar ProcessHandle__)
forall a. a -> IO (MVar a)
newMVar (PHANDLE -> ProcessHandle__
OpenHandle PHANDLE
procHandle)
MVar ()
lock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
Process stdin stdout stderr -> IO (Process stdin stdout stderr)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> MVar ProcessHandle__
-> Bool
-> MVar ()
-> Process stdin stdout stderr
forall stdin stdout stderr.
Maybe Handle
-> Maybe Handle
-> Maybe Handle
-> MVar ProcessHandle__
-> Bool
-> MVar ()
-> Process stdin stdout stderr
Process Maybe Handle
hIn Maybe Handle
hOut Maybe Handle
hErr MVar ProcessHandle__
mvarProcHandle Bool
delegateCtlc MVar ()
lock)
{-# NOINLINE runInteractiveProcessLock #-}
runInteractiveProcessLock :: MVar ()
runInteractiveProcessLock :: MVar ()
runInteractiveProcessLock = 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 ()
{-# NOINLINE runInteractiveProcessDelegateCtlc #-}
runInteractiveProcessDelegateCtlc :: MVar (Maybe (Int, Sig.Handler, Sig.Handler))
runInteractiveProcessDelegateCtlc :: MVar (Maybe (Int, Handler, Handler))
runInteractiveProcessDelegateCtlc = 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)
newMVar Maybe (Int, Handler, Handler)
forall a. Maybe a
Nothing
startDelegateControlC :: 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))
runInteractiveProcessDelegateCtlc ((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
$ \ case
Maybe (Int, Handler, Handler)
Nothing -> do
Handler
old_int <- FD -> Handler -> Maybe SignalSet -> IO Handler
installHandler FD
sigINT Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing
Handler
old_quit <- FD -> Handler -> Maybe SignalSet -> IO Handler
installHandler FD
sigQUIT Handler
Ignore Maybe SignalSet
forall a. Maybe a
Nothing
Maybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
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
let !count' :: Int
count' = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Maybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
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))
runInteractiveProcessDelegateCtlc ((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
$ \ case
Just (Int
1, Handler
old_int, Handler
old_quit) -> do
Handler
_ <- FD -> Handler -> Maybe SignalSet -> IO Handler
installHandler FD
sigINT Handler
old_int Maybe SignalSet
forall a. Maybe a
Nothing
Handler
_ <- FD -> Handler -> Maybe SignalSet -> IO Handler
installHandler FD
sigQUIT Handler
old_quit Maybe SignalSet
forall a. Maybe a
Nothing
Maybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Handler, Handler)
forall a. Maybe a
Nothing
Just (Int
count, Handler
old_int, Handler
old_quit) -> do
let !count' :: Int
count' = Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
Maybe (Int, Handler, Handler) -> IO (Maybe (Int, Handler, Handler))
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe (Int, Handler, Handler)
forall a. Maybe a
Nothing
endDelegateControlC :: ExitCode -> IO ()
endDelegateControlC :: ExitCode -> IO ()
endDelegateControlC ExitCode
exitCode = do
IO ()
stopDelegateControlC
case ExitCode
exitCode of
ExitFailure Int
n | Int -> Bool
forall a. Integral a => a -> Bool
isSigIntQuit Int
n -> AsyncException -> IO ()
forall e a. Exception e => e -> IO a
throwIO AsyncException
UserInterrupt
ExitCode
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
isSigIntQuit :: a -> Bool
isSigIntQuit a
n = FD
sig FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
sigINT Bool -> Bool -> Bool
|| FD
sig FD -> FD -> Bool
forall a. Eq a => a -> a -> Bool
== FD
sigQUIT
where
sig :: FD
sig = a -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral (-a
n)
foreign import ccall unsafe "runInteractiveProcess"
c_runInteractiveProcess
:: Ptr CString
-> CString
-> Ptr CString
-> FD
-> FD
-> FD
-> Ptr FD
-> Ptr FD
-> Ptr FD
-> Ptr CGid
-> Ptr CUid
-> CInt
-> CInt
-> Ptr CString
-> IO PHANDLE
createPipe :: IO (Handle, Handle)
createPipe :: IO (Handle, Handle)
createPipe = do
(Fd
readfd, Fd
writefd) <- IO (Fd, Fd)
Posix.createPipe
Handle
readh <- Fd -> IO Handle
Posix.fdToHandle Fd
readfd
Handle
writeh <- Fd -> IO Handle
Posix.fdToHandle Fd
writefd
(Handle, Handle) -> IO (Handle, Handle)
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle
readh, Handle
writeh)
createPipeInternalFd :: IO (FD, FD)
createPipeInternalFd :: IO (FD, FD)
createPipeInternalFd = do
(Fd FD
readfd, Fd FD
writefd) <- IO (Fd, Fd)
Posix.createPipe
(FD, FD) -> IO (FD, FD)
forall (m :: * -> *) a. Monad m => a -> m a
return (FD
readfd, FD
writefd)