    {-# OPTIONS_GHC -cpp -fffi #-}
    -----------------------------------------------------------------------------
    -- |
    -- 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
    --
    -- Operations for creating and interacting with sub-processes.
    --
    -----------------------------------------------------------------------------

    -- #hide
    module System.Process.Internals (
    #ifndef __HUGS__
    	ProcessHandle(..), ProcessHandle__(..),
    	PHANDLE, closePHANDLE, mkProcessHandle,
    	withProcessHandle, withProcessHandle_,
    #endif
    #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
    	 pPrPr_disableITimers, c_execvpe,
    # ifdef __GLASGOW_HASKELL__
    	runProcessPosix,
    # endif
    	ignoreSignal, defaultSignal,
    #else
    # ifdef __GLASGOW_HASKELL__
    	runProcessWin32, translate,
    # endif
    #endif
    #ifndef __HUGS__
    	commandToProcess,
    #endif
    	withFilePathException, withCEnvironment
      ) where

    import Prelude -- necessary to get dependencies right

    #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
    import System.Posix.Types ( CPid )
    import System.Posix.Process.Internals ( pPrPr_disableITimers, c_execvpe )
    import System.IO 	( Handle )
    #else
    import Data.Word ( Word32 )
    import Data.IORef
    #endif

    import System.Exit	( ExitCode )
    import Data.Maybe	( fromMaybe )
    # ifdef __GLASGOW_HASKELL__
    import GHC.IOBase	( haFD, FD, Exception(..), IOException(..) )
    import GHC.Handle 	( stdin, stdout, stderr, withHandle_ )
    # elif __HUGS__
    import Hugs.Exception	( Exception(..), IOException(..) )
    # endif

    import Control.Concurrent
    import Control.Exception ( handle, throwIO )
    import Foreign.C
    import Foreign

    #if defined(mingw32_HOST_OS)
    import Control.Monad		( when )
    import System.Directory		( doesFileExist )
    import Control.Exception 	( catchJust, ioErrors )
    import System.IO.Error		( isDoesNotExistError, doesNotExistErrorType,
    				  mkIOError )
    import System.Environment	( getEnv )
    import System.FilePath
    #endif

    #ifdef __HUGS__
    {-# CFILES cbits/execvpe.c  #-}
    #endif

    #include "HsProcessConfig.h"

    #ifndef __HUGS__
    -- ----------------------------------------------------------------------------
    -- ProcessHandle type

    {- | A handle to a process, which can be used to wait for termination
         of the process using 'waitForProcess'.

         None of the process-creation functions in this library wait for
         termination: they all return a 'ProcessHandle' which may be used
         to wait for the process later.
    -}
    data ProcessHandle__ = OpenHandle PHANDLE | ClosedHandle ExitCode
    newtype ProcessHandle = ProcessHandle (MVar ProcessHandle__)

    withProcessHandle
    	:: ProcessHandle
    	-> (ProcessHandle__ -> IO (ProcessHandle__, a))
    	-> IO a
    withProcessHandle (ProcessHandle m) io = modifyMVar m io

    withProcessHandle_
    	:: ProcessHandle
    	-> (ProcessHandle__ -> IO ProcessHandle__)
    	-> IO ()
    withProcessHandle_ (ProcessHandle m) io = modifyMVar_ m io

    #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)

    type PHANDLE = CPid

    mkProcessHandle :: PHANDLE -> IO ProcessHandle
    mkProcessHandle p = do
      m <- newMVar (OpenHandle p)
      return (ProcessHandle m)

    closePHANDLE :: PHANDLE -> IO ()
    closePHANDLE _ = return ()

    #else

    type PHANDLE = Word32

    -- On Windows, we have to close this HANDLE when it is no longer required,
    -- hence we add a finalizer to it, using an IORef as the box on which to
    -- attach the finalizer.
    mkProcessHandle :: PHANDLE -> IO ProcessHandle
    mkProcessHandle h = do
       m <- newMVar (OpenHandle h)
       addMVarFinalizer m (processHandleFinaliser m)
       return (ProcessHandle m)

    processHandleFinaliser m =
       modifyMVar_ m $ \p_ -> do
    	case p_ of
    	  OpenHandle ph -> closePHANDLE ph
    	  _ -> return ()
    	return (error "closed process handle")

    closePHANDLE :: PHANDLE -> IO ()
    closePHANDLE ph = c_CloseHandle ph

    foreign import stdcall unsafe "CloseHandle"
      c_CloseHandle
    	:: PHANDLE
    	-> IO ()
    #endif
    #endif /* !__HUGS__ */

    -- ----------------------------------------------------------------------------

    #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)

    #ifdef __GLASGOW_HASKELL__
    -- -----------------------------------------------------------------------------
    -- POSIX runProcess with signal handling in the child

    runProcessPosix
      :: String
      -> FilePath			-- ^ Filename of the executable
      -> [String]			-- ^ Arguments to pass to the executable
      -> Maybe FilePath		-- ^ Optional path to the working directory
      -> Maybe [(String,String)]	-- ^ Optional environment (otherwise inherit)
      -> Maybe Handle		-- ^ Handle to use for @stdin@
      -> Maybe Handle		-- ^ Handle to use for @stdout@
      -> Maybe Handle		-- ^ Handle to use for @stderr@
      -> Maybe CLong		-- handler for SIGINT
      -> Maybe CLong		-- handler for SIGQUIT
      -> IO ProcessHandle

    runProcessPosix fun cmd args mb_cwd mb_env mb_stdin mb_stdout mb_stderr
    	mb_sigint mb_sigquit
     = withFilePathException cmd $ do
         fd_stdin  <- withHandle_ fun (fromMaybe stdin  mb_stdin)  $ return . haFD
         fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD
         fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD
    	-- some of these might refer to the same Handle, so don't do
    	-- nested withHandle_'s (that will deadlock).
         maybeWith withCEnvironment mb_env $ \pEnv -> do
         maybeWith withCString mb_cwd $ \pWorkDir -> do
         withMany withCString (cmd:args) $ \cstrs -> do
         let (set_int, inthand)
    		= case mb_sigint of
    			Nothing   -> (0, 0)
    			Just hand -> (1, hand)
    	 (set_quit, quithand)
    		= case mb_sigquit of
    			Nothing   -> (0, 0)
    			Just hand -> (1, hand)
         withArray0 nullPtr cstrs $ \pargs -> do
             ph <- throwErrnoIfMinus1 fun $
    		 c_runProcess pargs pWorkDir pEnv
    			fd_stdin fd_stdout fd_stderr
    			set_int inthand set_quit quithand
    	 mkProcessHandle ph

    foreign import ccall unsafe "runProcess"
      c_runProcess
            :: Ptr CString			-- args
            -> CString			-- working directory (or NULL)
            -> Ptr CString			-- env (or NULL)
            -> FD				-- stdin
            -> FD				-- stdout
            -> FD				-- stderr
    	-> CInt				-- non-zero: set child's SIGINT handler
    	-> CLong			-- SIGINT handler
    	-> CInt				-- non-zero: set child's SIGQUIT handler
    	-> CLong			-- SIGQUIT handler
            -> IO PHANDLE

    #endif /* __GLASGOW_HASKELL__ */

    ignoreSignal  = CONST_SIG_IGN :: CLong
    defaultSignal = CONST_SIG_DFL :: CLong

    #else

    #ifdef __GLASGOW_HASKELL__

    runProcessWin32 fun cmd args mb_cwd mb_env
    	mb_stdin mb_stdout mb_stderr extra_cmdline
     = withFilePathException cmd $ do
         fd_stdin  <- withHandle_ fun (fromMaybe stdin  mb_stdin)  $ return . haFD
         fd_stdout <- withHandle_ fun (fromMaybe stdout mb_stdout) $ return . haFD
         fd_stderr <- withHandle_ fun (fromMaybe stderr mb_stderr) $ return . haFD
    	-- some of these might refer to the same Handle, so don't do
    	-- nested withHandle_'s (that will deadlock).
         maybeWith withCEnvironment mb_env $ \pEnv -> do
         maybeWith withCString      mb_cwd $ \pWorkDir -> do
           let cmdline = translate cmd ++
    		   concat (map ((' ':) . translate) args) ++
    		   (if null extra_cmdline then "" else ' ':extra_cmdline)
           withCString cmdline $ \pcmdline -> do
             proc_handle <- throwErrnoIfMinus1 fun
    	                  (c_runProcess pcmdline pWorkDir pEnv
    				fd_stdin fd_stdout fd_stderr)
    	 mkProcessHandle proc_handle

    foreign import ccall unsafe "runProcess"
      c_runProcess
            :: CString
            -> CString
            -> Ptr ()
            -> FD
            -> FD
            -> FD
            -> IO PHANDLE

    -- ------------------------------------------------------------------------
    -- Passing commands to the OS on Windows

    {-
    On Windows this is tricky.  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:

    	   http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vccelng/htm/progs_12.asp

    	(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 command-line arguments for passing to CreateProcess().
    translate :: String -> String
    translate str = '"' : snd (foldr escape (True,"\"") str)
      where escape '"'  (b,     str) = (True,  '\\' : '"'  : str)
            escape '\\' (True,  str) = (True,  '\\' : '\\' : str)
            escape '\\' (False, str) = (False, '\\' : str)
    	escape c    (b,     str) = (False, c : str)
    	-- See long comment above for what this function is trying to do.
    	--
    	-- The Bool passed back along the string is True iff the
    	-- rest of the string is a sequence of backslashes followed by
    	-- a double quote.

    #endif /* __GLASGOW_HASKELL__ */

    #endif

    #ifndef __HUGS__
    -- ----------------------------------------------------------------------------
    -- commandToProcess

    {- | Turns a shell command into a raw command.  Usually this involves
         wrapping it in an invocation of the shell.

       There's a difference in the signature of commandToProcess between
       the Windows and Unix versions.  On Unix, exec takes a list of strings,
       and we want to pass our command to /bin/sh as a single argument.

       On Windows, CreateProcess takes a single string for the command,
       which is later decomposed by cmd.exe.  In this case, we just want
       to prepend @\"c:\WINDOWS\CMD.EXE \/c\"@ to our command line.  The
       command-line translation that we normally do for arguments on
       Windows isn't required (or desirable) here.
    -}

    #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)

    commandToProcess
      :: String
      -> IO (FilePath,[String])
    commandToProcess string = return ("/bin/sh", ["-c", string])

    #else

    commandToProcess
      :: String
      -> IO (FilePath,String)
    commandToProcess string = do
      cmd <- findCommandInterpreter
      return (cmd, "/c "++string)
    	-- We don't want to put the cmd into a single
    	-- argument, because cmd.exe will not try to split it up.  Instead,
    	-- we just tack the command on the end of the cmd.exe command line,
    	-- which partly works.  There seem to be some quoting issues, but
    	-- I don't have the energy to find+fix them right now (ToDo). --SDM
    	-- (later) Now I don't know what the above comment means.  sigh.

    -- Find CMD.EXE (or COMMAND.COM on Win98).  We use the same algorithm as
    -- system() in the VC++ CRT (Vc7/crt/src/system.c in a VC++ installation).
    findCommandInterpreter :: IO FilePath
    findCommandInterpreter = do
      -- try COMSPEC first
      catchJust ioErrors (getEnv "COMSPEC") $ \e -> do
        when (not (isDoesNotExistError e)) $ ioError e

        -- try to find CMD.EXE or COMMAND.COM
        {-
        XXX We used to look at _osver (using cbits) and pick which shell to
        use with
        let filename | osver .&. 0x8000 /= 0 = "command.com"
                     | otherwise             = "cmd.exe"
        We ought to use GetVersionEx instead, but for now we just look for
        either filename
        -}
        path <- getEnv "PATH"
        let
    	-- use our own version of System.Directory.findExecutable, because
    	-- that assumes the .exe suffix.
    	search :: [FilePath] -> IO (Maybe FilePath)
    	search [] = return Nothing
    	search (d:ds) = do
    		let path1 = d </> "cmd.exe"
    		    path2 = d </> "command.com"
    		b1 <- doesFileExist path1
    		b2 <- doesFileExist path2
    		if b1 then return (Just path1)
    		      else if b2 then return (Just path2)
    		                 else search ds
        --
        mb_path <- search (splitSearchPath path)

        case mb_path of
          Nothing -> ioError (mkIOError doesNotExistErrorType
    				"findCommandInterpreter" Nothing Nothing)
          Just cmd -> return cmd
    #endif

    #endif /* __HUGS__ */

    -- ----------------------------------------------------------------------------
    -- Utils

    withFilePathException :: FilePath -> IO a -> IO a
    withFilePathException fpath act = handle mapEx act
      where
        mapEx (IOException (IOError h iot fun str _)) = ioError (IOError h iot fun str (Just fpath))
        mapEx e                                       = throwIO e

    #if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)
    withCEnvironment :: [(String,String)] -> (Ptr CString  -> IO a) -> IO a
    withCEnvironment env act =
      let env' = map (\(name, val) -> name ++ ('=':val)) env
      in withMany withCString env' (\pEnv -> withArray0 nullPtr pEnv act)
    #else
    withCEnvironment :: [(String,String)] -> (Ptr () -> IO a) -> IO a
    withCEnvironment env act =
      let env' = foldr (\(name, val) env -> name ++ ('=':val)++'\0':env) "\0" env
      in withCString env' (act . castPtr)
    #endif