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
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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue