{-# LANGUAGE CPP #-}
{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE InterruptibleFFI #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Process.Internals
-- Copyright   :  (c) The University of Glasgow 2004
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  portable
--
-- __Note:__ This module exports internal implementation details that may
-- change anytime.  If you want a more stable API, use "System.Process"
-- instead.
--
-----------------------------------------------------------------------------

module System.Process.Internals (
    ProcessHandle(..), ProcessHandle__(..),
    PHANDLE, closePHANDLE, mkProcessHandle,
#if defined(mingw32_HOST_OS)
    CGid(..),
#else
    CGid,
#endif
    GroupID,
    UserID,
    modifyProcessHandle, withProcessHandle,
    CreateProcess(..),
    CmdSpec(..), StdStream(..), ProcRetHandles (..),
    createProcess_,
    runGenProcess_, --deprecated
    fdToHandle,
    startDelegateControlC,
    endDelegateControlC,
    stopDelegateControlC,
    unwrapHandles,
#if defined(mingw32_HOST_OS)
    terminateJob,
    terminateJobUnsafe,
    waitForJobCompletion,
    timeout_Infinite,
#else
#if !defined(javascript_HOST_ARCH)
    pPrPr_disableITimers, c_execvpe,
    runInteractiveProcess_lock,
#endif
    ignoreSignal, defaultSignal,
#endif
    withFilePathException, withCEnvironment,
    translate,
    createPipe,
    createPipeFd,
    interruptProcessGroupOf,
    withForkWait,
    ignoreSigPipe,
    ) where

import Control.Concurrent
import Control.Exception (SomeException, mask, try, throwIO)
import qualified Control.Exception as C
import Foreign.C
import System.IO

import GHC.IO.Exception ( IOErrorType(..), IOException(..) )
import GHC.IO.Handle.FD (fdToHandle)
import System.Posix.Internals (FD)

import System.Process.Common

#if defined(javascript_HOST_ARCH)
import System.Process.JavaScript
#elif defined(mingw32_HOST_OS)
import System.Process.Windows
#else
import System.Process.Posix
#endif

-- ----------------------------------------------------------------------------
-- | This function is almost identical to
-- 'System.Process.createProcess'. The only differences are:
--
-- * 'Handle's provided via 'UseHandle' are not closed automatically.
--
-- * This function takes an extra @String@ argument to be used in creating
--   error messages.
--
-- This function has been available from the "System.Process.Internals" module
-- for some time, and is part of the "System.Process" module since version
-- 1.2.1.0.
--
-- @since 1.2.1.0
createProcess_
  :: String
       -- ^ Function name (for error messages).
       --
       --   This can be any 'String', but will typically be the name of the caller.
       --   E.g., 'spawnProcess' passes @"spawnProcess"@ here when calling
       --   'createProcess_'.
  -> CreateProcess
  -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ :: String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
msg CreateProcess
proc_ = ProcRetHandles
-> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
unwrapHandles (ProcRetHandles
 -> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO ProcRetHandles
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> CreateProcess -> IO ProcRetHandles
createProcess_Internal String
msg CreateProcess
proc_
{-# INLINE createProcess_ #-}

-- ------------------------------------------------------------------------
-- Escaping commands for shells

{-
On Windows we also use this for running commands.  We use CreateProcess,
passing a single command-line string (lpCommandLine) as its argument.
(CreateProcess is well documented on http://msdn.microsoft.com.)

      - It parses the beginning of the string to find the command. If the
        file name has embedded spaces, it must be quoted, using double
        quotes thus
                "foo\this that\cmd" arg1 arg2

      - The invoked command can in turn access the entire lpCommandLine string,
        and the C runtime does indeed do so, parsing it to generate the
        traditional argument vector argv[0], argv[1], etc.  It does this
        using a complex and arcane set of rules which are described here:

           https://msdn.microsoft.com/en-us/library/a1y7w461.aspx

        (if this URL stops working, you might be able to find it by
        searching for "Parsing C Command-Line Arguments" on MSDN.  Also,
        the code in the Microsoft C runtime that does this translation
        is shipped with VC++).

Our goal in runProcess is to take a command filename and list of
arguments, and construct a string which inverts the translatsions
described above, such that the program at the other end sees exactly
the same arguments in its argv[] that we passed to rawSystem.

This inverse translation is implemented by 'translate' below.

Here are some pages that give informations on Windows-related
limitations and deviations from Unix conventions:

    http://support.microsoft.com/default.aspx?scid=kb;en-us;830473
    Command lines and environment variables effectively limited to 8191
    characters on Win XP, 2047 on NT/2000 (probably even less on Win 9x):

    http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/percent.asp
    Command-line substitution under Windows XP. IIRC these facilities (or at
    least a large subset of them) are available on Win NT and 2000. Some
    might be available on Win 9x.

    http://www.microsoft.com/windowsxp/home/using/productdoc/en/default.asp?url=/WINDOWSXP/home/using/productdoc/en/Cmd.asp
    How CMD.EXE processes command lines.


Note: CreateProcess does have a separate argument (lpApplicationName)
with which you can specify the command, but we have to slap the
command into lpCommandLine anyway, so that argv[0] is what a C program
expects (namely the application name).  So it seems simpler to just
use lpCommandLine alone, which CreateProcess supports.
-}

translate :: String -> String
translate :: String -> String
translate = String -> String
translateInternal
{-# INLINE translate #-}

-- ---------------------------------------------------------------------------
-- unwrapHandles
unwrapHandles :: ProcRetHandles -> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
unwrapHandles :: ProcRetHandles
-> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
unwrapHandles ProcRetHandles
r = (ProcRetHandles -> Maybe Handle
hStdInput ProcRetHandles
r, ProcRetHandles -> Maybe Handle
hStdOutput ProcRetHandles
r, ProcRetHandles -> Maybe Handle
hStdError ProcRetHandles
r, ProcRetHandles -> ProcessHandle
procHandle ProcRetHandles
r)

-- ----------------------------------------------------------------------------
-- Deprecated / compat

{-# DEPRECATED runGenProcess_
      "Please do not use this anymore, use the ordinary 'System.Process.createProcess'. If you need the SIGINT handling, use delegate_ctlc = True (runGenProcess_ is now just an imperfectly emulated stub that probably duplicates or overrides your own signal handling)." #-}
runGenProcess_
 :: String                     -- ^ function name (for error messages)
 -> CreateProcess
 -> Maybe CLong                -- ^ handler for SIGINT
 -> Maybe CLong                -- ^ handler for SIGQUIT
 -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
runGenProcess_ :: String
-> CreateProcess
-> Maybe CLong
-> Maybe CLong
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
runGenProcess_ String
fun CreateProcess
c (Just CLong
sig) (Just CLong
sig') | CLong -> Bool
isDefaultSignal CLong
sig Bool -> Bool -> Bool
&& CLong
sig CLong -> CLong -> Bool
forall a. Eq a => a -> a -> Bool
== CLong
sig'
                         = String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
fun CreateProcess
c { delegate_ctlc = True }
runGenProcess_ String
fun CreateProcess
c Maybe CLong
_ Maybe CLong
_ = String
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess_ String
fun CreateProcess
c

-- ---------------------------------------------------------------------------
-- createPipe

-- | Create a pipe for interprocess communication and return a
-- @(readEnd, writeEnd)@ `Handle` pair.
--
-- * WinIO Support
--
-- When this function is used with WinIO enabled it's the caller's
-- responsibility to register the handles with the I/O manager.
-- If this is not done the operation will deadlock.  Association can
-- be done as follows:
--
-- @
--     #if defined(__IO_MANAGER_WINIO__)
--     import GHC.IO.SubSystem ((<!>))
--     import GHC.IO.Handle.Windows (handleToHANDLE)
--     import GHC.Event.Windows (associateHandle')
--     #endif
--
--     ...
--
--     #if defined (__IO_MANAGER_WINIO__)
--     return () <!> (do
--       associateHandle' =<< handleToHANDLE <handle>)
--     #endif
-- @
--
-- Only associate handles that you are in charge of read/writing to.
-- Do not associate handles passed to another process.  It's the
-- process's reponsibility to register the handle if it supports
-- async access.
--
-- @since 1.2.1.0
createPipe :: IO (Handle, Handle)
createPipe :: IO (Handle, Handle)
createPipe = IO (Handle, Handle)
createPipeInternal
{-# INLINE createPipe #-}

-- ---------------------------------------------------------------------------
-- createPipeFd

-- | Create a pipe for interprocess communication and return a
-- @(readEnd, writeEnd)@ `FD` pair.
--
-- @since 1.4.2.0
createPipeFd :: IO (FD, FD)
createPipeFd :: IO (FD, FD)
createPipeFd = IO (FD, FD)
createPipeInternalFd
{-# INLINE createPipeFd #-}


-- ----------------------------------------------------------------------------
-- interruptProcessGroupOf

-- | Sends an interrupt signal to the process group of the given process.
--
-- On Unix systems, it sends the group the SIGINT signal.
--
-- On Windows systems, it generates a CTRL_BREAK_EVENT and will only work for
-- processes created using 'createProcess' and setting the 'create_group' flag

interruptProcessGroupOf
    :: ProcessHandle    -- ^ A process in the process group
    -> IO ()
interruptProcessGroupOf :: ProcessHandle -> IO ()
interruptProcessGroupOf = ProcessHandle -> IO ()
interruptProcessGroupOfInternal

-- | Fork a thread while doing something else, but kill it if there's an
-- exception.
--
-- This is important in the cases above because we want to kill the thread
-- that is holding the Handle lock, because when we clean up the process we
-- try to close that handle, which could otherwise deadlock.
--
-- @since 1.6.20.0
withForkWait :: IO () -> (IO () ->  IO a) -> IO a
withForkWait :: forall a. IO () -> (IO () -> IO a) -> IO a
withForkWait IO ()
async IO () -> IO a
body = do
  MVar (Either SomeException ())
waitVar <- IO (MVar (Either SomeException ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either SomeException ()))
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO ()
forall a. IO a -> IO a
restore IO ()
async) IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Either SomeException ()) -> Either SomeException () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either SomeException ())
waitVar
    let wait :: IO ()
wait = MVar (Either SomeException ()) -> IO (Either SomeException ())
forall a. MVar a -> IO a
takeMVar MVar (Either SomeException ())
waitVar IO (Either SomeException ())
-> (Either SomeException () -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> IO ())
-> (() -> IO ()) -> Either SomeException () -> IO ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> IO ()
forall e a. Exception e => e -> IO a
throwIO () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    IO a -> IO a
forall a. IO a -> IO a
restore (IO () -> IO a
body IO ()
wait) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`C.onException` ThreadId -> IO ()
killThread ThreadId
tid

-- | Handle any SIGPIPE errors in the given computation.
--
-- @since 1.6.20.0
ignoreSigPipe :: IO () -> IO ()
ignoreSigPipe :: IO () -> IO ()
ignoreSigPipe = (IOException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
C.handle ((IOException -> IO ()) -> IO () -> IO ())
-> (IOException -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOException
e -> case IOException
e of
                                   IOError { ioe_type :: IOException -> IOErrorType
ioe_type  = IOErrorType
ResourceVanished
                                           , ioe_errno :: IOException -> Maybe FD
ioe_errno = Just FD
ioe }
                                     | FD -> Errno
Errno FD
ioe Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
ePIPE -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                   IOException
_ -> IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e