Add annex-trustlevel configuration settings, which can be used to override the trust level of a remote.

This overrides the trust.log, and is overridden by the command-line trust
parameters.

It would have been nicer to have Logs.Trust.trustMap just look up the
configuration for all remotes, but a dependency loop prevented that
(Remotes depends on Logs.Trust in several ways). So instead, look up
the configuration when building remotes, storing it in the same forcetrust
field used for the command-line trust parameters.

7 files changed, 64 insertions, 26 deletions

diff --git a/Annex.hs b/Annex.hs
index f1e46126a..b365132e5 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -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
diff --git a/Config.hs b/Config.hs
index aa8885873..0a7ac0789 100644
--- a/Config.hs
+++ b/Config.hs
@@ -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
diff --git a/Remote.hs b/Remote.hs
index 271665838..6a97c2da3 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -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.