91 lines
2.9 KiB
Haskell
91 lines
2.9 KiB
Haskell
{-# OPTIONS -cpp #-}
|
|
--
|
|
-- | A Posix.popen compatibility mapping.
|
|
--
|
|
-- If we use this, we should build -threaded
|
|
--
|
|
module System.Plugins.Process (exec, popen) where
|
|
|
|
import System.Exit
|
|
#if __GLASGOW_HASKELL__ >= 604
|
|
import System.IO
|
|
import System.Process
|
|
import Control.Concurrent (forkIO)
|
|
#else
|
|
import qualified Posix as P
|
|
#endif
|
|
|
|
import qualified Control.Exception
|
|
|
|
--
|
|
-- slight wrapper over popen for calls that don't care about stdin to the program
|
|
--
|
|
exec :: String -> [String] -> IO ([String],[String])
|
|
exec f as = do
|
|
(a,b,_) <- popen f as (Just [])
|
|
return (lines a, lines b)
|
|
|
|
#if __GLASGOW_HASKELL__ >= 604
|
|
|
|
type ProcessID = ProcessHandle
|
|
|
|
--
|
|
-- Ignoring exit status for now.
|
|
--
|
|
-- XXX there are still issues. Large amounts of output can cause what
|
|
-- seems to be a dead lock on the pipe write from runplugs, for example.
|
|
-- Posix.popen doesn't have this problem, so maybe we can reproduce its
|
|
-- pipe handling somehow.
|
|
--
|
|
popen :: FilePath -> [String] -> Maybe String -> IO (String,String,ProcessID)
|
|
popen file args minput =
|
|
Control.Exception.handle (\e -> return ([],show e,error (show e))) $ do
|
|
|
|
(inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing
|
|
|
|
case minput of
|
|
Just input -> hPutStr inp input >> hClose inp -- importante!
|
|
Nothing -> return ()
|
|
|
|
-- Now, grab the input
|
|
output <- hGetContents out
|
|
errput <- hGetContents err
|
|
|
|
-- SimonM sez:
|
|
-- ... avoids blocking the main thread, but ensures that all the
|
|
-- data gets pulled as it becomes available. you have to force the
|
|
-- output strings before waiting for the process to terminate.
|
|
--
|
|
forkIO (Control.Exception.evaluate (length output) >> return ())
|
|
forkIO (Control.Exception.evaluate (length errput) >> return ())
|
|
|
|
-- And now we wait. We must wait after we read, unsurprisingly.
|
|
exitCode <- waitForProcess pid -- blocks without -threaded, you're warned.
|
|
case exitCode of
|
|
ExitFailure code
|
|
| null errput -> let errMsg = file ++ ": failed with error code " ++ show code
|
|
in return ([],errMsg,error errMsg)
|
|
_ -> return (output,errput,pid)
|
|
|
|
#else
|
|
|
|
--
|
|
-- catch so that we can deal with forkProcess failing gracefully. and
|
|
-- getProcessStatus is needed so as not to get a bunch of zombies,
|
|
-- leading to forkProcess failing.
|
|
--
|
|
-- Large amounts of input will cause problems with blocking as we wait
|
|
-- on the process to finish. Make sure no lambdabot processes will
|
|
-- generate 1000s of lines of output.
|
|
--
|
|
popen :: FilePath -> [String] -> Maybe String -> IO (String,String,P.ProcessID)
|
|
popen f s m =
|
|
Control.Exception.handle (\e -> return ([], show e, error $ show e )) $ do
|
|
x@(_,_,pid) <- P.popen f s m
|
|
b <- P.getProcessStatus True False pid -- wait
|
|
return $ case b of
|
|
Nothing -> ([], "process has disappeared", pid)
|
|
_ -> x
|
|
|
|
#endif
|