aboutsummaryrefslogtreecommitdiff
path: root/Assistant/TransferSlots.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-10 14:14:08 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-10 14:14:08 -0400
commitd5e06e7b89133d8178b604724a41d4a392d577cd (patch)
tree90ad011ece5890b5cc0ab9eca01e6d6dfb4a9141 /Assistant/TransferSlots.hs
parent2e1f3a86aec44337775b418b66bf9696146a49f2 (diff)
fork off git-annex copy for transfers
This doesn't quite work, because canceling a transfer sends a signal to git-annex, but not to rsync (etc). Looked at making git-annex run in its own process group, which could then be killed, and would kill child processes. But, rsync checks if it's process group is the foreground process group and doesn't show progress if not, and when git has run git-annex, if git-annex makes a new process group, that is not the case. Also, if git has run git-annex, ctrl-c wouldn't be propigated to it if it made a new process group. So this seems like a blind alley, but recording it here just in case.
Diffstat (limited to 'Assistant/TransferSlots.hs')
-rw-r--r--Assistant/TransferSlots.hs8
1 files changed, 3 insertions, 5 deletions
diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index 9556232a4..c394dc30d 100644
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -11,7 +11,6 @@ import Control.Exception
import Control.Concurrent
import Common.Annex
-import Assistant.ThreadedMonad
type TransferSlots = QSemN
@@ -29,13 +28,12 @@ newTransferSlots = newQSemN numSlots
{- Waits until a transfer slot becomes available, and runs a transfer
- action in the slot, in its own thread. Note that this thread is
- subject to being killed when the transfer is canceled. -}
-inTransferSlot :: TransferSlots -> ThreadState -> Annex a -> IO ThreadId
-inTransferSlot s st a = do
+inTransferSlot :: TransferSlots -> IO () -> IO ThreadId
+inTransferSlot s a = do
waitQSemN s 1
- forkIO $ bracket_ noop done run
+ forkIO $ bracket_ noop done a
where
done = transferComplete s
- run = unsafeRunThreadState st a
{- Call when a transfer is complete. -}
transferComplete :: TransferSlots -> IO ()