diff options
| -rw-r--r-- | Assistant/TransferSlots.hs | 15 | ||||
| -rw-r--r-- | doc/design/assistant/syncing.mdwn | 5 |
2 files changed, 11 insertions, 9 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs index 3dd29a823..30163dbde 100644 --- a/Assistant/TransferSlots.hs +++ b/Assistant/TransferSlots.hs @@ -73,7 +73,14 @@ runTransferThread dstatus s (Just (t, info, a)) = do updateTransferInfo dstatus t $ info { transferTid = Just tid } where go = catchPauseResume a - pause = catchPauseResume $ runEvery (Seconds 86400) noop - catchPauseResume a' = E.catch a' handlePauseResume - handlePauseResume PauseTransfer = pause - handlePauseResume ResumeTransfer = go + pause = catchPauseResume $ runEvery (Seconds 1) $ print "paused" + {- Note: This must use E.try, rather than E.catch. + - When E.catch is used, and has called go in its exception + - handler, Control.Concurrent.throwTo will block sometimes + - when signaling. Using E.try avoids the problem. -} + catchPauseResume a' = do + r <- E.try a' + case r of + Right v -> return v + Left PauseTransfer -> pause + Left ResumeTransfer -> go diff --git a/doc/design/assistant/syncing.mdwn b/doc/design/assistant/syncing.mdwn index 8677fdb84..9bd04e0ea 100644 --- a/doc/design/assistant/syncing.mdwn +++ b/doc/design/assistant/syncing.mdwn @@ -3,11 +3,6 @@ all the other git clones, at both the git level and the key/value level. ## immediate action items -* pause, resume, and pause of a transfer fails... The first pause is ok, - and the first resume. The second pause seems to block forever when - it signals the transfer thread. I've checked: ThreadID is correct. Thread - is still running. No exception is thrown. WTF? (One or twice, it worked, - but then blocked next time paused.) ## longer-term TODO |