{-# LINE 1 "System/Posix/Process/PosixString.hsc" #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Process.PosixString
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX process support.  See also the System.Cmd and System.Process
-- modules in the process package.
--
-----------------------------------------------------------------------------

module System.Posix.Process.PosixString (
    -- * Processes

    -- ** Forking and executing
    forkProcess,
    forkProcessWithUnmask,
    executeFile,

    -- ** Exiting
    exitImmediately,

    -- ** Process environment
    getProcessID,
    getParentProcessID,

    -- ** Process groups
    getProcessGroupID,
    getProcessGroupIDOf,
    createProcessGroupFor,
    joinProcessGroup,
    setProcessGroupIDOf,

    -- ** Sessions
    createSession,

    -- ** Process times
    ProcessTimes(..),
    getProcessTimes,

    -- ** Scheduling priority
    nice,
    getProcessPriority,
    getProcessGroupPriority,
    getUserPriority,
    setProcessPriority,
    setProcessGroupPriority,
    setUserPriority,

    -- ** Process status
    ProcessStatus(..),
    getProcessStatus,
    getAnyProcessStatus,
    getGroupProcessStatus,

    -- ** Deprecated
    createProcessGroup,
    setProcessGroupID,

 ) where



import Foreign
import System.Posix.Process.Internals
import System.Posix.Process (ProcessTimes(..), setProcessGroupID, createProcessGroup, getGroupProcessStatus, getAnyProcessStatus, getProcessStatus, setUserPriority, setProcessGroupPriority, setProcessPriority, getUserPriority, getProcessGroupPriority, getProcessPriority, nice, getProcessTimes, createSession, setProcessGroupIDOf, joinProcessGroup, createProcessGroupFor, getProcessGroupIDOf, getProcessGroupID, getParentProcessID, getProcessID, exitImmediately, forkProcessWithUnmask, forkProcess)

import Foreign.C hiding (
     throwErrnoPath,
     throwErrnoPathIf,
     throwErrnoPathIf_,
     throwErrnoPathIfNull,
     throwErrnoPathIfMinus1,
     throwErrnoPathIfMinus1_ )

import System.OsPath.Types
import System.OsString.Internal.Types (PosixString(..))
import qualified System.OsPath.Data.ByteString.Short as BC

import System.Posix.PosixPath.FilePath

-- | @'executeFile' cmd args env@ calls one of the
--   @execv*@ family, depending on whether or not the current
--   PATH is to be searched for the command, and whether or not an
--   environment is provided to supersede the process's current
--   environment.  The basename (leading directory names suppressed) of
--   the command is passed to @execv*@ as @arg[0]@;
--   the argument list passed to 'executeFile' therefore
--   begins with @arg[1]@.
executeFile :: PosixPath                        -- ^ Command
            -> Bool                                 -- ^ Search PATH?
            -> [PosixString]                         -- ^ Arguments
            -> Maybe [(PosixString, PosixString)]     -- ^ Environment
            -> IO a
executeFile :: forall a.
PosixPath
-> Bool -> [PosixPath] -> Maybe [(PosixPath, PosixPath)] -> IO a
executeFile PosixPath
path Bool
search [PosixPath]
args Maybe [(PosixPath, PosixPath)]
Nothing = do
  forall a. PosixPath -> (Ptr CChar -> IO a) -> IO a
withFilePath PosixPath
path forall a b. (a -> b) -> a -> b
$ \Ptr CChar
s ->
    forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany forall a. PosixPath -> (Ptr CChar -> IO a) -> IO a
withFilePath (PosixPath
pathforall a. a -> [a] -> [a]
:[PosixPath]
args) forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cstrs ->
      forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 forall a. Ptr a
nullPtr [Ptr CChar]
cstrs forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
arr -> do
        IO ()
pPrPr_disableITimers
        if Bool
search
           then forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"executeFile" PosixPath
path (Ptr CChar -> Ptr (Ptr CChar) -> IO CInt
c_execvp Ptr CChar
s Ptr (Ptr CChar)
arr)
           else forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"executeFile" PosixPath
path (Ptr CChar -> Ptr (Ptr CChar) -> IO CInt
c_execv Ptr CChar
s Ptr (Ptr CChar)
arr)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. HasCallStack => a
undefined -- never reached

executeFile PosixPath
path Bool
search [PosixPath]
args (Just [(PosixPath, PosixPath)]
env) = do
  forall a. PosixPath -> (Ptr CChar -> IO a) -> IO a
withFilePath PosixPath
path forall a b. (a -> b) -> a -> b
$ \Ptr CChar
s ->
    forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany forall a. PosixPath -> (Ptr CChar -> IO a) -> IO a
withFilePath (PosixPath
pathforall a. a -> [a] -> [a]
:[PosixPath]
args) forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cstrs ->
      forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 forall a. Ptr a
nullPtr [Ptr CChar]
cstrs forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
arg_arr ->
    let env' :: [PosixPath]
env' = forall a b. (a -> b) -> [a] -> [b]
map (\ (PosixString ShortByteString
name, PosixString ShortByteString
val) -> ShortByteString -> PosixPath
PosixString forall a b. (a -> b) -> a -> b
$ ShortByteString
name ShortByteString -> ShortByteString -> ShortByteString
`BC.append` (Word8
_equal Word8 -> ShortByteString -> ShortByteString
`BC.cons` ShortByteString
val)) [(PosixPath, PosixPath)]
env in
    forall a b res.
(a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
withMany forall a. PosixPath -> (Ptr CChar -> IO a) -> IO a
withFilePath [PosixPath]
env' forall a b. (a -> b) -> a -> b
$ \[Ptr CChar]
cenv ->
      forall a b. Storable a => a -> [a] -> (Ptr a -> IO b) -> IO b
withArray0 forall a. Ptr a
nullPtr [Ptr CChar]
cenv forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
env_arr -> do
        IO ()
pPrPr_disableITimers
        if Bool
search
           then forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"executeFile" PosixPath
path
                   (Ptr CChar -> Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> IO CInt
c_execvpe Ptr CChar
s Ptr (Ptr CChar)
arg_arr Ptr (Ptr CChar)
env_arr)
           else forall a. (Eq a, Num a) => String -> PosixPath -> IO a -> IO ()
throwErrnoPathIfMinus1_ String
"executeFile" PosixPath
path
                   (Ptr CChar -> Ptr (Ptr CChar) -> Ptr (Ptr CChar) -> IO CInt
c_execve Ptr CChar
s Ptr (Ptr CChar)
arg_arr Ptr (Ptr CChar)
env_arr)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a. HasCallStack => a
undefined -- never reached

foreign import ccall unsafe "execvp"
  c_execvp :: CString -> Ptr CString -> IO CInt

foreign import ccall unsafe "execv"
  c_execv :: CString -> Ptr CString -> IO CInt

foreign import ccall unsafe "execve"
  c_execve :: CString -> Ptr CString -> Ptr CString -> IO CInt

_equal :: Word8
_equal :: Word8
_equal = Word8
0x3d