From cf47bb3f509ae63ad868b66c0b6f2baecb93e4c7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 18 Jul 2012 19:13:56 -0400 Subject: run file transfers in threads, not processes This should fix OSX/BSD issues with not noticing transfer information files with kqueue. Now that threads are used, the thread can manage the transfer slot allocation and deallocation by itself; much cleaner. --- Assistant/TransferSlots.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) (limited to 'Assistant/TransferSlots.hs') diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 1859b281b..dc077254d 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -10,6 +10,9 @@ module Assistant.TransferSlots where import Control.Exception import Control.Concurrent +import Common.Annex +import Assistant.ThreadedMonad + type TransferSlots = QSemN {- Number of concurrent transfers allowed to be run from the assistant. @@ -24,16 +27,13 @@ newTransferSlots :: IO TransferSlots newTransferSlots = newQSemN numSlots {- Waits until a transfer slot becomes available, and runs a transfer - - action in the slot. If the action throws an exception, its slot is - - freed here, otherwise it should be freed by the TransferWatcher when - - the transfer is complete. - -} -inTransferSlot :: TransferSlots -> IO a -> IO a -inTransferSlot s a = bracketOnError start abort run + - action in the slot, in its own thread. -} +inTransferSlot :: TransferSlots -> ThreadState -> Annex a -> IO ThreadId +inTransferSlot s st a = forkIO $ bracket_ start done run where start = waitQSemN s 1 - abort = const $ transferComplete s - run = const a + done = transferComplete s + run = unsafeRunThreadState st a {- Call when a transfer is complete. -} transferComplete :: TransferSlots -> IO () -- cgit v1.2.3