close stdin handles before waiting on commands
Fixes reversion in recent conversions, the old code relied on the GC apparently, but the new code explicitly waits on the process, so must close stdin handle first or the command will never exit.
This commit is contained in:
parent
ef0024444b
commit
e41f8c83f3
2 changed files with 7 additions and 7 deletions
|
@ -103,15 +103,15 @@ pipeWriteRead params writer repo = assertLocal repo $
|
|||
|
||||
{- Runs a git command, feeding it input on a handle with an action. -}
|
||||
pipeWrite :: [CommandParam] -> Repo -> (Handle -> IO ()) -> IO ()
|
||||
pipeWrite params repo a = assertLocal repo $
|
||||
pipeWrite params repo feeder = assertLocal repo $
|
||||
let p = (gitCreateProcess params repo)
|
||||
{ std_in = CreatePipe }
|
||||
in withCreateProcess p (go p)
|
||||
where
|
||||
go p (Just hin) _ _ pid =
|
||||
go p (Just hin) _ _ pid = do
|
||||
feeder hin
|
||||
hClose hin
|
||||
forceSuccessProcess p pid
|
||||
`after`
|
||||
a hin
|
||||
go _ _ _ _ _ = error "internal"
|
||||
|
||||
{- Reads null terminated output of a git command (as enabled by the -z
|
||||
|
|
|
@ -166,10 +166,10 @@ store' r k b p = go =<< glacierEnv c gc u
|
|||
let cmd = (proc "glacier" (toCommand params)) { env = Just e }
|
||||
{ std_in = CreatePipe }
|
||||
in liftIO $ withCreateProcess cmd (go' cmd)
|
||||
go' cmd (Just hin) _ _ pid =
|
||||
forceSuccessProcess cmd pid
|
||||
`after`
|
||||
go' cmd (Just hin) _ _ pid = do
|
||||
meteredWrite p hin b
|
||||
hClose hin
|
||||
forceSuccessProcess cmd pid
|
||||
go' _ _ _ _ _ = error "internal"
|
||||
|
||||
retrieve :: Remote -> Retriever
|
||||
|
|
Loading…
Add table
Reference in a new issue