{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
module System.Process.Common
( CreateProcess (..)
, CmdSpec (..)
, StdStream (..)
, ProcessHandle(..)
, ProcessHandle__(..)
, ProcRetHandles (..)
, withFilePathException
, PHANDLE
, GroupID
, UserID
, modifyProcessHandle
, withProcessHandle
, fd_stdin
, fd_stdout
, fd_stderr
, mbFd
, mbPipe
, pfdToHandle
#ifdef WINDOWS
, CGid (..)
#else
, CGid
#endif
#if defined(__IO_MANAGER_WINIO__)
, HANDLE
, mbHANDLE
, mbPipeHANDLE
#endif
) where
import Control.Concurrent
import Control.Exception
import Data.String
import Foreign.Ptr
import Foreign.Storable
import System.Posix.Internals
import GHC.IO.Exception
import GHC.IO.Encoding
import qualified GHC.IO.FD as FD
import GHC.IO.Device
#if defined(__IO_MANAGER_WINIO__)
import GHC.IO.Handle.Windows
import GHC.IO.Windows.Handle (fromHANDLE, Io(), NativeHandle())
#endif
import GHC.IO.Handle.FD
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Types hiding (ClosedHandle)
import System.IO.Error
import Data.Typeable
import System.IO (IOMode)
#if defined(javascript_HOST_ARCH)
import GHC.JS.Prim (JSVal)
#endif
#ifdef WINDOWS
import Data.Word (Word32)
import System.Win32.DebugApi (PHANDLE)
#if defined(__IO_MANAGER_WINIO__)
import System.Win32.Types (HANDLE)
#endif
#else
import System.Posix.Types
#endif
#if defined(javascript_HOST_ARCH)
type PHANDLE = JSVal
#elif defined(WINDOWS)
newtype CGid = CGid Word32
deriving (Show, Eq)
type GroupID = CGid
type UserID = CGid
#else
type PHANDLE = CPid
#endif
data CreateProcess = CreateProcess{
CreateProcess -> CmdSpec
cmdspec :: CmdSpec,
CreateProcess -> Maybe FilePath
cwd :: Maybe FilePath,
CreateProcess -> Maybe [(FilePath, FilePath)]
env :: Maybe [(String,String)],
CreateProcess -> StdStream
std_in :: StdStream,
CreateProcess -> StdStream
std_out :: StdStream,
CreateProcess -> StdStream
std_err :: StdStream,
CreateProcess -> Bool
close_fds :: Bool,
CreateProcess -> Bool
create_group :: Bool,
CreateProcess -> Bool
delegate_ctlc:: Bool,
CreateProcess -> Bool
detach_console :: Bool,
CreateProcess -> Bool
create_new_console :: Bool,
CreateProcess -> Bool
new_session :: Bool,
CreateProcess -> Maybe GroupID
child_group :: Maybe GroupID,
CreateProcess -> Maybe UserID
child_user :: Maybe UserID,
CreateProcess -> Bool
use_process_jobs :: Bool
} deriving (Int -> CreateProcess -> ShowS
[CreateProcess] -> ShowS
CreateProcess -> FilePath
(Int -> CreateProcess -> ShowS)
-> (CreateProcess -> FilePath)
-> ([CreateProcess] -> ShowS)
-> Show CreateProcess
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateProcess -> ShowS
showsPrec :: Int -> CreateProcess -> ShowS
$cshow :: CreateProcess -> FilePath
show :: CreateProcess -> FilePath
$cshowList :: [CreateProcess] -> ShowS
showList :: [CreateProcess] -> ShowS
Show, CreateProcess -> CreateProcess -> Bool
(CreateProcess -> CreateProcess -> Bool)
-> (CreateProcess -> CreateProcess -> Bool) -> Eq CreateProcess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateProcess -> CreateProcess -> Bool
== :: CreateProcess -> CreateProcess -> Bool
$c/= :: CreateProcess -> CreateProcess -> Bool
/= :: CreateProcess -> CreateProcess -> Bool
Eq)
data ProcRetHandles
= ProcRetHandles { ProcRetHandles -> Maybe Handle
hStdInput :: Maybe Handle
, ProcRetHandles -> Maybe Handle
hStdOutput :: Maybe Handle
, ProcRetHandles -> Maybe Handle
hStdError :: Maybe Handle
, ProcRetHandles -> ProcessHandle
procHandle :: ProcessHandle
}
data CmdSpec
= ShellCommand String
| RawCommand FilePath [String]
deriving (Int -> CmdSpec -> ShowS
[CmdSpec] -> ShowS
CmdSpec -> FilePath
(Int -> CmdSpec -> ShowS)
-> (CmdSpec -> FilePath) -> ([CmdSpec] -> ShowS) -> Show CmdSpec
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CmdSpec -> ShowS
showsPrec :: Int -> CmdSpec -> ShowS
$cshow :: CmdSpec -> FilePath
show :: CmdSpec -> FilePath
$cshowList :: [CmdSpec] -> ShowS
showList :: [CmdSpec] -> ShowS
Show, CmdSpec -> CmdSpec -> Bool
(CmdSpec -> CmdSpec -> Bool)
-> (CmdSpec -> CmdSpec -> Bool) -> Eq CmdSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CmdSpec -> CmdSpec -> Bool
== :: CmdSpec -> CmdSpec -> Bool
$c/= :: CmdSpec -> CmdSpec -> Bool
/= :: CmdSpec -> CmdSpec -> Bool
Eq)
instance IsString CmdSpec where
fromString :: FilePath -> CmdSpec
fromString = FilePath -> CmdSpec
ShellCommand
data StdStream
= Inherit
| UseHandle Handle
| CreatePipe
| NoStream
deriving (StdStream -> StdStream -> Bool
(StdStream -> StdStream -> Bool)
-> (StdStream -> StdStream -> Bool) -> Eq StdStream
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StdStream -> StdStream -> Bool
== :: StdStream -> StdStream -> Bool
$c/= :: StdStream -> StdStream -> Bool
/= :: StdStream -> StdStream -> Bool
Eq, Int -> StdStream -> ShowS
[StdStream] -> ShowS
StdStream -> FilePath
(Int -> StdStream -> ShowS)
-> (StdStream -> FilePath)
-> ([StdStream] -> ShowS)
-> Show StdStream
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StdStream -> ShowS
showsPrec :: Int -> StdStream -> ShowS
$cshow :: StdStream -> FilePath
show :: StdStream -> FilePath
$cshowList :: [StdStream] -> ShowS
showList :: [StdStream] -> ShowS
Show)
data ProcessHandle__ = OpenHandle { ProcessHandle__ -> PHANDLE
phdlProcessHandle :: PHANDLE }
| OpenExtHandle { phdlProcessHandle :: PHANDLE
, ProcessHandle__ -> PHANDLE
phdlJobHandle :: PHANDLE
}
| ClosedHandle ExitCode
data ProcessHandle
= ProcessHandle { ProcessHandle -> MVar ProcessHandle__
phandle :: !(MVar ProcessHandle__)
, ProcessHandle -> Bool
mb_delegate_ctlc :: !Bool
, ProcessHandle -> MVar ()
waitpidLock :: !(MVar ())
}
withFilePathException :: FilePath -> IO a -> IO a
withFilePathException :: forall a. FilePath -> IO a -> IO a
withFilePathException FilePath
fpath IO a
act = (IOError -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOError -> IO a
forall {a}. IOError -> IO a
mapEx IO a
act
where
mapEx :: IOError -> IO a
mapEx IOError
ex = IOError -> IO a
forall {a}. IOError -> IO a
ioError (IOError -> FilePath -> IOError
ioeSetFileName IOError
ex FilePath
fpath)
modifyProcessHandle
:: ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a))
-> IO a
modifyProcessHandle :: forall a.
ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle (ProcessHandle MVar ProcessHandle__
m Bool
_ MVar ()
_) ProcessHandle__ -> IO (ProcessHandle__, a)
io = MVar ProcessHandle__
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar ProcessHandle__
m ProcessHandle__ -> IO (ProcessHandle__, a)
io
withProcessHandle
:: ProcessHandle
-> (ProcessHandle__ -> IO a)
-> IO a
withProcessHandle :: forall a. ProcessHandle -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle (ProcessHandle MVar ProcessHandle__
m Bool
_ MVar ()
_) ProcessHandle__ -> IO a
io = MVar ProcessHandle__ -> (ProcessHandle__ -> IO a) -> IO a
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar ProcessHandle__
m ProcessHandle__ -> IO a
io
fd_stdin, fd_stdout, fd_stderr :: FD
fd_stdin :: FD
fd_stdin = FD
0
fd_stdout :: FD
fd_stdout = FD
1
fd_stderr :: FD
fd_stderr = FD
2
mbFd :: String -> FD -> StdStream -> IO FD
mbFd :: FilePath -> FD -> StdStream -> IO FD
mbFd FilePath
_ FD
_std StdStream
CreatePipe = FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-FD
1)
mbFd FilePath
_fun FD
std StdStream
Inherit = FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FD
std
mbFd FilePath
_fn FD
_std StdStream
NoStream = FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-FD
2)
mbFd FilePath
fun FD
_std (UseHandle Handle
hdl) =
FilePath -> Handle -> (Handle__ -> IO (Handle__, FD)) -> IO FD
forall a.
FilePath -> Handle -> (Handle__ -> IO (Handle__, a)) -> IO a
withHandle FilePath
fun Handle
hdl ((Handle__ -> IO (Handle__, FD)) -> IO FD)
-> (Handle__ -> IO (Handle__, FD)) -> IO FD
forall a b. (a -> b) -> a -> b
$ \Handle__{haDevice :: ()
haDevice=dev
dev,Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haOtherSide :: Handle__ -> Maybe (MVar Handle__)
haOutputNL :: Handle__ -> Newline
haInputNL :: Handle__ -> Newline
haCodec :: Handle__ -> Maybe TextEncoding
haDecoder :: ()
haEncoder :: ()
haBuffers :: Handle__ -> IORef (BufferList Char)
haCharBuffer :: Handle__ -> IORef (Buffer Char)
haLastDecode :: ()
haBufferMode :: Handle__ -> BufferMode
haByteBuffer :: Handle__ -> IORef (Buffer Word8)
haType :: Handle__ -> HandleType
..} -> do
case dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
dev of
Just FD
fd -> do
#if !defined(javascript_HOST_ARCH)
FD
fd' <- FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fd Bool
False
#else
fd' <- pure fd
#endif
(Handle__, FD) -> IO (Handle__, FD)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle__{haDevice :: FD
haDevice=FD
fd',Maybe (MVar Handle__)
Maybe TextEncoding
Maybe (TextEncoder enc_state)
Maybe (TextDecoder dec_state)
IORef (dec_state, Buffer Word8)
IORef (Buffer Char)
IORef (Buffer Word8)
IORef (BufferList Char)
Newline
BufferMode
HandleType
haType :: HandleType
haByteBuffer :: IORef (Buffer Word8)
haBufferMode :: BufferMode
haLastDecode :: IORef (dec_state, Buffer Word8)
haCharBuffer :: IORef (Buffer Char)
haBuffers :: IORef (BufferList Char)
haEncoder :: Maybe (TextEncoder enc_state)
haDecoder :: Maybe (TextDecoder dec_state)
haCodec :: Maybe TextEncoding
haInputNL :: Newline
haOutputNL :: Newline
haOtherSide :: Maybe (MVar Handle__)
haOtherSide :: Maybe (MVar Handle__)
haOutputNL :: Newline
haInputNL :: Newline
haCodec :: Maybe TextEncoding
haDecoder :: Maybe (TextDecoder dec_state)
haEncoder :: Maybe (TextEncoder enc_state)
haBuffers :: IORef (BufferList Char)
haCharBuffer :: IORef (Buffer Char)
haLastDecode :: IORef (dec_state, Buffer Word8)
haBufferMode :: BufferMode
haByteBuffer :: IORef (Buffer Word8)
haType :: HandleType
..}, FD -> FD
FD.fdFD FD
fd')
Maybe FD
Nothing ->
IOError -> IO (Handle__, FD)
forall {a}. IOError -> IO a
ioError (IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
illegalOperationErrorType
FilePath
"createProcess" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hdl) Maybe FilePath
forall a. Maybe a
Nothing
IOError -> FilePath -> IOError
`ioeSetErrorString` FilePath
"handle is not a file descriptor")
mbPipe :: StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe :: StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe StdStream
CreatePipe Ptr FD
pfd IOMode
mode = (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Handle -> Maybe Handle
forall a. a -> Maybe a
Just (Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode)
mbPipe StdStream
_std Ptr FD
_pfd IOMode
_mode = Maybe Handle -> IO (Maybe Handle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Handle
forall a. Maybe a
Nothing
pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle :: Ptr FD -> IOMode -> IO Handle
pfdToHandle Ptr FD
pfd IOMode
mode = do
FD
fd <- Ptr FD -> IO FD
forall a. Storable a => Ptr a -> IO a
peek Ptr FD
pfd
let filepath :: FilePath
filepath = FilePath
"fd:" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FD -> FilePath
forall a. Show a => a -> FilePath
show FD
fd
(FD
fD,IODeviceType
fd_type) <- FD
-> IOMode
-> Maybe (IODeviceType, CDev, CIno)
-> Bool
-> Bool
-> IO (FD, IODeviceType)
FD.mkFD (FD -> FD
forall a b. (Integral a, Num b) => a -> b
fromIntegral FD
fd) IOMode
mode
((IODeviceType, CDev, CIno) -> Maybe (IODeviceType, CDev, CIno)
forall a. a -> Maybe a
Just (IODeviceType
Stream,CDev
0,CIno
0))
Bool
False
Bool
False
FD
fD' <- FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fD Bool
True
#if __GLASGOW_HASKELL__ >= 704
TextEncoding
enc <- IO TextEncoding
getLocaleEncoding
#else
let enc = localeEncoding
#endif
FD
-> IODeviceType
-> FilePath
-> IOMode
-> Bool
-> Maybe TextEncoding
-> IO Handle
mkHandleFromFD FD
fD' IODeviceType
fd_type FilePath
filepath IOMode
mode Bool
False (TextEncoding -> Maybe TextEncoding
forall a. a -> Maybe a
Just TextEncoding
enc)
#if defined(__IO_MANAGER_WINIO__)
mbHANDLE :: HANDLE -> StdStream -> IO HANDLE
mbHANDLE _std CreatePipe = return $ intPtrToPtr (-1)
mbHANDLE std Inherit = return std
mbHANDLE _std NoStream = return $ intPtrToPtr (-2)
mbHANDLE _std (UseHandle hdl) = handleToHANDLE hdl
mbPipeHANDLE :: StdStream -> Ptr HANDLE -> IOMode -> IO (Maybe Handle)
mbPipeHANDLE CreatePipe pfd mode =
do raw_handle <- peek pfd
let hwnd = fromHANDLE raw_handle :: Io NativeHandle
ident = "hwnd:" ++ show raw_handle
enc <- fmap Just getLocaleEncoding
Just <$> mkHandleFromHANDLE hwnd Stream ident mode enc
mbPipeHANDLE _std _pfd _mode = return Nothing
#endif