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

@@ -1,6 +1,6 @@
 {- management of the git-annex branch
  -
- - Copyright 2011-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>
  -
  - 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 changers' f content
-	apply [] _ _ _ = return ()
+	apply [] _ _ = return ()
-	apply (changer:rest) file content trustmap =
+	apply (changer:rest) file content =
-		case changer file content trustmap of
+		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

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
+-- Removes data about all dead repos.
-dropDead f content trustmap = case getLogVariety f of
+--
+-- 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 $
+		| otherwise ->
-			UUIDBased.buildLogOld byteString $
+			let go tm = ChangeFile $
-				dropDeadFromMapLog trustmap id $
+				UUIDBased.buildLogOld byteString $
-					UUIDBased.parseLogOld A.takeByteString content
+					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 =

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)
+readRemoteLog = calcRemoteConfigMap 
-	. simpleMap
-	. parseLogOld remoteConfigParser
 	<$> 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)

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