implement 3 level trust storage in trust.log

Command/Semitrust.hs

@@ -0,0 +1,35 @@
+{- git-annex command
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.Semitrust where
+
+import Command
+import qualified GitRepo as Git
+import qualified Remotes
+import UUID
+import Trust
+import Messages
+
+command :: [Command]
+command = [Command "semitrust" (paramRepeating paramRemote) seek
+	"return repository to default trust level"]
+
+seek :: [CommandSeek]
+seek = [withString start]
+
+{- Marks a remote as not trusted. -}
+start :: CommandStartString
+start name = do
+	r <- Remotes.byName name
+	showStart "untrust" name
+	return $ Just $ perform r
+
+perform :: Git.Repo -> CommandPerform
+perform repo = do
+	uuid <- getUUID repo
+	trustSet uuid SemiTrusted
+	return $ Just $ return True

Command/Trust.hs

@@ -7,13 +7,10 @@
 
 module Command.Trust where
 
-import Control.Monad.State (liftIO)
-import Control.Monad (unless)
-
 import Command
-import qualified Annex
 import qualified GitRepo as Git
 import qualified Remotes
+import Trust
 import UUID
 import Messages
 
@@ -34,11 +31,5 @@ start name = do
 perform :: Git.Repo -> CommandPerform
 perform repo = do
 	uuid <- getUUID repo
-	trusted <- getTrusted
-	unless (elem uuid trusted) $ do
-		setTrusted $ uuid:trusted
-		g <- Annex.gitRepo
-		logfile <- trustLog
-		liftIO $ Git.run g ["add", logfile]
-		liftIO $ Git.run g ["commit", "-q", "-m", "git annex untrust", logfile]
+	trustSet uuid Trusted
 	return $ Just $ return True

Command/Untrust.hs

@@ -7,14 +7,11 @@
 
 module Command.Untrust where
 
-import Control.Monad.State (liftIO)
-import Control.Monad (when)
-
 import Command
-import qualified Annex
 import qualified GitRepo as Git
 import qualified Remotes
 import UUID
+import Trust
 import Messages
 
 command :: [Command]
@@ -34,11 +31,5 @@ start name = do
 perform :: Git.Repo -> CommandPerform
 perform repo = do
 	uuid <- getUUID repo
-	trusted <- getTrusted
-	when (elem uuid trusted) $ do
-		setTrusted $ filter (\u -> u /= uuid) trusted
-		g <- Annex.gitRepo
-		logfile <- trustLog
-		liftIO $ Git.run g ["add", logfile]
-		liftIO $ Git.run g ["commit", "-q", "-m", "git annex untrust", logfile]
+	trustSet uuid UnTrusted
 	return $ Just $ return True

GitAnnex.hs

@@ -37,6 +37,7 @@ import qualified Command.Migrate
 import qualified Command.Uninit
 import qualified Command.Trust
 import qualified Command.Untrust
+import qualified Command.Semitrust
 
 cmds :: [Command]
 cmds = concat
@@ -53,6 +54,7 @@ cmds = concat
 	, Command.PreCommit.command
 	, Command.Trust.command
 	, Command.Untrust.command
+	, Command.Semitrust.command
 	, Command.FromKey.command
 	, Command.DropKey.command
 	, Command.SetKey.command

Remotes.hs

@@ -32,6 +32,7 @@ import qualified Annex
 import LocationLog
 import Locations
 import UUID
+import Trust
 import Utility
 import qualified Content
 import Messages
@@ -126,7 +127,7 @@ keyPossibilities key = do
 	allremotes <- remotesByCost
 	g <- Annex.gitRepo
 	u <- getUUID g
-	trusted <- getTrusted
+	trusted <- trustGet Trusted
 
 	-- get uuids of other repositories that are
 	-- believed to have the key

Trust.hs

@@ -0,0 +1,86 @@
+{- git-annex trust levels
+ -
+ - Copyright 2010 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Trust (
+	TrustLevel(..),
+	trustLog,
+	trustGet,
+	trustMap,
+	trustMapParse,
+	trustSet
+) where
+
+import Control.Monad.State
+import qualified Data.Map as M
+
+import qualified GitRepo as Git
+import Types
+import UUID
+import Locations
+import qualified Annex
+import Utility
+
+data TrustLevel = SemiTrusted | UnTrusted | Trusted
+	deriving Eq
+
+instance Show TrustLevel where
+        show SemiTrusted = "?"
+        show UnTrusted = "0"
+        show Trusted = "1"
+
+instance Read TrustLevel where
+        readsPrec _ "1" = [(Trusted, "")]
+        readsPrec _ "0" = [(UnTrusted, "")]
+	readsPrec _ _ = [(SemiTrusted, "")]
+
+{- Filename of trust.log. -}
+trustLog :: Annex FilePath
+trustLog = do
+	g <- Annex.gitRepo
+	return $ gitStateDir g ++ "trust.log"
+
+{- Returns a list of UUIDs at the specified trust level. -}
+trustGet :: TrustLevel -> Annex [UUID]
+trustGet level = do
+	m <- trustMap
+	return $ M.keys $ M.filter (== level) m
+
+{- Read the trustLog into a map. -}
+trustMap :: Annex (M.Map UUID TrustLevel)
+trustMap = do
+	logfile <- trustLog
+	s <- liftIO $ catch (readFile logfile) ignoreerror
+	return $ trustMapParse s
+	where
+                ignoreerror _ = return ""
+
+{- Trust map parser. -}
+trustMapParse :: String -> M.Map UUID TrustLevel
+trustMapParse s = M.fromList $ map pair $ filter (not . null) $ lines s
+	where
+		pair l
+			| length w > 1 = (w !! 0, read (w !! 1) :: TrustLevel)
+			-- for back-compat; the trust log used to only
+			-- list trusted uuids
+			| otherwise = (w !! 0, Trusted)
+			where
+				w = words l
+
+{- Changes the trust level for a uuid in the trustLog, and commits it. -}
+trustSet :: UUID -> TrustLevel -> Annex ()
+trustSet uuid level = do
+        m <- trustMap
+	when (M.lookup uuid m /= Just level) $ do
+		let m' = M.insert uuid level m
+	        logfile <- trustLog
+	        liftIO $ safeWriteFile logfile (serialize m')
+		g <- Annex.gitRepo
+		liftIO $ Git.run g ["add", logfile]
+		liftIO $ Git.run g ["commit", "-q", "-m", "git annex trust change", logfile]
+        where
+                serialize m = unlines $ map showpair $ M.toList m
+		showpair (u, t) = u ++ " " ++ show t

UUID.hs

@@ -17,10 +17,7 @@ module UUID (
 	reposWithoutUUID,
 	prettyPrintUUIDs,
 	describeUUID,
-	uuidLog,
-	trustLog,
-	getTrusted,
-	setTrusted
+	uuidLog
 ) where
 
 import Control.Monad.State
@@ -141,28 +138,3 @@ uuidLog :: Annex FilePath
 uuidLog = do
 	g <- Annex.gitRepo
 	return $ gitStateDir g ++ "uuid.log"
-
-{- Filename of trust.log. -}
-trustLog :: Annex FilePath
-trustLog = do
-	g <- Annex.gitRepo
-	return $ gitStateDir g ++ "trust.log"
-
-{- List of trusted UUIDs. -}
-getTrusted :: Annex [UUID]
-getTrusted = do
-	logfile <- trustLog
-	s <- liftIO $ catch (readFile logfile) ignoreerror
-	return $ parse s
-	where
-		parse [] = []
-		parse s = map firstword $ lines s
-		firstword [] = ""
-		firstword l = head $ words l
-		ignoreerror _ = return ""
-
-{- Changes the list of trusted UUIDs. -}
-setTrusted :: [UUID] -> Annex ()
-setTrusted u = do
-	logfile <- trustLog
-	liftIO $ safeWriteFile logfile $ unlines u

doc/git-annex.mdwn

@@ -188,9 +188,13 @@ Many git-annex commands will stage changes for later `git commit` by you.
 
 * untrust [repository ...]
 
-  Records that a repository is [[not trusted|trusted]] and could lose content
+  Records that a repository is [[not trusted|trust]] and could lose content
   at any time.
 
+* semitrust [repository ...]
+
+  Returns a repository to the default [[semi trusted|trust]] state.
+
 * fromkey file
 
   This can be used to maually set up a file to link to a specified key
@@ -356,7 +360,8 @@ available. Annexed files in your git repository symlink to that content.
 `.git-annex/uuid.log` is used to map between repository UUID and
 decscriptions.
 
-`.git-annex/trust.log` is used to list the UUIDs of trusted repositories.
+`.git-annex/trust.log` is used to indicate which repositories are trusted
+and untrusted.
 
 `.git-annex/*.log` is where git-annex records its content tracking
 information. These files should be committed to git.

test.hs

@@ -32,6 +32,7 @@ import qualified Types
 import qualified GitAnnex
 import qualified LocationLog
 import qualified UUID
+import qualified Trust
 import qualified Remotes
 import qualified Content
 import qualified Backend.SHA1
@@ -288,24 +289,28 @@ test_fix = "git-annex fix" ~: intmpclonerepo $ do
 		newfile = subdir ++ "/" ++ annexedfile
 
 test_trust :: Test
-test_trust = "git-annex trust/untrust" ~: intmpclonerepo $ do
-	trust False
+test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do
+	trustcheck Trust.SemiTrusted
 	git_annex "trust" ["-q", "origin"] @? "trust failed"
-	trust True
+	trustcheck Trust.Trusted
 	git_annex "trust" ["-q", "origin"] @? "trust of trusted failed"
-	trust True
+	trustcheck Trust.Trusted
 	git_annex "untrust" ["-q", "origin"] @? "untrust failed"
-	trust False
+	trustcheck Trust.UnTrusted
 	git_annex "untrust" ["-q", "origin"] @? "untrust of untrusted failed"
-	trust False
+	trustcheck Trust.UnTrusted
+	git_annex "semitrust" ["-q", "origin"] @? "semitrust failed"
+	trustcheck Trust.SemiTrusted
+	git_annex "semitrust" ["-q", "origin"] @? "semitrust of semitrusted failed"
+	trustcheck Trust.SemiTrusted
 	where
-		trust expected = do
-			istrusted <- annexeval $ do
-				uuids <- UUID.getTrusted
+		trustcheck expected = do
+			present <- annexeval $ do
+				l <- Trust.trustGet expected
 				r <- Remotes.byName "origin"
 				u <- UUID.getUUID r
-				return $ elem u uuids
-			assertEqual "trust value" expected istrusted
+				return $ elem u l
+			assertEqual ("trust value " ++ show expected) True present
 
 test_fsck :: Test
 test_fsck = "git-annex fsck" ~: intmpclonerepo $ do