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.
This commit is contained in:
parent
2e1f3a86ae
commit
d5e06e7b89
4 changed files with 44 additions and 63 deletions
|
@ -164,19 +164,23 @@ startTransfer t = liftIO $ putStrLn "start"
|
|||
cancelTransfer :: Transfer -> Handler ()
|
||||
cancelTransfer t = do
|
||||
webapp <- getYesod
|
||||
{- Remove if queued. -}
|
||||
{- remove queued transfer -}
|
||||
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
|
||||
{- stop running transfer -}
|
||||
maybe noop (void . liftIO . stop webapp) =<< running webapp
|
||||
where
|
||||
running webapp = liftIO $ M.lookup t . currentTransfers
|
||||
<$> getDaemonStatus (daemonStatus webapp)
|
||||
stop webapp info = do
|
||||
putStrLn $ "stopping transfer " ++ show info
|
||||
{- When there's a thread associated with the
|
||||
- transfer, it's killed first, to avoid it
|
||||
- displaying any alert about the transfer having
|
||||
- failed when the transfer process is killed. -}
|
||||
maybe noop killThread $ transferTid info
|
||||
maybe noop killproc $ transferPid info
|
||||
removeTransfer (daemonStatus webapp) t
|
||||
killproc pid = do
|
||||
void $ tryIO $ signalProcess sigTERM pid
|
||||
threadDelay 100000 -- 0.1 second grace period
|
||||
void $ tryIO $ signalProcess sigKILL pid
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue