diff options
author | Joey Hess <joey@kitenet.net> | 2014-01-06 17:07:08 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2014-01-06 17:07:08 -0400 |
commit | 108d51811a2befe1da8f5259a9e2d13dcb91c28f (patch) | |
tree | 30ae4c27502e4929bacdbd9b1f5399255c363067 /Assistant/TransferrerPool.hs | |
parent | 6728be8d14484071a3b086eb5b7493db055683d1 (diff) |
tested transferkeys restarting; fix some bugs
Diffstat (limited to 'Assistant/TransferrerPool.hs')
-rw-r--r-- | Assistant/TransferrerPool.hs | 16 |
1 files changed, 9 insertions, 7 deletions
diff --git a/Assistant/TransferrerPool.hs b/Assistant/TransferrerPool.hs index 580417305..6ad9b6b99 100644 --- a/Assistant/TransferrerPool.hs +++ b/Assistant/TransferrerPool.hs @@ -26,14 +26,16 @@ import Control.Concurrent -} withTransferrer :: FilePath -> BatchCommandMaker -> TransferrerPool -> (Transferrer -> IO a) -> IO a withTransferrer program batchmaker pool a = do - i@(TransferrerPoolItem (Just t) _) <- maybe - (mkTransferrerPoolItem pool =<< mkTransferrer program batchmaker) - (checkTransferrerPoolItem program batchmaker) - =<< atomically (popTransferrerPool pool) + (mi, leftinpool) <- atomically (popTransferrerPool pool) + i@(TransferrerPoolItem (Just t) check) <- case mi of + Nothing -> mkTransferrerPoolItem pool =<< mkTransferrer program batchmaker + Just i -> checkTransferrerPoolItem program batchmaker i v <- tryNonAsync $ a t - sz <- atomically $ pushTransferrerPool pool i - when (sz > 1) $ - void $ forkIO $ stopTransferrer t + if leftinpool == 0 + then atomically $ pushTransferrerPool pool i + else do + void $ forkIO $ stopTransferrer t + atomically $ pushTransferrerPool pool $ TransferrerPoolItem Nothing check either throw return v {- Check if a Transferrer from the pool is still ok to be used. |