diff options
| -rw-r--r-- | Annex.hs | 5 | ||||
| -rw-r--r-- | Config.hs | 13 | ||||
| -rw-r--r-- | Git/Config.hs | 4 | ||||
| -rw-r--r-- | Logs/Trust.hs | 31 | ||||
| -rw-r--r-- | Remote.hs | 29 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 6 |
7 files changed, 64 insertions, 26 deletions
@@ -40,7 +40,6 @@ import qualified Types.Remote import Types.Crypto import Types.BranchState import Types.TrustLevel -import Types.UUID import qualified Utility.Matcher import qualified Data.Map as M @@ -84,7 +83,7 @@ data AnnexState = AnnexState , forcebackend :: Maybe String , forcenumcopies :: Maybe Int , limit :: Matcher (FilePath -> Annex Bool) - , forcetrust :: [(UUID, TrustLevel)] + , forcetrust :: TrustMap , trustmap :: Maybe TrustMap , ciphers :: M.Map EncryptedCipher Cipher , flags :: M.Map String Bool @@ -106,7 +105,7 @@ newState gitrepo = AnnexState , forcebackend = Nothing , forcenumcopies = Nothing , limit = Left [] - , forcetrust = [] + , forcetrust = M.empty , trustmap = Nothing , ciphers = M.empty , flags = M.empty @@ -12,6 +12,8 @@ import qualified Git import qualified Git.Config import qualified Git.Command import qualified Annex +import qualified Logs.Trust +import Types.TrustLevel type ConfigKey = String @@ -30,7 +32,7 @@ getConfig r key def = do def' <- fromRepo $ Git.Config.get ("annex." ++ key) def fromRepo $ Git.Config.get (remoteConfig r key) def' -{- Looks up a per-remote config setting in git config. -} +{- A per-remote config setting in git config. -} remoteConfig :: Git.Repo -> ConfigKey -> String remoteConfig r key = "remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" ++ key @@ -67,9 +69,7 @@ prop_cost_sane = False `notElem` , semiCheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost ] -{- Checks if a repo should be ignored, based either on annex-ignore - - setting, or on command-line options. Allows command-line to override - - annex-ignore. -} +{- Checks if a repo should be ignored. -} repoNotIgnored :: Git.Repo -> Annex Bool repoNotIgnored r = not . Git.configTrue <$> getConfig r "ignore" "false" @@ -83,3 +83,8 @@ getNumCopies v = perhaps (use v) =<< Annex.getState Annex.forcenumcopies readMaybe <$> fromRepo (Git.Config.get config "1") perhaps fallback = maybe fallback (return . id) 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")) diff --git a/Git/Config.hs b/Git/Config.hs index d9109548b..55ab8a6f1 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -20,6 +20,10 @@ import qualified Git.Construct get :: String -> String -> Repo -> String get key defaultValue repo = M.findWithDefault defaultValue key (config repo) +{- Returns a single git config setting, if set. -} +getMaybe :: String -> Repo -> Maybe String +getMaybe key repo = M.lookup key (config repo) + {- Runs git config and populates a repo with its config. -} read :: Repo -> IO Repo read repo@(Repo { location = Dir d }) = do diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 5d769bd24..f6ead87f1 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -9,7 +9,8 @@ module Logs.Trust ( TrustLevel(..), trustGet, trustSet, - trustPartition + trustPartition, + trustName ) where import qualified Data.Map as M @@ -32,6 +33,15 @@ trustLog = "trust.log" trustGet :: TrustLevel -> Annex [UUID] trustGet level = M.keys . M.filter (== level) <$> trustMap +{- Changes the trust level for a uuid in the trustLog. -} +trustSet :: UUID -> TrustLevel -> Annex () +trustSet uuid@(UUID _) level = do + ts <- liftIO getPOSIXTime + Annex.Branch.change trustLog $ + showLog showTrust . changeLog ts uuid level . parseLog (Just . parseTrust) + Annex.changeState $ \s -> s { Annex.trustmap = Nothing } +trustSet NoUUID _ = error "unknown UUID; cannot modify trust level" + {- Partitions a list of UUIDs to those matching a TrustLevel and not. -} trustPartition :: TrustLevel -> [UUID] -> Annex ([UUID], [UUID]) trustPartition level ls @@ -53,9 +63,10 @@ trustMap = do case cached of Just m -> return m Nothing -> do - overrides <- M.fromList <$> Annex.getState Annex.forcetrust - m <- (M.union overrides . simpleMap . parseLog (Just . parseTrust)) <$> + overrides <- Annex.getState Annex.forcetrust + logged <- simpleMap . parseLog (Just . parseTrust) <$> Annex.Branch.get trustLog + let m = M.union overrides logged Annex.changeState $ \s -> s { Annex.trustmap = Just m } return m @@ -75,11 +86,9 @@ showTrust UnTrusted = "0" showTrust DeadTrusted = "X" showTrust SemiTrusted = "?" -{- Changes the trust level for a uuid in the trustLog. -} -trustSet :: UUID -> TrustLevel -> Annex () -trustSet uuid@(UUID _) level = do - ts <- liftIO getPOSIXTime - Annex.Branch.change trustLog $ - showLog showTrust . changeLog ts uuid level . parseLog (Just . parseTrust) - Annex.changeState $ \s -> s { Annex.trustmap = Nothing } -trustSet NoUUID _ = error "unknown UUID; cannot modify trust level" +trustName :: String -> Maybe TrustLevel +trustName "trusted" = Just Trusted +trustName "untrusted" = Just UnTrusted +trustName "deadtrusted" = Just DeadTrusted +trustName "semitrusted" = Just SemiTrusted +trustName _ = Nothing @@ -40,6 +40,7 @@ import Text.JSON.Generic import Common.Annex import Types.Remote import qualified Annex +import qualified Git import Config import Annex.UUID import Logs.UUID @@ -74,17 +75,15 @@ remoteList = do if null rs then do m <- readRemoteLog - l <- mapM (process m) remoteTypes - let rs' = concat l + 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) + 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. -} @@ -242,10 +241,24 @@ showTriedRemotes remotes = (join ", " $ map name remotes) forceTrust :: TrustLevel -> String -> Annex () -forceTrust level remotename = do - r <- nameToUUID remotename +forceTrust level remotename = forceTrust' True level =<< nameToUUID remotename + +forceTrust' :: Bool -> TrustLevel -> UUID -> Annex () +forceTrust' overwrite level u = do Annex.changeState $ \s -> - s { Annex.forcetrust = (r, level):Annex.forcetrust 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 () {- 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/debian/changelog b/debian/changelog index 5f9f7ee61..90026d89e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -2,6 +2,8 @@ git-annex (3.20120107) UNRELEASED; urgency=low * log: Add --gource mode, which generates output usable by gource. * map: Fix display of remote repos + * Add annex-trustlevel configuration settings, which can be used to + override the trust level of a remote. -- Joey Hess <joeyh@debian.org> Sat, 07 Jan 2012 18:12:09 -0400 diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 629e191b5..59b756de8 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -606,6 +606,12 @@ Here are all the supported configuration settings. git-annex caches UUIDs of remote repositories here. +* `remote.<name>.annex-trustlevel` + + Configures a local trust level for the remote. This overrides the value + configured by the trust and untrust commands. The value can be any of + "trusted", "semitrusted" or "untrusted". + * `remote.<name>.annex-ssh-options` Options to use when using ssh to talk to this remote. |