break module dependancy loop

A PITA but worth it to clean up the trust configuration code.
This commit is contained in:
Joey Hess 2012-01-10 13:11:16 -04:00
parent 0d5c402210
commit 07cacbeee9
10 changed files with 109 additions and 107 deletions

View file

@ -26,13 +26,13 @@ import Common.Annex
import qualified Backend import qualified Backend
import qualified Annex import qualified Annex
import qualified Git import qualified Git
import qualified Remote
import Types.Command as ReExported import Types.Command as ReExported
import Types.Option as ReExported import Types.Option as ReExported
import Seek as ReExported import Seek as ReExported
import Checks as ReExported import Checks as ReExported
import Usage as ReExported import Usage as ReExported
import Logs.Trust import Logs.Trust
import Logs.Location
import Config import Config
{- Generates a normal command -} {- Generates a normal command -}
@ -110,5 +110,5 @@ autoCopies key vs numcopiesattr a = Annex.getState Annex.auto >>= auto
auto False = a auto False = a
auto True = do auto True = do
needed <- getNumCopies numcopiesattr needed <- getNumCopies numcopiesattr
(_, have) <- trustPartition UnTrusted =<< keyLocations key (_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
if length have `vs` needed then a else stop if length have `vs` needed then a else stop

View file

@ -93,7 +93,7 @@ verifyLocationLog key desc = do
preventWrite (parentDir f) preventWrite (parentDir f)
u <- getUUID u <- getUUID
uuids <- keyLocations key uuids <- Remote.keyLocations key
case (present, u `elem` uuids) of case (present, u `elem` uuids) of
(True, False) -> do (True, False) -> do
@ -142,7 +142,7 @@ checkBackend = Types.Backend.fsckKey
checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool checkKeyNumCopies :: Key -> FilePath -> Maybe Int -> Annex Bool
checkKeyNumCopies key file numcopies = do checkKeyNumCopies key file numcopies = do
needed <- getNumCopies numcopies needed <- getNumCopies numcopies
(untrustedlocations, safelocations) <- trustPartition UnTrusted =<< keyLocations key (untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key
let present = length safelocations let present = length safelocations
if present < needed if present < needed
then do then do

View file

@ -8,7 +8,6 @@
module Command.Whereis where module Command.Whereis where
import Common.Annex import Common.Annex
import Logs.Location
import Command import Command
import Remote import Remote
import Logs.Trust import Logs.Trust

View file

@ -12,8 +12,6 @@ import qualified Git
import qualified Git.Config import qualified Git.Config
import qualified Git.Command import qualified Git.Command
import qualified Annex import qualified Annex
import qualified Logs.Trust
import Types.TrustLevel
type ConfigKey = String type ConfigKey = String
@ -85,6 +83,5 @@ getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies
config = "annex.numcopies" config = "annex.numcopies"
{- Gets the trust level set for a remote in git config. -} {- Gets the trust level set for a remote in git config. -}
getTrustLevel :: Git.Repo -> Annex (Maybe TrustLevel) getTrustLevel :: Git.Repo -> Annex (Maybe String)
getTrustLevel r = maybe Nothing Logs.Trust.trustName <$> getTrustLevel r = fromRepo $ Git.Config.getMaybe $ remoteConfig r "trustlevel"
fromRepo (Git.Config.getMaybe (remoteConfig r "trustlevel"))

View file

@ -15,7 +15,6 @@ import qualified Annex
import qualified Utility.Matcher import qualified Utility.Matcher
import qualified Remote import qualified Remote
import qualified Backend import qualified Backend
import Logs.Location
import Annex.Content import Annex.Content
type Limit = Utility.Matcher.Token (FilePath -> Annex Bool) 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 handle a (Just (key, _)) = a key
inremote key = do inremote key = do
u <- Remote.nameToUUID name u <- Remote.nameToUUID name
us <- keyLocations key us <- Remote.keyLocations key
return $ u `elem` us return $ u `elem` us
{- Adds a limit to skip files not believed to have the specified number {- 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 check n = Backend.lookupFile >=> handle n
handle _ Nothing = return False handle _ Nothing = return False
handle n (Just (key, _)) = do handle n (Just (key, _)) = do
us <- keyLocations key us <- Remote.keyLocations key
return $ length us >= n return $ length us >= n
{- Adds a limit to skip files not using a specified key-value backend. -} {- Adds a limit to skip files not using a specified key-value backend. -}

View file

@ -16,8 +16,7 @@
module Logs.Location ( module Logs.Location (
LogStatus(..), LogStatus(..),
logChange, logChange,
readLog, loggedLocations,
keyLocations,
loggedKeys, loggedKeys,
loggedKeysFor, loggedKeysFor,
logFile, logFile,
@ -27,7 +26,6 @@ module Logs.Location (
import Common.Annex import Common.Annex
import qualified Annex.Branch import qualified Annex.Branch
import Logs.Presence import Logs.Presence
import Logs.Trust
{- Log a change in the presence of a key's value in a repository. -} {- Log a change in the presence of a key's value in a repository. -}
logChange :: Key -> UUID -> LogStatus -> Annex () logChange :: Key -> UUID -> LogStatus -> Annex ()
@ -36,13 +34,9 @@ logChange _ NoUUID _ = return ()
{- Returns a list of repository UUIDs that, according to the log, have {- Returns a list of repository UUIDs that, according to the log, have
- the value of a key. - the value of a key.
-
- Dead repositories are skipped.
-} -}
keyLocations :: Key -> Annex [UUID] loggedLocations :: Key -> Annex [UUID]
keyLocations key = do loggedLocations key = map toUUID <$> (currentLog . logFile) key
l <- map toUUID <$> (currentLog . logFile) key
snd <$> trustPartition DeadTrusted l
{- Finds all keys that have location log information. {- Finds all keys that have location log information.
- (There may be duplicate keys in the list.) -} - (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 {- This should run strictly to avoid the filterM
- building many thunks containing keyLocations data. -} - building many thunks containing keyLocations data. -}
isthere k = do isthere k = do
us <- keyLocations k us <- loggedLocations k
let !there = u `elem` us let !there = u `elem` us
return there return there

View file

@ -10,7 +10,6 @@ module Logs.Trust (
trustGet, trustGet,
trustSet, trustSet,
trustPartition, trustPartition,
trustName
) where ) where
import qualified Data.Map as M import qualified Data.Map as M
@ -21,6 +20,9 @@ import Types.TrustLevel
import qualified Annex.Branch import qualified Annex.Branch
import qualified Annex import qualified Annex
import Logs.UUIDBased import Logs.UUIDBased
import Remote.List
import Config
import qualified Types.Remote
{- Filename of trust.log. -} {- Filename of trust.log. -}
trustLog :: FilePath trustLog :: FilePath
@ -56,7 +58,7 @@ trustPartition level ls
return $ partition (`elem` candidates) ls return $ partition (`elem` candidates) ls
{- Read the trustLog into a map, overriding with any {- 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 :: Annex TrustMap
trustMap = do trustMap = do
cached <- Annex.getState Annex.trustmap cached <- Annex.getState Annex.trustmap
@ -66,9 +68,22 @@ trustMap = do
overrides <- Annex.getState Annex.forcetrust overrides <- Annex.getState Annex.forcetrust
logged <- simpleMap . parseLog (Just . parseTrust) <$> logged <- simpleMap . parseLog (Just . parseTrust) <$>
Annex.Branch.get trustLog 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 } Annex.changeState $ \s -> s { Annex.trustmap = Just m }
return 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 {- The trust.log used to only list trusted repos, without a field for the
- trust status, which is why this defaults to Trusted. -} - trust status, which is why this defaults to Trusted. -}
@ -85,10 +100,3 @@ showTrust Trusted = "1"
showTrust UnTrusted = "0" showTrust UnTrusted = "0"
showTrust DeadTrusted = "X" showTrust DeadTrusted = "X"
showTrust SemiTrusted = "?" showTrust SemiTrusted = "?"
trustName :: String -> Maybe TrustLevel
trustName "trusted" = Just Trusted
trustName "untrusted" = Just UnTrusted
trustName "deadtrusted" = Just DeadTrusted
trustName "semitrusted" = Just SemiTrusted
trustName _ = Nothing

View file

@ -24,6 +24,7 @@ module Remote (
prettyPrintUUIDs, prettyPrintUUIDs,
remotesWithUUID, remotesWithUUID,
remotesWithoutUUID, remotesWithoutUUID,
keyLocations,
keyPossibilities, keyPossibilities,
keyPossibilitiesTrusted, keyPossibilitiesTrusted,
nameToUUID, nameToUUID,
@ -40,55 +41,11 @@ import Text.JSON.Generic
import Common.Annex import Common.Annex
import Types.Remote import Types.Remote
import qualified Annex import qualified Annex
import qualified Git
import Config
import Annex.UUID import Annex.UUID
import Logs.UUID import Logs.UUID
import Logs.Trust import Logs.Trust
import Logs.Location import Logs.Location
import Logs.Remote import Remote.List
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
{- Map of UUIDs of Remotes and their names. -} {- Map of UUIDs of Remotes and their names. -}
remoteMap :: Annex (M.Map UUID String) 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 :: [Remote] -> [UUID] -> [Remote]
remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs 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 -> 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 - Also returns a list of UUIDs that are trusted to have the key
- (some may not have configured remotes). - (some may not have configured remotes).
-} -}
keyPossibilitiesTrusted :: Key -> Annex ([Remote], [UUID]) keyPossibilitiesTrusted :: Key -> Annex ([Remote], [UUID])
keyPossibilitiesTrusted = keyPossibilities' True keyPossibilitiesTrusted key = keyPossibilities' key =<< trustGet Trusted
keyPossibilities' :: Bool -> Key -> Annex ([Remote], [UUID]) keyPossibilities' :: Key -> [UUID] -> Annex ([Remote], [UUID])
keyPossibilities' withtrusted key = do keyPossibilities' key trusted = do
u <- getUUID u <- getUUID
trusted <- if withtrusted then trustGet Trusted else return []
-- get uuids of all remotes that are recorded to have the key -- uuids of all remotes that are recorded to have the key
uuids <- keyLocations key validuuids <- filter (/= u) <$> keyLocations key
let validuuids = filter (/= u) uuids
-- note that validuuids is assumed to not have dups -- note that validuuids is assumed to not have dups
let validtrusteduuids = validuuids `intersect` trusted let validtrusteduuids = validuuids `intersect` trusted
@ -241,24 +203,10 @@ showTriedRemotes remotes =
(join ", " $ map name remotes) (join ", " $ map name remotes)
forceTrust :: TrustLevel -> String -> Annex () forceTrust :: TrustLevel -> String -> Annex ()
forceTrust level remotename = forceTrust' True level =<< nameToUUID remotename forceTrust level remotename = do
u <- nameToUUID remotename
forceTrust' :: Bool -> TrustLevel -> UUID -> Annex ()
forceTrust' overwrite level u = do
Annex.changeState $ \s -> Annex.changeState $ \s ->
s { Annex.forcetrust = change u level (Annex.forcetrust s) } s { Annex.forcetrust = M.insert 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 ()
{- Used to log a change in a remote's having a key. The change is logged {- 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 - in the local repo, not on the remote. The process of transferring the

58
Remote/List.hs Normal file
View file

@ -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

View file

@ -32,7 +32,6 @@ import qualified Locations
import qualified Types.Backend import qualified Types.Backend
import qualified Types import qualified Types
import qualified GitAnnex import qualified GitAnnex
import qualified Logs.Location
import qualified Logs.UUIDBased import qualified Logs.UUIDBased
import qualified Logs.Trust import qualified Logs.Trust
import qualified Logs.Remote import qualified Logs.Remote
@ -847,7 +846,7 @@ checklocationlog f expected = do
r <- annexeval $ Backend.lookupFile f r <- annexeval $ Backend.lookupFile f
case r of case r of
Just (k, _) -> do 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) assertEqual ("bad content in location log for " ++ f ++ " key " ++ (show k) ++ " uuid " ++ show thisuuid)
expected (thisuuid `elem` uuids) expected (thisuuid `elem` uuids)
_ -> assertFailure $ f ++ " failed to look up key" _ -> assertFailure $ f ++ " failed to look up key"