break module dependancy loop
A PITA but worth it to clean up the trust configuration code.
This commit is contained in:
parent
0d5c402210
commit
07cacbeee9
10 changed files with 109 additions and 107 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
5
Limit.hs
5
Limit.hs
|
@ -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. -}
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
92
Remote.hs
92
Remote.hs
|
@ -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
58
Remote/List.hs
Normal 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
|
3
test.hs
3
test.hs
|
@ -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"
|
||||
|
|
Loading…
Reference in a new issue