check for unused keys on an unwanted remote, and move them off, before deleting it
This commit is contained in:
parent
021c564319
commit
2c3aeec19b
2 changed files with 33 additions and 5 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue