diff options
-rw-r--r-- | Assistant/DeleteRemote.hs | 33 | ||||
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 5 |
2 files changed, 33 insertions, 5 deletions
diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs index a23eeaa8e..25dd7720f 100644 --- a/Assistant/DeleteRemote.hs +++ b/Assistant/DeleteRemote.hs @@ -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 diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 01ea3c22b..46695469e 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -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 |