mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

ensure handles get closed

Browse source
This commit is contained in:
Joey Hess 2012-11-09 23:27:07 -04:00
parent 3f2467f253
commit c00ecfbb83
1 changed files with 11 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
Assistant/XMPP/Git.hs
View file

@ -109,7 +109,10 @@ xmppPush cid remote refs = runPush (SendPushRunning cid) handleDeferred $ do
let params = Param name : map (Param . show) refs let params = Param name : map (Param . show) refs
ok <- liftIO $ Git.Command.runBool "push" params g' ok <- liftIO $ Git.Command.runBool "push" params g'
liftIO $ mapM_ killThread [t1, t2] liftIO $ do
mapM_ killThread [t1, t2]
mapM_ hClose [inh, outh, controlh]
return ok return ok
where where
toxmpp inh = forever $ do toxmpp inh = forever $ do
@ -124,7 +127,7 @@ xmppPush cid remote refs = runPush (SendPushRunning cid) handleDeferred $ do
B.hPut outh b B.hPut outh b
hFlush outh hFlush outh
(ReceivePackDone _ exitcode) -> liftIO $ do (ReceivePackDone _ exitcode) -> liftIO $ do
hPutStrLn controlh (show exitcode) hPrint controlh exitcode
hFlush controlh hFlush controlh
_ -> noop _ -> noop
installwrapper tmpdir = liftIO $ do installwrapper tmpdir = liftIO $ do
@ -204,15 +207,16 @@ xmppReceivePack cid = runPush (ReceivePushRunning cid) handleDeferred $ do
code <- waitForProcess pid code <- waitForProcess pid
void $ sendexitcode code void $ sendexitcode code
killThread readertid killThread readertid
hClose inh
hClose outh
return $ code == ExitSuccess return $ code == ExitSuccess
where where
toxmpp outh = do toxmpp outh = do
b <- liftIO $ B.hGetSome outh chunkSize b <- liftIO $ B.hGetSome outh chunkSize
if B.null b -- empty is EOF, so exit
then return () -- EOF unless (B.null b) $ do
else do sendNetMessage $ ReceivePackOutput cid b
sendNetMessage $ ReceivePackOutput cid b toxmpp outh
toxmpp outh
fromxmpp inh = forever $ do fromxmpp inh = forever $ do
m <- waitNetPushMessage m <- waitNetPushMessage
case m of case m of