1{-# LANGUAGE CPP #-} 2{-# LANGUAGE RecordWildCards #-} 3module System.Process.Common 4 ( CreateProcess (..) 5 , CmdSpec (..) 6 , StdStream (..) 7 , ProcessHandle(..) 8 , ProcessHandle__(..) 9 , ProcRetHandles (..) 10 , withFilePathException 11 , PHANDLE 12 , GroupID 13 , UserID 14 , modifyProcessHandle 15 , withProcessHandle 16 , fd_stdin 17 , fd_stdout 18 , fd_stderr 19 , mbFd 20 , mbPipe 21 , pfdToHandle 22 23-- Avoid a warning on Windows 24#ifdef WINDOWS 25 , CGid (..) 26#else 27 , CGid 28#endif 29 30-- WINIO is only available on GHC 8.12 and up. 31#if defined(__IO_MANAGER_WINIO__) 32 , HANDLE 33 , mbHANDLE 34 , mbPipeHANDLE 35#endif 36 ) where 37 38import Control.Concurrent 39import Control.Exception 40import Data.String 41import Foreign.Ptr 42import Foreign.Storable 43 44import System.Posix.Internals 45import GHC.IO.Exception 46import GHC.IO.Encoding 47import qualified GHC.IO.FD as FD 48import GHC.IO.Device 49#if defined(__IO_MANAGER_WINIO__) 50import GHC.IO.Handle.Windows 51import GHC.IO.Windows.Handle (fromHANDLE, Io(), NativeHandle()) 52#endif 53import GHC.IO.Handle.FD 54import GHC.IO.Handle.Internals 55import GHC.IO.Handle.Types hiding (ClosedHandle) 56import System.IO.Error 57import Data.Typeable 58import System.IO (IOMode) 59 60-- We do a minimal amount of CPP here to provide uniform data types across 61-- Windows and POSIX. 62#ifdef WINDOWS 63import Data.Word (Word32) 64import System.Win32.DebugApi (PHANDLE) 65#if defined(__IO_MANAGER_WINIO__) 66import System.Win32.Types (HANDLE) 67#endif 68#else 69import System.Posix.Types 70#endif 71 72#ifdef WINDOWS 73-- Define some missing types for Windows compatibility. Note that these values 74-- will never actually be used, as the setuid/setgid system calls are not 75-- applicable on Windows. No value of this type will ever exist. 76newtype CGid = CGid Word32 77 deriving (Show, Eq) 78type GroupID = CGid 79type UserID = CGid 80#else 81type PHANDLE = CPid 82#endif 83 84data CreateProcess = CreateProcess{ 85 cmdspec :: CmdSpec, -- ^ Executable & arguments, or shell command. If 'cwd' is 'Nothing', relative paths are resolved with respect to the current working directory. If 'cwd' is provided, it is implementation-dependent whether relative paths are resolved with respect to 'cwd' or the current working directory, so absolute paths should be used to ensure portability. 86 cwd :: Maybe FilePath, -- ^ Optional path to the working directory for the new process 87 env :: Maybe [(String,String)], -- ^ Optional environment (otherwise inherit from the current process) 88 std_in :: StdStream, -- ^ How to determine stdin 89 std_out :: StdStream, -- ^ How to determine stdout 90 std_err :: StdStream, -- ^ How to determine stderr 91 close_fds :: Bool, -- ^ Close all file descriptors except stdin, stdout and stderr in the new process (on Windows, only works if std_in, std_out, and std_err are all Inherit). This implementation will call close an every fd from 3 to the maximum of open files, which can be slow for high maximum of open files. 92 create_group :: Bool, -- ^ Create a new process group 93 delegate_ctlc:: Bool, -- ^ Delegate control-C handling. Use this for interactive console processes to let them handle control-C themselves (see below for details). 94 -- 95 -- On Windows this has no effect. 96 -- 97 -- @since 1.2.0.0 98 detach_console :: Bool, -- ^ Use the windows DETACHED_PROCESS flag when creating the process; does nothing on other platforms. 99 -- 100 -- @since 1.3.0.0 101 create_new_console :: Bool, -- ^ Use the windows CREATE_NEW_CONSOLE flag when creating the process; does nothing on other platforms. 102 -- 103 -- Default: @False@ 104 -- 105 -- @since 1.3.0.0 106 new_session :: Bool, -- ^ Use posix setsid to start the new process in a new session; does nothing on other platforms. 107 -- 108 -- @since 1.3.0.0 109 child_group :: Maybe GroupID, -- ^ Use posix setgid to set child process's group id; does nothing on other platforms. 110 -- 111 -- Default: @Nothing@ 112 -- 113 -- @since 1.4.0.0 114 child_user :: Maybe UserID, -- ^ Use posix setuid to set child process's user id; does nothing on other platforms. 115 -- 116 -- Default: @Nothing@ 117 -- 118 -- @since 1.4.0.0 119 use_process_jobs :: Bool -- ^ On Windows systems this flag indicates that we should wait for the entire process tree 120 -- to finish before unblocking. On POSIX systems this flag is ignored. See $exec-on-windows for details. 121 -- 122 -- Default: @False@ 123 -- 124 -- @since 1.5.0.0 125 } deriving (Show, Eq) 126 127-- | contains the handles returned by a call to createProcess_Internal 128data ProcRetHandles 129 = ProcRetHandles { hStdInput :: Maybe Handle 130 , hStdOutput :: Maybe Handle 131 , hStdError :: Maybe Handle 132 , procHandle :: ProcessHandle 133 } 134 135data CmdSpec 136 = ShellCommand String 137 -- ^ A command line to execute using the shell 138 | RawCommand FilePath [String] 139 -- ^ The name of an executable with a list of arguments 140 -- 141 -- The 'FilePath' argument names the executable, and is interpreted 142 -- according to the platform's standard policy for searching for 143 -- executables. Specifically: 144 -- 145 -- * on Unix systems the 146 -- <http://pubs.opengroup.org/onlinepubs/9699919799/functions/execvp.html execvp(3)> 147 -- semantics is used, where if the executable filename does not 148 -- contain a slash (@/@) then the @PATH@ environment variable is 149 -- searched for the executable. 150 -- 151 -- * on Windows systems the Win32 @CreateProcess@ semantics is used. 152 -- Briefly: if the filename does not contain a path, then the 153 -- directory containing the parent executable is searched, followed 154 -- by the current directory, then some standard locations, and 155 -- finally the current @PATH@. An @.exe@ extension is added if the 156 -- filename does not already have an extension. For full details 157 -- see the 158 -- <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365527%28v=vs.85%29.aspx documentation> 159 -- for the Windows @SearchPath@ API. 160 deriving (Show, Eq) 161 162 163-- | construct a `ShellCommand` from a string literal 164-- 165-- @since 1.2.1.0 166instance IsString CmdSpec where 167 fromString = ShellCommand 168 169data StdStream 170 = Inherit -- ^ Inherit Handle from parent 171 | UseHandle Handle -- ^ Use the supplied Handle 172 | CreatePipe -- ^ Create a new pipe. The returned 173 -- @Handle@ will use the default encoding 174 -- and newline translation mode (just 175 -- like @Handle@s created by @openFile@). 176 | NoStream -- ^ Close the stream's file descriptor without 177 -- passing a Handle. On POSIX systems this may 178 -- lead to strange behavior in the child process 179 -- because attempting to read or write after the 180 -- file has been closed throws an error. This 181 -- should only be used with child processes that 182 -- don't use the file descriptor at all. If you 183 -- wish to ignore the child process's output you 184 -- should either create a pipe and drain it 185 -- manually or pass a @Handle@ that writes to 186 -- @\/dev\/null@. 187 deriving (Eq, Show) 188 189-- ---------------------------------------------------------------------------- 190-- ProcessHandle type 191 192data ProcessHandle__ = OpenHandle { phdlProcessHandle :: PHANDLE } 193 | OpenExtHandle { phdlProcessHandle :: PHANDLE 194 -- ^ the process 195 , phdlJobHandle :: PHANDLE 196 -- ^ the job containing the process and 197 -- its subprocesses 198 } 199 | ClosedHandle ExitCode 200 201{- | A handle to a process, which can be used to wait for termination 202 of the process using 'System.Process.waitForProcess'. 203 204 None of the process-creation functions in this library wait for 205 termination: they all return a 'ProcessHandle' which may be used 206 to wait for the process later. 207 208 On Windows a second wait method can be used to block for event 209 completion. This requires two handles. A process job handle and 210 a events handle to monitor. 211-} 212data ProcessHandle 213 = ProcessHandle { phandle :: !(MVar ProcessHandle__) 214 , mb_delegate_ctlc :: !Bool 215 , waitpidLock :: !(MVar ()) 216 } 217 218withFilePathException :: FilePath -> IO a -> IO a 219withFilePathException fpath act = handle mapEx act 220 where 221 mapEx ex = ioError (ioeSetFileName ex fpath) 222 223modifyProcessHandle 224 :: ProcessHandle 225 -> (ProcessHandle__ -> IO (ProcessHandle__, a)) 226 -> IO a 227modifyProcessHandle (ProcessHandle m _ _) io = modifyMVar m io 228 229withProcessHandle 230 :: ProcessHandle 231 -> (ProcessHandle__ -> IO a) 232 -> IO a 233withProcessHandle (ProcessHandle m _ _) io = withMVar m io 234 235fd_stdin, fd_stdout, fd_stderr :: FD 236fd_stdin = 0 237fd_stdout = 1 238fd_stderr = 2 239 240mbFd :: String -> FD -> StdStream -> IO FD 241mbFd _ _std CreatePipe = return (-1) 242mbFd _fun std Inherit = return std 243mbFd _fn _std NoStream = return (-2) 244mbFd fun _std (UseHandle hdl) = 245 withHandle fun hdl $ \Handle__{haDevice=dev,..} -> 246 case cast dev of 247 Just fd -> do 248 -- clear the O_NONBLOCK flag on this FD, if it is set, since 249 -- we're exposing it externally (see #3316) 250 fd' <- FD.setNonBlockingMode fd False 251 return (Handle__{haDevice=fd',..}, FD.fdFD fd') 252 Nothing -> 253 ioError (mkIOError illegalOperationErrorType 254 "createProcess" (Just hdl) Nothing 255 `ioeSetErrorString` "handle is not a file descriptor") 256 257mbPipe :: StdStream -> Ptr FD -> IOMode -> IO (Maybe Handle) 258mbPipe CreatePipe pfd mode = fmap Just (pfdToHandle pfd mode) 259mbPipe _std _pfd _mode = return Nothing 260 261pfdToHandle :: Ptr FD -> IOMode -> IO Handle 262pfdToHandle pfd mode = do 263 fd <- peek pfd 264 let filepath = "fd:" ++ show fd 265 (fD,fd_type) <- FD.mkFD (fromIntegral fd) mode 266 (Just (Stream,0,0)) -- avoid calling fstat() 267 False {-is_socket-} 268 False {-non-blocking-} 269 fD' <- FD.setNonBlockingMode fD True -- see #3316 270#if __GLASGOW_HASKELL__ >= 704 271 enc <- getLocaleEncoding 272#else 273 let enc = localeEncoding 274#endif 275 mkHandleFromFD fD' fd_type filepath mode False {-is_socket-} (Just enc) 276 277#if defined(__IO_MANAGER_WINIO__) 278-- It is not completely safe to pass the values -1 and -2 as HANDLE as it's an 279-- unsigned type. -1 additionally is also the value for INVALID_HANDLE. However 280-- it should be safe in this case since an invalid handle would be an error here 281-- anyway and the chances of us getting a handle with a value of -2 is 282-- astronomical. However, sometime in the future process should really use a 283-- proper structure here. 284mbHANDLE :: HANDLE -> StdStream -> IO HANDLE 285mbHANDLE _std CreatePipe = return $ intPtrToPtr (-1) 286mbHANDLE std Inherit = return std 287mbHANDLE _std NoStream = return $ intPtrToPtr (-2) 288mbHANDLE _std (UseHandle hdl) = handleToHANDLE hdl 289 290mbPipeHANDLE :: StdStream -> Ptr HANDLE -> IOMode -> IO (Maybe Handle) 291mbPipeHANDLE CreatePipe pfd mode = 292 do raw_handle <- peek pfd 293 let hwnd = fromHANDLE raw_handle :: Io NativeHandle 294 ident = "hwnd:" ++ show raw_handle 295 Just <$> mkHandleFromHANDLE hwnd Stream ident mode Nothing 296mbPipeHANDLE _std _pfd _mode = return Nothing 297#endif 298