module Procex.Execve (Execve, execve, forkexecve) where
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as B
import Foreign
import Foreign.C.Types
import System.Posix.ByteString
import Prelude
type ExecveRaw =
Ptr CChar ->
Ptr (Ptr CChar) ->
Ptr (Ptr CChar) ->
Ptr Fd ->
CSize ->
IO CPid
type Execve =
ByteString ->
[ByteString] ->
Maybe [ByteString] ->
[Fd] ->
IO (Maybe CPid)
foreign import ccall "vfork_close_execve" c_vfork_close_execve :: ExecveRaw
foreign import ccall "close_execve" c_close_execve :: ExecveRaw
exec' :: ExecveRaw -> ByteString -> [ByteString] -> Maybe [ByteString] -> [Fd] -> IO CPid
exec' :: ExecveRaw
-> ByteString
-> [ByteString]
-> Maybe [ByteString]
-> [Fd]
-> IO CPid
exec' ExecveRaw
f ByteString
path [ByteString]
args Maybe [ByteString]
env [Fd]
fds = do
let go :: [BS.ByteString] -> ([Ptr CChar] -> IO a) -> IO a
go :: forall a. [ByteString] -> ([Ptr CChar] -> IO a) -> IO a
go [] [Ptr CChar] -> IO a
f = [Ptr CChar] -> IO a
f []
go (ByteString
x : [ByteString]
xs) [Ptr CChar] -> IO a
f = forall a. [ByteString] -> ([Ptr CChar] -> IO a) -> IO a
go [ByteString]
xs (\[Ptr CChar]
ys -> forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString ByteString
x forall a b. (a -> b) -> a -> b
$ \Ptr CChar
y -> [Ptr CChar] -> IO a
f (Ptr CChar
y forall a. a -> [a] -> [a]
: [Ptr CChar]
ys))
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BS.useAsCString (ByteString -> ByteString
B.toStrict ByteString
path) forall a b. (a -> b) -> a -> b
$ \Ptr CChar
path ->
forall a. [ByteString] -> ([Ptr CChar] -> IO a) -> IO a
go (ByteString -> ByteString
B.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
args) forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
args ->
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 forall a. Ptr a
nullPtr [Ptr CChar]
args forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
args ->
forall a b. Storable a => [a] -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen [Fd]
fds forall a b. (a -> b) -> a -> b
$ \Int
fd_count Ptr Fd
fds ->
case Maybe [ByteString]
env of
Just [ByteString]
env ->
forall a. [ByteString] -> ([Ptr CChar] -> IO a) -> IO a
go (ByteString -> ByteString
B.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
env) forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
env ->
forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 forall a. Ptr a
nullPtr [Ptr CChar]
env forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
env ->
ExecveRaw
f Ptr CChar
path Ptr (Ptr CChar)
args Ptr (Ptr CChar)
env Ptr Fd
fds (Word64 -> CSize
CSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
fd_count)
Maybe [ByteString]
Nothing -> ExecveRaw
f Ptr CChar
path Ptr (Ptr CChar)
args forall a. Ptr a
nullPtr Ptr Fd
fds (Word64 -> CSize
CSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
fd_count)
execve :: Execve
execve :: Execve
execve ByteString
path [ByteString]
args Maybe [ByteString]
env [Fd]
fds = forall a b. a -> b -> a
const forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExecveRaw
-> ByteString
-> [ByteString]
-> Maybe [ByteString]
-> [Fd]
-> IO CPid
exec' ExecveRaw
c_close_execve ByteString
path [ByteString]
args Maybe [ByteString]
env [Fd]
fds
forkexecve :: Execve
forkexecve :: Execve
forkexecve ByteString
path [ByteString]
args Maybe [ByteString]
env [Fd]
fds = CPid -> Maybe CPid
h forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExecveRaw
-> ByteString
-> [ByteString]
-> Maybe [ByteString]
-> [Fd]
-> IO CPid
exec' ExecveRaw
c_vfork_close_execve ByteString
path [ByteString]
args Maybe [ByteString]
env [Fd]
fds
where
h :: CPid -> Maybe CPid
h :: CPid -> Maybe CPid
h (CPid (-1)) = forall a. Maybe a
Nothing
h CPid
x = forall a. a -> Maybe a
Just CPid
x