{-# 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
) 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
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)
#ifdef WINDOWS
import Data.Word (Word32)
import System.Win32.DebugApi (PHANDLE)
#else
import System.Posix.Types
#endif
#ifdef 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
showList :: [CreateProcess] -> ShowS
$cshowList :: [CreateProcess] -> ShowS
show :: CreateProcess -> FilePath
$cshow :: CreateProcess -> FilePath
showsPrec :: Int -> CreateProcess -> ShowS
$cshowsPrec :: Int -> CreateProcess -> ShowS
Show, CreateProcess -> CreateProcess -> Bool
(CreateProcess -> CreateProcess -> Bool)
-> (CreateProcess -> CreateProcess -> Bool) -> Eq CreateProcess
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProcess -> CreateProcess -> Bool
$c/= :: CreateProcess -> CreateProcess -> Bool
== :: CreateProcess -> CreateProcess -> Bool
$c== :: 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
showList :: [CmdSpec] -> ShowS
$cshowList :: [CmdSpec] -> ShowS
show :: CmdSpec -> FilePath
$cshow :: CmdSpec -> FilePath
showsPrec :: Int -> CmdSpec -> ShowS
$cshowsPrec :: Int -> CmdSpec -> ShowS
Show, CmdSpec -> CmdSpec -> Bool
(CmdSpec -> CmdSpec -> Bool)
-> (CmdSpec -> CmdSpec -> Bool) -> Eq CmdSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CmdSpec -> CmdSpec -> Bool
$c/= :: CmdSpec -> CmdSpec -> Bool
== :: CmdSpec -> CmdSpec -> Bool
$c== :: 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
/= :: StdStream -> StdStream -> Bool
$c/= :: StdStream -> StdStream -> Bool
== :: StdStream -> StdStream -> Bool
$c== :: 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
showList :: [StdStream] -> ShowS
$cshowList :: [StdStream] -> ShowS
show :: StdStream -> FilePath
$cshow :: StdStream -> FilePath
showsPrec :: Int -> StdStream -> ShowS
$cshowsPrec :: Int -> StdStream -> ShowS
Show)
data ProcessHandle__ = OpenHandle PHANDLE
| OpenExtHandle PHANDLE PHANDLE 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 :: FilePath -> IO a -> IO a
withFilePathException fpath :: FilePath
fpath act :: 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 ex :: 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 :: ProcessHandle
-> (ProcessHandle__ -> IO (ProcessHandle__, a)) -> IO a
modifyProcessHandle (ProcessHandle m :: MVar ProcessHandle__
m _ _) io :: 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 :: ProcessHandle -> (ProcessHandle__ -> IO a) -> IO a
withProcessHandle (ProcessHandle m :: MVar ProcessHandle__
m _ _) io :: 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 = 0
fd_stdout :: FD
fd_stdout = 1
fd_stderr :: FD
fd_stderr = 2
mbFd :: String -> FD -> StdStream -> IO FD
mbFd :: FilePath -> FD -> StdStream -> IO FD
mbFd _ _std :: FD
_std CreatePipe = FD -> IO FD
forall (m :: * -> *) a. Monad m => a -> m a
return (-1)
mbFd _fun :: FilePath
_fun std :: FD
std Inherit = FD -> IO FD
forall (m :: * -> *) a. Monad m => a -> m a
return FD
std
mbFd _fn :: FilePath
_fn _std :: FD
_std NoStream = FD -> IO FD
forall (m :: * -> *) a. Monad m => a -> m a
return (-2)
mbFd fun :: FilePath
fun _std :: FD
_std (UseHandle hdl :: 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,..} ->
case dev -> Maybe FD
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast dev
dev of
Just fd :: FD
fd -> do
FD
fd' <- FD -> Bool -> IO FD
FD.setNonBlockingMode FD
fd Bool
False
(Handle__, FD) -> IO (Handle__, FD)
forall (m :: * -> *) a. Monad m => a -> m a
return ($WHandle__ :: forall dev enc_state dec_state.
(IODevice dev, BufferedIO dev, Typeable dev) =>
dev
-> HandleType
-> IORef (Buffer Word8)
-> BufferMode
-> IORef (dec_state, Buffer Word8)
-> IORef (Buffer CharBufElem)
-> IORef (BufferList CharBufElem)
-> Maybe (TextEncoder enc_state)
-> Maybe (TextDecoder dec_state)
-> Maybe TextEncoding
-> Newline
-> Newline
-> Maybe (MVar Handle__)
-> Handle__
Handle__{haDevice :: FD
haDevice=FD
fd',..}, FD -> FD
FD.fdFD FD
fd')
Nothing ->
IOError -> IO (Handle__, FD)
forall a. IOError -> IO a
ioError (IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
illegalOperationErrorType
"createProcess" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
hdl) Maybe FilePath
forall a. Maybe a
Nothing
IOError -> FilePath -> IOError
`ioeSetErrorString` "handle is not a file descriptor")
mbPipe :: StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe :: StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle)
mbPipe CreatePipe pfd :: Ptr FD
pfd mode :: IOMode
mode = (Handle -> Maybe Handle) -> IO Handle -> IO (Maybe Handle)
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 _std :: StdStream
_std _pfd :: Ptr FD
_pfd _mode :: IOMode
_mode = Maybe Handle -> IO (Maybe Handle)
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 pfd :: Ptr FD
pfd mode :: 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 = "fd:" FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FD -> FilePath
forall a. Show a => a -> FilePath
show FD
fd
(fD :: FD
fD,fd_type :: 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,0,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)