-- | Contains FFI bindings to the C bits
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

-- | The signature for 'execve' and 'forkexecve'.
type Execve =
  -- | The full path to the executable.
  ByteString ->
  -- | The args to pass, including argv[0].
  [ByteString] ->
  -- | The environment to pass. Will default to the current environment if 'Nothing' is passed.
  Maybe [ByteString] ->
  -- | The fds to pass. All other fds will be closed. In the new process, the integral id for each fd will be
  -- set to the position the fd has in this list, e.g. the first element in this list will be stdin, and so on.
  [Fd] ->
  -- | The process id for the new process.
  IO (Maybe CPid)

foreign import ccall "vfork_close_execve" c_vfork_close_execve :: ExecveRaw

foreign import ccall "close_execve" c_close_execve :: ExecveRaw

-- foreign import ccall "execve" c_execve :: Ptr CChar -> Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> IO ()
-- foreign import ccall "&environ" c_environ :: Ptr (Ptr CChar)

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)

-- | Replace the current process with a new process.
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

-- | Fork and execute a new process.
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