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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

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