diff options
author | Joey Hess <joey@kitenet.net> | 2012-01-10 13:11:16 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-01-10 13:32:38 -0400 |
commit | 07cacbeee95b377e1bf4111e4d4b30190956c585 (patch) | |
tree | 17249f177a6ffde3d2f524ee66a9a6b2530bd92e | |
parent | 0d5c4022105a393a4eac76b09940f8b22fa0a56c (diff) |
break module dependancy loop
A PITA but worth it to clean up the trust configuration code.
-rw-r--r-- | Command.hs | 4 | ||||
-rw-r--r-- | Command/Fsck.hs | 4 | ||||
-rw-r--r-- | Command/Whereis.hs | 1 | ||||
-rw-r--r-- | Config.hs | 7 | ||||
-rw-r--r-- | Limit.hs | 5 | ||||
-rw-r--r-- | Logs/Location.hs | 14 | ||||
-rw-r--r-- | Logs/Trust.hs | 28 | ||||
-rw-r--r-- | Remote.hs | 92 | ||||
-rw-r--r-- | Remote/List.hs | 58 | ||||
-rw-r--r-- | test.hs | 3 |
10 files changed, 109 insertions, 107 deletions
diff --git a/Command.hs b/Command.hs index 82d6429bf..386efafde 100644 --- a/Command.hs +++ b/Command.hs @@ -26,13 +26,13 @@ import Common.Annex import qualified Backend import qualified Annex import qualified Git +import qualified Remote import Types.Command as ReExported import Types.Option as ReExported import Seek as ReExported import Checks as ReExported import Usage as ReExported import Logs.Trust -import Logs.Location import Config {- Generates a normal command -} @@ -110,5 +110,5 @@ autoCopies key vs numcopiesattr a = Annex.getState Annex.auto >>= auto auto False = a auto True = do needed <- getNumCopies numcopiesattr - (_, have) <- trustPartition UnTrusted =<< keyLocations key + (_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key if length have `vs` needed then a else stop diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 723a2e740..61107ebe1 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -93,7 +93,7 @@ verifyLocationLog key desc = do preventWrite (parentDir f) u <- getUUID - uuids <- keyLocations key + uuids <- Remote.keyLocations key case (present, u `elem` uuids) of (True, False) -> do @@ -142,7 +142,7 @@ checkBackend = Types.Backend.fsckKey checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool checkKeyNumCopies key file numcopies = do needed <- getNumCopies numcopies - (untrustedlocations, safelocations) <- trustPartition UnTrusted =<< keyLocations key + (untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key let present = length safelocations if present < needed then do diff --git a/Command/Whereis.hs b/Command/Whereis.hs index 9e57f361b..1fbe70799 100644 --- a/Command/Whereis.hs +++ b/Command/Whereis.hs @@ -8,7 +8,6 @@ module Command.Whereis where import Common.Annex -import Logs.Location import Command import Remote import Logs.Trust @@ -12,8 +12,6 @@ import qualified Git import qualified Git.Config import qualified Git.Command import qualified Annex -import qualified Logs.Trust -import Types.TrustLevel type ConfigKey = String @@ -85,6 +83,5 @@ getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies config = "annex.numcopies" {- Gets the trust level set for a remote in git config. -} -getTrustLevel :: Git.Repo -> Annex (Maybe TrustLevel) -getTrustLevel r = maybe Nothing Logs.Trust.trustName <$> - fromRepo (Git.Config.getMaybe (remoteConfig r "trustlevel")) +getTrustLevel :: Git.Repo -> Annex (Maybe String) +getTrustLevel r = fromRepo $ Git.Config.getMaybe $ remoteConfig r "trustlevel" @@ -15,7 +15,6 @@ import qualified Annex import qualified Utility.Matcher import qualified Remote import qualified Backend -import Logs.Location import Annex.Content type Limit = Utility.Matcher.Token (FilePath -> Annex Bool) @@ -78,7 +77,7 @@ addIn name = addLimit $ check $ if name == "." then inAnnex else inremote handle a (Just (key, _)) = a key inremote key = do u <- Remote.nameToUUID name - us <- keyLocations key + us <- Remote.keyLocations key return $ u `elem` us {- Adds a limit to skip files not believed to have the specified number @@ -92,7 +91,7 @@ addCopies num = check n = Backend.lookupFile >=> handle n handle _ Nothing = return False handle n (Just (key, _)) = do - us <- keyLocations key + us <- Remote.keyLocations key return $ length us >= n {- Adds a limit to skip files not using a specified key-value backend. -} diff --git a/Logs/Location.hs b/Logs/Location.hs index 588962bc5..b6d59b928 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -16,8 +16,7 @@ module Logs.Location ( LogStatus(..), logChange, - readLog, - keyLocations, + loggedLocations, loggedKeys, loggedKeysFor, logFile, @@ -27,7 +26,6 @@ module Logs.Location ( import Common.Annex import qualified Annex.Branch import Logs.Presence -import Logs.Trust {- Log a change in the presence of a key's value in a repository. -} logChange :: Key -> UUID -> LogStatus -> Annex () @@ -36,13 +34,9 @@ logChange _ NoUUID _ = return () {- Returns a list of repository UUIDs that, according to the log, have - the value of a key. - - - - Dead repositories are skipped. -} -keyLocations :: Key -> Annex [UUID] -keyLocations key = do - l <- map toUUID <$> (currentLog . logFile) key - snd <$> trustPartition DeadTrusted l +loggedLocations :: Key -> Annex [UUID] +loggedLocations key = map toUUID <$> (currentLog . logFile) key {- Finds all keys that have location log information. - (There may be duplicate keys in the list.) -} @@ -57,7 +51,7 @@ loggedKeysFor u = filterM isthere =<< loggedKeys {- This should run strictly to avoid the filterM - building many thunks containing keyLocations data. -} isthere k = do - us <- keyLocations k + us <- loggedLocations k let !there = u `elem` us return there diff --git a/Logs/Trust.hs b/Logs/Trust.hs index f6ead87f1..4dd728a8b 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -10,7 +10,6 @@ module Logs.Trust ( trustGet, trustSet, trustPartition, - trustName ) where import qualified Data.Map as M @@ -21,6 +20,9 @@ import Types.TrustLevel import qualified Annex.Branch import qualified Annex import Logs.UUIDBased +import Remote.List +import Config +import qualified Types.Remote {- Filename of trust.log. -} trustLog :: FilePath @@ -56,7 +58,7 @@ trustPartition level ls return $ partition (`elem` candidates) ls {- Read the trustLog into a map, overriding with any - - values from forcetrust. The map is cached for speed. -} + - values from forcetrust or the git config. The map is cached for speed. -} trustMap :: Annex TrustMap trustMap = do cached <- Annex.getState Annex.trustmap @@ -66,9 +68,22 @@ trustMap = do overrides <- Annex.getState Annex.forcetrust logged <- simpleMap . parseLog (Just . parseTrust) <$> Annex.Branch.get trustLog - let m = M.union overrides logged + configured <- M.fromList . catMaybes <$> + (mapM configuredtrust =<< remoteList) + let m = M.union overrides $ M.union configured logged Annex.changeState $ \s -> s { Annex.trustmap = Just m } return m + where + configuredtrust r = + maybe Nothing (\l -> Just (Types.Remote.uuid r, l)) <$> + (convert <$> getTrustLevel (Types.Remote.repo r)) + convert :: Maybe String -> Maybe TrustLevel + convert Nothing = Nothing + convert (Just s) + | s == "trusted" = Just Trusted + | s == "untrusted" = Just UnTrusted + | s == "semitrusted" = Just SemiTrusted + | otherwise = Nothing {- The trust.log used to only list trusted repos, without a field for the - trust status, which is why this defaults to Trusted. -} @@ -85,10 +100,3 @@ showTrust Trusted = "1" showTrust UnTrusted = "0" showTrust DeadTrusted = "X" showTrust SemiTrusted = "?" - -trustName :: String -> Maybe TrustLevel -trustName "trusted" = Just Trusted -trustName "untrusted" = Just UnTrusted -trustName "deadtrusted" = Just DeadTrusted -trustName "semitrusted" = Just SemiTrusted -trustName _ = Nothing @@ -24,6 +24,7 @@ module Remote ( prettyPrintUUIDs, remotesWithUUID, remotesWithoutUUID, + keyLocations, keyPossibilities, keyPossibilitiesTrusted, nameToUUID, @@ -40,55 +41,11 @@ import Text.JSON.Generic import Common.Annex import Types.Remote import qualified Annex -import qualified Git -import Config import Annex.UUID import Logs.UUID import Logs.Trust import Logs.Location -import Logs.Remote - -import qualified Remote.Git -import qualified Remote.S3 -import qualified Remote.Bup -import qualified Remote.Directory -import qualified Remote.Rsync -import qualified Remote.Web -import qualified Remote.Hook - -remoteTypes :: [RemoteType] -remoteTypes = - [ Remote.Git.remote - , Remote.S3.remote - , Remote.Bup.remote - , Remote.Directory.remote - , Remote.Rsync.remote - , Remote.Web.remote - , Remote.Hook.remote - ] - -{- Builds a list of all available Remotes. - - Since doing so can be expensive, the list is cached. -} -remoteList :: Annex [Remote] -remoteList = do - rs <- Annex.getState Annex.remotes - if null rs - then do - m <- readRemoteLog - rs' <- concat <$> mapM (process m) remoteTypes - Annex.changeState $ \s -> s { Annex.remotes = rs' } - return rs' - else return rs - where - process m t = enumerate t >>= mapM (gen m t) - gen m t r = do - u <- getRepoUUID r - checkTrust r u - generate t r u (M.lookup u m) - -{- All remotes that are not ignored. -} -enabledRemoteList :: Annex [Remote] -enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList +import Remote.List {- Map of UUIDs of Remotes and their names. -} remoteMap :: Annex (M.Map UUID String) @@ -185,27 +142,32 @@ remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs remotesWithoutUUID :: [Remote] -> [UUID] -> [Remote] remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs -{- Cost ordered lists of remotes that the Logs.Location indicate may have a key. +{- List of repository UUIDs that the location log indicates may have a key. + - Dead repositories are excluded. -} +keyLocations :: Key -> Annex [UUID] +keyLocations key = snd <$> (trustPartition DeadTrusted =<< loggedLocations key) + +{- Cost ordered lists of remotes that the location log indicates + - may have a key. -} keyPossibilities :: Key -> Annex [Remote] -keyPossibilities key = fst <$> keyPossibilities' False key +keyPossibilities key = fst <$> keyPossibilities' key [] -{- Cost ordered lists of remotes that the Logs.Location indicate may have a key. +{- Cost ordered lists of remotes that the location log indicates + - may have a key. - - Also returns a list of UUIDs that are trusted to have the key - (some may not have configured remotes). -} keyPossibilitiesTrusted :: Key -> Annex ([Remote], [UUID]) -keyPossibilitiesTrusted = keyPossibilities' True +keyPossibilitiesTrusted key = keyPossibilities' key =<< trustGet Trusted -keyPossibilities' :: Bool -> Key -> Annex ([Remote], [UUID]) -keyPossibilities' withtrusted key = do +keyPossibilities' :: Key -> [UUID] -> Annex ([Remote], [UUID]) +keyPossibilities' key trusted = do u <- getUUID - trusted <- if withtrusted then trustGet Trusted else return [] - -- get uuids of all remotes that are recorded to have the key - uuids <- keyLocations key - let validuuids = filter (/= u) uuids + -- uuids of all remotes that are recorded to have the key + validuuids <- filter (/= u) <$> keyLocations key -- note that validuuids is assumed to not have dups let validtrusteduuids = validuuids `intersect` trusted @@ -241,24 +203,10 @@ showTriedRemotes remotes = (join ", " $ map name remotes) forceTrust :: TrustLevel -> String -> Annex () -forceTrust level remotename = forceTrust' True level =<< nameToUUID remotename - -forceTrust' :: Bool -> TrustLevel -> UUID -> Annex () -forceTrust' overwrite level u = do +forceTrust level remotename = do + u <- nameToUUID remotename Annex.changeState $ \s -> - s { Annex.forcetrust = change u level (Annex.forcetrust s) } - -- This change invalidated any cached trustmap. - Annex.changeState $ \s -> s { Annex.trustmap = Nothing } - where - change - | overwrite = M.insert - | otherwise = M.insertWith (\_new old -> old) - -checkTrust :: Git.Repo -> UUID -> Annex () -checkTrust r u = set =<< getTrustLevel r - where - set (Just level) = forceTrust' False level u - set Nothing = return () + s { Annex.forcetrust = M.insert u level (Annex.forcetrust s) } {- Used to log a change in a remote's having a key. The change is logged - in the local repo, not on the remote. The process of transferring the diff --git a/Remote/List.hs b/Remote/List.hs new file mode 100644 index 000000000..e589b4401 --- /dev/null +++ b/Remote/List.hs @@ -0,0 +1,58 @@ +{- git-annex remote list + - + - Copyright 2011 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Remote.List where + +import qualified Data.Map as M + +import Common.Annex +import qualified Annex +import Logs.Remote +import Types.Remote +import Annex.UUID +import Config + +import qualified Remote.Git +import qualified Remote.S3 +import qualified Remote.Bup +import qualified Remote.Directory +import qualified Remote.Rsync +import qualified Remote.Web +import qualified Remote.Hook + +remoteTypes :: [RemoteType] +remoteTypes = + [ Remote.Git.remote + , Remote.S3.remote + , Remote.Bup.remote + , Remote.Directory.remote + , Remote.Rsync.remote + , Remote.Web.remote + , Remote.Hook.remote + ] + +{- Builds a list of all available Remotes. + - Since doing so can be expensive, the list is cached. -} +remoteList :: Annex [Remote] +remoteList = do + rs <- Annex.getState Annex.remotes + if null rs + then do + m <- readRemoteLog + rs' <- concat <$> mapM (process m) remoteTypes + Annex.changeState $ \s -> s { Annex.remotes = rs' } + return rs' + else return rs + where + process m t = enumerate t >>= mapM (gen m t) + gen m t r = do + u <- getRepoUUID r + generate t r u (M.lookup u m) + +{- All remotes that are not ignored. -} +enabledRemoteList :: Annex [Remote] +enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList @@ -32,7 +32,6 @@ import qualified Locations import qualified Types.Backend import qualified Types import qualified GitAnnex -import qualified Logs.Location import qualified Logs.UUIDBased import qualified Logs.Trust import qualified Logs.Remote @@ -847,7 +846,7 @@ checklocationlog f expected = do r <- annexeval $ Backend.lookupFile f case r of Just (k, _) -> do - uuids <- annexeval $ Logs.Location.keyLocations k + uuids <- annexeval $ Remote.keyLocations k assertEqual ("bad content in location log for " ++ f ++ " key " ++ (show k) ++ " uuid " ++ show thisuuid) expected (thisuuid `elem` uuids) _ -> assertFailure $ f ++ " failed to look up key" |