    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE CPP #-}
    module System.Process.Posix
        ( mkProcessHandle
        , translateInternal
        , createProcess_Internal
        , withCEnvironment
        , closePHANDLE
        , startDelegateControlC
        , endDelegateControlC
        , stopDelegateControlC
        , isDefaultSignal
        , ignoreSignal
        , defaultSignal
        , c_execvpe
        , pPrPr_disableITimers
        , createPipeInternal
        , createPipeInternalFd
        , interruptProcessGroupOfInternal
        , runInteractiveProcess_lock
        ) where

    import Control.Concurrent
    import Control.Exception
    import Data.Bits
    import Foreign.C
    import Foreign.Marshal
    import Foreign.Ptr
    import Foreign.Storable
    import System.IO.Unsafe

    import Control.Monad
    import Data.Char
    import System.IO
    import System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe )
    import System.Posix.Types

    import System.Posix.Internals
    import GHC.IO.Exception
    import System.Posix.Signals as Sig
    import qualified System.Posix.IO as Posix
    import System.Posix.Process (getProcessGroupIDOf)

    import System.Process.Common hiding (mb_delegate_ctlc)

    #include "HsProcessConfig.h"
    #include "processFlags.h"

    mkProcessHandle :: PHANDLE -> Bool -> IO ProcessHandle
    mkProcessHandle :: PHANDLE -> Bool -> IO ProcessHandle
    mkProcessHandle PHANDLE
    p Bool
    mb_delegate_ctlc = do
      MVar 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 (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 (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 -> String
    translateInternal :: 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
    all Char -> Bool
    goodChar FilePath
    str = FilePath
    str
     | Bool
    otherwise        = Char
    '\'' Char -> FilePath -> FilePath
    forall a. a -> [a] -> [a]
    : (Char -> FilePath -> FilePath) -> FilePath -> FilePath -> FilePath
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Char -> FilePath -> FilePath
    escape FilePath
    "'" FilePath
    str
      where escape :: Char -> FilePath -> FilePath
    escape Char
    '\'' = FilePath -> FilePath -> FilePath
    showString FilePath
    "'\\''"
            escape Char
    c    = Char -> FilePath -> FilePath
    showChar Char
    c
            goodChar :: Char -> Bool
    goodChar Char
    c = Char -> Bool
    isAlphaNum Char
    c Bool -> Bool -> Bool
    || Char
    c Char -> FilePath -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` FilePath
    "-_.,/"

    -- ----------------------------------------------------------------------------
    -- Utils

    withCEnvironment :: [(String,String)] -> (Ptr CString  -> IO a) -> IO a
    withCEnvironment :: forall a. [(FilePath, FilePath)] -> (Ptr CString -> IO a) -> IO a
    withCEnvironment [(FilePath, FilePath)]
    envir Ptr CString -> IO a
    act =
      let env' :: [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
    withMany FilePath -> (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
    withArray0 CString
    forall a. Ptr a
    nullPtr [CString]
    pEnv Ptr CString -> IO a
    act)

    -- -----------------------------------------------------------------------------
    -- POSIX runProcess with signal handling in the child

    createProcess_Internal
        :: String
        -> CreateProcess
        -> IO ProcRetHandles
    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 }
     = do
      let (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
    maybeWith FilePath -> (CString -> IO ProcRetHandles) -> IO ProcRetHandles
    forall a. FilePath -> (CString -> IO a) -> IO a
    withFilePath Maybe 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
    maybeWith GroupID -> (Ptr GroupID -> IO ProcRetHandles) -> IO ProcRetHandles
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with Maybe 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
    maybeWith UserID -> (Ptr UserID -> IO ProcRetHandles) -> IO ProcRetHandles
    forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with Maybe 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)
    -> [FilePath]
    -> ([CString] -> IO ProcRetHandles)
    -> IO ProcRetHandles
    forall a b res.
    (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
    withMany FilePath -> (CString -> IO ProcRetHandles) -> IO ProcRetHandles
    forall a. FilePath -> (CString -> IO a) -> IO a
    withFilePath (FilePath
    cmdFilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    :[FilePath]
    args) (([CString] -> IO ProcRetHandles) -> IO ProcRetHandles)
    -> ([CString] -> IO ProcRetHandles) -> IO ProcRetHandles
    forall a b. (a -> b) -> a -> b
    $ \[CString]
    cstrs ->
       CString
    -> [CString]
    -> (Ptr CString -> IO ProcRetHandles)
    -> IO ProcRetHandles
    forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
    withArray0 CString
    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 -> do

         FD
    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 ()
    when Bool
    mb_delegate_ctlc
           IO ()
    startDelegateControlC

         let flags :: FD
    flags = (if Bool
    mb_close_fds then RUN_PROCESS_IN_CLOSE_FDS else 0)
                      FD -> FD -> FD
    forall a. Bits a => a -> a -> a
    .|.(if Bool
    mb_create_group then RUN_PROCESS_IN_NEW_GROUP else 0)
                      FD -> FD -> FD
    forall a. Bits a => a -> a -> a
    .|.(if Bool
    mb_detach_console then RUN_PROCESS_DETACHED else 0)
                      FD -> FD -> FD
    forall a. Bits a => a -> a -> a
    .|.(if Bool
    mb_create_new_console then RUN_PROCESS_NEW_CONSOLE else 0)
                      FD -> FD -> FD
    forall a. Bits a => a -> a -> a
    .|.(if Bool
    mb_new_session then RUN_PROCESS_NEW_SESSION else 0)
                      FD -> FD -> FD
    forall a. Bits a => a -> a -> a
    .|.(if Bool
    mb_delegate_ctlc then RESET_INT_QUIT_HANDLERS else 0)

         -- See the comment on runInteractiveProcess_lock
         PHANDLE
    proc_handle <- MVar () -> (() -> IO PHANDLE) -> IO PHANDLE
    forall a b. MVar a -> (a -> IO b) -> IO b
    withMVar MVar ()
    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
    $ do
             CString
    cFailedDoing <- Ptr CString -> IO CString
    forall a. Storable a => Ptr a -> IO a
    peek Ptr CString
    pFailedDoing
             FilePath
    failedDoing <- CString -> IO FilePath
    peekCString CString
    cFailedDoing
             Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    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
    WriteMode
         Maybe Handle
    hndStdOutput <- StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
    mbPipe StdStream
    mb_stdout Ptr FD
    pfdStdOutput IOMode
    ReadMode
         Maybe Handle
    hndStdError  <- StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
    mbPipe StdStream
    mb_stderr Ptr FD
    pfdStdError  IOMode
    ReadMode

         ProcessHandle
    ph <- PHANDLE -> Bool -> IO ProcessHandle
    mkProcessHandle PHANDLE
    proc_handle Bool
    mb_delegate_ctlc
         ProcRetHandles -> IO ProcRetHandles
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProcRetHandles :: Maybe Handle
    -> Maybe Handle -> Maybe Handle -> ProcessHandle -> ProcRetHandles
    ProcRetHandles { 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
                               }

    {-# NOINLINE runInteractiveProcess_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.0
    runInteractiveProcess_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.

    {-# NOINLINE runInteractiveProcess_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)
    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))
    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 -> do
          case Maybe (Int, Handler, Handler)
    delegating of
            Maybe (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
    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
              -- If we're already doing it, just increment the count
              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))
    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 -> do
          case Maybe (Int, Handler, Handler)
    delegating of
            Just (Int
    1, Handler
    old_int, Handler
    old_quit) -> do
              -- Last process, so restore the old signal handlers
              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
              -- Not the last, just decrement the count
              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 -- should be impossible

    endDelegateControlC :: ExitCode -> IO ()
    endDelegateControlC :: ExitCode -> IO ()
    endDelegateControlC ExitCode
    exitCode = do
        IO ()
    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.
        case ExitCode
    exitCode of
          ExitFailure Int
    n | Int -> Bool
    forall {p}. Integral p => p -> 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 :: p -> Bool
    isSigIntQuit p
    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 = p -> FD
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (-p
    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                         -- flags
            -> Ptr CString
            -> IO PHANDLE

    ignoreSignal, defaultSignal :: CLong
    ignoreSignal :: CLong
    ignoreSignal  = CONST_SIG_IGN
    defaultSignal :: CLong
    defaultSignal = CONST_SIG_DFL

    isDefaultSignal :: CLong -> Bool
    isDefaultSignal :: 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.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)

    interruptProcessGroupOfInternal
        :: ProcessHandle    -- ^ A process in the process group
        -> IO ()
    interruptProcessGroupOfInternal :: ProcessHandle -> IO ()
    interruptProcessGroupOfInternal ProcessHandle
    ph = do
        ProcessHandle -> (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_ -> do
            case ProcessHandle__
    p_ of
                OpenExtHandle{} -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                ClosedHandle  ExitCode
    _ -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                OpenHandle    PHANDLE
    h -> do
                    PHANDLE
    pgid <- PHANDLE -> IO PHANDLE
    getProcessGroupIDOf PHANDLE
    h
                    FD -> PHANDLE -> IO ()
    signalProcessGroup FD
    sigINT PHANDLE
    pgid