transfer canceling

Should work (untested) for transfers being run by other processes.

Not yet by transfers being run by the assistant. killThread does not
kill processes forked off by a thread. To fix this, will probably
need to make `git annex getkey` and `git annex sendkey` commands that
operate on keys, and write their own transfer info. Then the assistant
can run them, and kill them, as needed.
This commit is contained in:
Joey Hess 2012-08-08 17:55:56 -04:00
parent 09449792fa
commit 20203b45b9
3 changed files with 34 additions and 5 deletions

View file

@ -29,6 +29,7 @@ import Yesod
import Text.Hamlet
import qualified Data.Map as M
import Control.Concurrent
import System.Posix.Signals (signalProcess, sigTERM, sigKILL)
{- A display of currently running and queued transfers.
-
@ -161,4 +162,21 @@ startTransfer :: Transfer -> Handler ()
startTransfer t = liftIO $ putStrLn "start"
cancelTransfer :: Transfer -> Handler ()
cancelTransfer t = liftIO $ putStrLn "cancel"
cancelTransfer t = do
webapp <- getYesod
{- Remove if queued. -}
void $ liftIO $ dequeueTransfer (transferQueue webapp) t
{- When the transfer is running, don't directly remove it from the
- map, instead signal to end the transfer, and rely on the
- TransferWatcher to notice it's done and update the map. -}
mi <- liftIO $ M.lookup t . currentTransfers
<$> getDaemonStatus (daemonStatus webapp)
case mi of
Just (TransferInfo { transferTid = Just tid } ) -> do
-- TODO
error "TODO"
Just (TransferInfo { transferPid = Just pid } ) -> liftIO $ do
signalProcess sigTERM pid
threadDelay 500000 -- half a second grace period
signalProcess sigKILL pid
_ -> noop