From 5e9a2cc37f781a05657dec92ec8abc051c2da753 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 14 Oct 2019 15:38:07 -0400 Subject: [PATCH] forget state of sameas remotes during DropDead transitions It would have been a lot less round-about to just make git annex dead also add the uuids of sameas remotes to the trust.log as dead. But, that would fail in the case where there's an unmerged other clone that has a sameas remote that the current repo does not know about. Then it would not get marked as dead. Handling it at transition time avoids that scenario. Note that the generation of trustmap' in dropDead should only happen once, due to the partial application. --- Annex/Branch.hs | 18 ++++++---- Annex/Branch/Transitions.hs | 51 ++++++++++++++++++-------- Logs/Remote.hs | 71 ++----------------------------------- git-annex.cabal | 1 + 4 files changed, 51 insertions(+), 90 deletions(-) diff --git a/Annex/Branch.hs b/Annex/Branch.hs index a8443b7767..fbfe2e4a1d 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -1,6 +1,6 @@ {- management of the git-annex branch - - - Copyright 2011-2018 Joey Hess + - Copyright 2011-2019 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -63,6 +63,7 @@ import Logs import Logs.Transitions import Logs.File import Logs.Trust.Pure +import Logs.Remote.Pure import Logs.Difference.Pure import qualified Annex.Queue import Annex.Branch.Transitions @@ -574,13 +575,16 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do run [] = noop run changers = do trustmap <- calcTrustMap <$> getStaged trustLog + remoteconfigmap <- calcRemoteConfigMap <$> getStaged remoteLog + -- partially apply, improves performance + let changers' = map (\c -> c trustmap remoteconfigmap) changers fs <- branchFiles forM_ fs $ \f -> do content <- getStaged f - apply changers f content trustmap - apply [] _ _ _ = return () - apply (changer:rest) file content trustmap = - case changer file content trustmap of + apply changers' f content + apply [] _ _ = return () + apply (changer:rest) file content = + case changer file content of RemoveFile -> do Annex.Queue.addUpdateIndex =<< inRepo (Git.UpdateIndex.unstageFile file) @@ -592,9 +596,9 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do sha <- hashBlob content' Annex.Queue.addUpdateIndex $ Git.UpdateIndex.pureStreamer $ Git.UpdateIndex.updateIndexLine sha TreeFile (asTopFilePath file) - apply rest file content' trustmap + apply rest file content' PreserveFile -> - apply rest file content trustmap + apply rest file content checkBranchDifferences :: Git.Ref -> Annex () checkBranchDifferences ref = do diff --git a/Annex/Branch/Transitions.hs b/Annex/Branch/Transitions.hs index d86dd1a14b..7961dcf1cc 100644 --- a/Annex/Branch/Transitions.hs +++ b/Annex/Branch/Transitions.hs @@ -20,6 +20,8 @@ import qualified Logs.MetaData.Pure as MetaData import Types.TrustLevel import Types.UUID import Types.MetaData +import Types.Remote +import Annex.SpecialRemote.Config import qualified Data.Map as M import qualified Data.Set as S @@ -32,42 +34,63 @@ data FileTransition | RemoveFile | PreserveFile -type TransitionCalculator = FilePath -> L.ByteString -> TrustMap -> FileTransition +type TransitionCalculator = TrustMap -> M.Map UUID RemoteConfig -> FilePath -> L.ByteString -> FileTransition getTransitionCalculator :: Transition -> Maybe TransitionCalculator getTransitionCalculator ForgetGitHistory = Nothing getTransitionCalculator ForgetDeadRemotes = Just dropDead -dropDead :: FilePath -> L.ByteString -> TrustMap -> FileTransition -dropDead f content trustmap = case getLogVariety f of +-- Removes data about all dead repos. +-- +-- The trust log is not changed, because other, unmerged clones +-- may contain other data about the dead repos. So we need to rememebr +-- which are dead to later remove that. +-- +-- When the remote log contains a sameas-uuid pointing to a dead uuid, +-- the uuid of that remote configuration is also effectively dead, +-- though not in the trust log. There may be per-remote state stored using +-- the latter uuid, that also needs to be removed. That configuration +-- is not removed from the remote log, for the same reason the trust log +-- is not changed. +dropDead :: TransitionCalculator +dropDead trustmap remoteconfigmap f content = case getLogVariety f of Just OldUUIDBasedLog - -- Don't remove the dead repo from the trust log, - -- because git remotes may still exist, and they need - -- to still know it's dead. | f == trustLog -> PreserveFile - | otherwise -> ChangeFile $ - UUIDBased.buildLogOld byteString $ - dropDeadFromMapLog trustmap id $ - UUIDBased.parseLogOld A.takeByteString content + | otherwise -> + let go tm = ChangeFile $ + UUIDBased.buildLogOld byteString $ + dropDeadFromMapLog tm id $ + UUIDBased.parseLogOld A.takeByteString content + in if f == remoteLog + then go trustmap + else go trustmap' Just NewUUIDBasedLog -> ChangeFile $ UUIDBased.buildLogNew byteString $ - dropDeadFromMapLog trustmap id $ + dropDeadFromMapLog trustmap' id $ UUIDBased.parseLogNew A.takeByteString content Just (ChunkLog _) -> ChangeFile $ - Chunk.buildLog $ dropDeadFromMapLog trustmap fst $ Chunk.parseLog content + Chunk.buildLog $ dropDeadFromMapLog trustmap' fst $ Chunk.parseLog content Just (PresenceLog _) -> let newlog = Presence.compactLog $ - dropDeadFromPresenceLog trustmap $ Presence.parseLog content + dropDeadFromPresenceLog trustmap' $ Presence.parseLog content in if null newlog then RemoveFile else ChangeFile $ Presence.buildLog newlog Just RemoteMetaDataLog -> - let newlog = dropDeadFromRemoteMetaDataLog trustmap $ MetaData.simplifyLog $ MetaData.parseLog content + let newlog = dropDeadFromRemoteMetaDataLog trustmap' $ + MetaData.simplifyLog $ MetaData.parseLog content in if S.null newlog then RemoveFile else ChangeFile $ MetaData.buildLog newlog Just OtherLog -> PreserveFile Nothing -> PreserveFile + where + trustmap' = trustmap `M.union` + M.map (const DeadTrusted) (M.filter sameasdead remoteconfigmap) + sameasdead cm = + case toUUID <$> M.lookup sameasUUIDField cm of + Nothing -> False + Just u' -> M.lookup u' trustmap == Just DeadTrusted dropDeadFromMapLog :: TrustMap -> (k -> UUID) -> M.Map k v -> M.Map k v dropDeadFromMapLog trustmap getuuid = diff --git a/Logs/Remote.hs b/Logs/Remote.hs index 2b767c2f4a..02350dbb83 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -22,11 +22,10 @@ import qualified Annex.Branch import Types.Remote import Logs import Logs.UUIDBased +import Logs.Remote.Pure import Annex.SpecialRemote.Config import qualified Data.Map as M -import Data.Char -import qualified Data.Attoparsec.ByteString.Lazy as A import Data.ByteString.Builder {- Adds or updates a remote's config in the log. -} @@ -40,71 +39,5 @@ configSet u cfg = do {- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID RemoteConfig) -readRemoteLog = (\m -> M.map (addSameasInherited m) m) - . simpleMap - . parseLogOld remoteConfigParser +readRemoteLog = calcRemoteConfigMap <$> Annex.Branch.get remoteLog - -remoteConfigParser :: A.Parser RemoteConfig -remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString - -showConfig :: RemoteConfig -> String -showConfig = unwords . configToKeyVal - -{- Given Strings like "key=value", generates a RemoteConfig. -} -keyValToConfig :: [String] -> RemoteConfig -keyValToConfig ws = M.fromList $ map (/=/) ws - where - (/=/) s = (k, v) - where - k = takeWhile (/= '=') s - v = configUnEscape $ drop (1 + length k) s - -configToKeyVal :: M.Map String String -> [String] -configToKeyVal m = map toword $ sort $ M.toList m - where - toword (k, v) = k ++ "=" ++ configEscape v - -configEscape :: String -> String -configEscape = concatMap escape - where - escape c - | isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";" - | otherwise = [c] - -configUnEscape :: String -> String -configUnEscape = unescape - where - unescape [] = [] - unescape (c:rest) - | c == '&' = entity rest - | otherwise = c : unescape rest - entity s - | not (null num) && ";" `isPrefixOf` r = - chr (Prelude.read num) : unescape rest - | otherwise = - '&' : unescape s - where - num = takeWhile isNumber s - r = drop (length num) s - rest = drop 1 r - -{- for quickcheck -} -prop_isomorphic_configEscape :: String -> Bool -prop_isomorphic_configEscape s = s == (configUnEscape . configEscape) s - -prop_parse_show_Config :: RemoteConfig -> Bool -prop_parse_show_Config c - -- whitespace and '=' are not supported in config keys - | any (\k -> any isSpace k || elem '=' k) (M.keys c) = True - | any (any excluded) (M.keys c) = True - | any (any excluded) (M.elems c) = True - | otherwise = A.parseOnly remoteConfigParser (encodeBS $ showConfig c) ~~ Right c - where - normalize v = sort . M.toList <$> v - a ~~ b = normalize a == normalize b - -- limit to ascii alphanumerics for simplicity; characters not - -- allowed by the current character set in the config may not - -- round-trip in an identical representation due to the use of the - -- filesystem encoding. - excluded ch = not (isAlphaNum ch) || not (isAscii ch) diff --git a/git-annex.cabal b/git-annex.cabal index 134640f277..4ddc4444be 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -897,6 +897,7 @@ Executable git-annex Logs.Presence Logs.Presence.Pure Logs.Remote + Logs.Remote.Pure Logs.RemoteState Logs.Schedule Logs.SingleValue