Ticket #1461: 1461.hs

File 1461.hs, 1.4 KB (added by igloo, 7 years ago)
Line 
1module Main where
2
3import System.Process (waitForProcess)
4import System.Posix.Internals (FDType(Stream))
5import System.IO
6import Control.Concurrent
7import Foreign
8import Foreign.C
9import System.Process.Internals
10import GHC.IOBase   ( FD )
11import GHC.Handle (openFd)
12
13runWith :: IO ()
14runWith =
15 do (i,o,e,p) <- runInteractiveProcess "date" [] Nothing Nothing
16    hClose i
17    waitForProcess p
18    hClose o
19    hClose e
20    runWith
21
22main :: IO ()
23main = runWith
24
25runInteractiveProcess cmd args mb_cwd mb_env =
26  alloca $ \ pfdStdInput  ->
27  alloca $ \ pfdStdOutput ->
28  alloca $ \ pfdStdError  ->
29  withCString cmd $ \ccmd ->
30  withArray0 nullPtr [ccmd] $ \pcmd -> do
31    proc_handle <- c_runInteractiveProcess pcmd nullPtr nullPtr
32                                           pfdStdInput pfdStdOutput pfdStdError
33    hndStdInput  <- fdToHandle pfdStdInput  WriteMode
34    hndStdOutput <- fdToHandle pfdStdOutput ReadMode
35    hndStdError  <- fdToHandle pfdStdError  ReadMode
36    ph <- mkProcessHandle proc_handle
37    return (hndStdInput, hndStdOutput, hndStdError, ph)
38
39foreign import ccall unsafe "runInteractiveProcess"
40  c_runInteractiveProcess
41        ::  Ptr CString
42        -> CString
43        -> Ptr CString
44        -> Ptr FD
45        -> Ptr FD
46        -> Ptr FD
47        -> IO PHANDLE
48
49fdToHandle :: Ptr FD -> IOMode -> IO Handle
50fdToHandle pfd mode = do
51  fd <- peek pfd
52  openFd fd (Just Stream)
53     False{-not a socket-}
54     ("fd:" ++ show fd) mode True{-binary-}