filipg/gonito
1
0
Fork 1
Code Issues 1 Pull Requests Releases Wiki Activity

Block terminal

Browse Source
This commit is contained in:
Filip Gralinski 2018-11-17 10:07:59 +01:00
parent 62e282f136
commit 879eb4e044
1 changed files with 8 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
Handler/Runner.hs
View File

@ -4,6 +4,7 @@ module Handler.Runner where
import Import import Import
import System.Process import System.Process
import System.Exit import System.Exit
import System.Environment
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.Lifted (threadDelay) import Control.Concurrent.Lifted (threadDelay)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
@ -83,10 +84,14 @@ runProg workingDir programPath args = Runner {
runProgram :: Maybe FilePath -> FilePath -> [String] -> Channel -> Handler (ExitCode, Text) runProgram :: Maybe FilePath -> FilePath -> [String] -> Channel -> Handler (ExitCode, Text)
runProgram workingDir programPath args chan = do runProgram workingDir programPath args chan = do
env <- liftIO $ getEnvironment
(_, Just hout, Just herr, pid) <- (_, Just hout, Just herr, pid) <-
liftIO $ createProcess (proc programPath args){ std_out = CreatePipe, liftIO $ createProcess (proc programPath args){
std_err = CreatePipe, std_out = CreatePipe,
cwd = workingDir} std_err = CreatePipe,
-- https://serverfault.com/questions/544156/git-clone-fail-instead-of-prompting-for-credentials
env = Just (("GIT_TERMINAL_PROMPT", "0") : env),
cwd = workingDir}
(code, out) <- gatherOutput pid hout herr chan (code, out) <- gatherOutput pid hout herr chan
_ <- liftIO $ waitForProcess pid _ <- liftIO $ waitForProcess pid
return (code, out) return (code, out)