check for unused keys on an unwanted remote, and move them off, before deleting it

This commit is contained in:
Joey Hess 2013-04-03 19:03:16 -04:00
parent 021c564319
commit 2c3aeec19b
2 changed files with 33 additions and 5 deletions

View file

@ -14,6 +14,9 @@ import Assistant.Common
import Assistant.WebApp.Types
import Assistant.WebApp
#endif
import Assistant.TransferQueue
import Logs.Transfer
import Logs.Location
import Assistant.Alert
import Assistant.DaemonStatus
import Assistant.Types.UrlRenderer
@ -21,6 +24,7 @@ import qualified Remote
import Remote.List
import qualified Git.Command
import Logs.Trust
import qualified Annex
import qualified Data.Text as T
@ -40,8 +44,33 @@ removeRemote uuid = do
updateSyncRemotes
return remote
{- Called when a remote was marked as unwanted, and is now empty, so can be
- removed. -}
{- Called when a Remote is probably empty, to remove it.
-
- This does one last check for any objects remaining in the Remote,
- and if there are any, queues Downloads of them, and defers removing
- the remote for later. This is to catch any objects not referred to
- in keys in the current branch.
-}
removableRemote :: UrlRenderer -> UUID -> Assistant ()
removableRemote urlrenderer uuid = do
keys <- getkeys
if null keys
then finishRemovingRemote urlrenderer uuid
else do
r <- fromMaybe (error "unknown remote")
<$> liftAnnex (Remote.remoteFromUUID uuid)
mapM_ (queueremaining r) keys
where
queueremaining r k =
queueTransferWhenSmall "remaining object in unwanted remote"
Nothing (Transfer Download uuid k) r
{- Scanning for keys can take a long time; do not tie up
- the Annex monad while doing it, so other threads continue to
- run. -}
getkeys = do
a <- liftAnnex $ Annex.withCurrentState $ loggedKeysFor uuid
liftIO a
finishRemovingRemote :: UrlRenderer -> UUID -> Assistant ()
finishRemovingRemote urlrenderer uuid = do
void $ removeRemote uuid

View file

@ -127,9 +127,8 @@ expensiveScan urlrenderer rs = unless onlyweb $ do
debug ["finished scan of", show visiblers]
nuke <- asIO1 $ finishRemovingRemote urlrenderer
liftIO $ forM_ (S.toList removablers) $
void . tryNonAsync . nuke
remove <- asIO1 $ removableRemote urlrenderer
liftIO $ mapM_ (void . tryNonAsync . remove) $ S.toList removablers
where
onlyweb = all (== webUUID) $ map Remote.uuid rs
visiblers = let rs' = filter (not . Remote.readonly) rs