trust setting improvements

Command/Semitrust.hs

@@ -21,11 +21,11 @@ command = [Command "semitrust" (paramRepeating paramRemote) seek
 seek :: [CommandSeek]
 seek = [withString start]
 
-{- Marks a remote as not trusted. -}
 start :: CommandStartString
 start name = do
+	showStart "semitrust" name
+	Remotes.readConfigs
 	r <- Remotes.byName name
-	showStart "untrust" name
 	return $ Just $ perform r
 
 perform :: Git.Repo -> CommandPerform

Command/Trust.hs

@@ -21,11 +21,11 @@ command = [Command "trust" (paramRepeating paramRemote) seek
 seek :: [CommandSeek]
 seek = [withString start]
 
-{- Marks a remote as trusted. -}
 start :: CommandStartString
 start name = do
-	r <- Remotes.byName name
 	showStart "trust" name
+	Remotes.readConfigs
+	r <- Remotes.byName name
 	return $ Just $ perform r
 
 perform :: Git.Repo -> CommandPerform

Command/Untrust.hs

@@ -21,11 +21,11 @@ command = [Command "untrust" (paramRepeating paramRemote) seek
 seek :: [CommandSeek]
 seek = [withString start]
 
-{- Marks a remote as not trusted. -}
 start :: CommandStartString
 start name = do
-	r <- Remotes.byName name
 	showStart "untrust" name
+	Remotes.readConfigs
+	r <- Remotes.byName name
 	return $ Just $ perform r
 
 perform :: Git.Repo -> CommandPerform

Remotes.hs

@@ -222,6 +222,7 @@ same a b = Git.repoRemoteName a == Git.repoRemoteName b
 
 {- Looks up a remote by name. -}
 byName :: String -> Annex Git.Repo
+byName "." = Annex.gitRepo -- special case to refer to current repository
 byName name = do
 	when (null name) $ error "no remote specified"
 	g <- Annex.gitRepo

Trust.hs

@@ -73,6 +73,8 @@ trustMapParse s = M.fromList $ map pair $ filter (not . null) $ lines s
 {- Changes the trust level for a uuid in the trustLog, and commits it. -}
 trustSet :: UUID -> TrustLevel -> Annex ()
 trustSet uuid level = do
+	when (null uuid) $
+		error "unknown UUID; cannot modify trust level"
         m <- trustMap
 	when (M.lookup uuid m /= Just level) $ do
 		let m' = M.insert uuid level m

debian/changelog

@@ -5,6 +5,7 @@ git-annex (0.19) UNRELEASED; urgency=low
   * There are now three levels of repository trust.
   * untrust: Now marks the current repository as untrusted.
   * semitrust: Now restores the default trust level. (What untrust used to do.)
+  * fsck: Warn if content is only in untrusted repositories.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 19 Jan 2011 18:07:51 -0400
 

doc/git-annex.mdwn

@@ -186,6 +186,8 @@ Many git-annex commands will stage changes for later `git commit` by you.
   Records that a repository is [[trusted|trust]] to not unexpectedly lose
   content. Use with care.
 
+  To trust the current repository, use "."
+
 * untrust [repository ...]
 
   Records that a repository is [[not trusted|trust]] and could lose content

test.hs

@@ -42,7 +42,7 @@ import qualified Command.DropUnused
 main :: IO ()
 main = do
 	prepare
-	r <- runVerboseTests $ TestList [quickchecks, toplevels]
+	r <- runVerboseTests $ TestList [quickcheck, blackbox]
 	cleanup tmpdir
 	propigate r
 
@@ -51,8 +51,8 @@ propigate (Counts { errors = e }, _)
 	| e > 0 = error "failed"
 	| otherwise = return ()
 
-quickchecks :: Test
+quickcheck :: Test
-quickchecks = TestLabel "quickchecks" $ TestList
+quickcheck = TestLabel "quickcheck" $ TestList
 	[ qctest "prop_idempotent_deencode" Git.prop_idempotent_deencode
 	, qctest "prop_idempotent_fileKey" Locations.prop_idempotent_fileKey
 	, qctest "prop_idempotent_key_read_show" BackendTypes.prop_idempotent_key_read_show
@@ -62,8 +62,8 @@ quickchecks = TestLabel "quickchecks" $ TestList
 	, qctest "prop_relPathDirToDir_basics" Utility.prop_relPathDirToDir_basics
 	]
 
-toplevels :: Test
+blackbox :: Test
-toplevels = TestLabel "toplevel" $ TestList
+blackbox = TestLabel "blackbox" $ TestList
 	-- test order matters, later tests may rely on state from earlier
 	[ test_init
 	, test_add
@@ -290,30 +290,33 @@ test_fix = "git-annex fix" ~: intmpclonerepo $ do
 
 test_trust :: Test
 test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do
-	trustcheck Trust.SemiTrusted
+	git_annex "trust" ["-q", repo] @? "trust failed"
-	git_annex "trust" ["-q", "origin"] @? "trust failed"
+	trustcheck Trust.Trusted "trusted 1"
-	trustcheck Trust.Trusted
+	git_annex "trust" ["-q", repo] @? "trust of trusted failed"
-	git_annex "trust" ["-q", "origin"] @? "trust of trusted failed"
+	trustcheck Trust.Trusted "trusted 2"
-	trustcheck Trust.Trusted
+	git_annex "untrust" ["-q", repo] @? "untrust failed"
-	git_annex "untrust" ["-q", "origin"] @? "untrust failed"
+	trustcheck Trust.UnTrusted "untrusted 1"
-	trustcheck Trust.UnTrusted
+	git_annex "untrust" ["-q", repo] @? "untrust of untrusted failed"
-	git_annex "untrust" ["-q", "origin"] @? "untrust of untrusted failed"
+	trustcheck Trust.UnTrusted "untrusted 2"
-	trustcheck Trust.UnTrusted
+	git_annex "semitrust" ["-q", repo] @? "semitrust failed"
-	git_annex "semitrust" ["-q", "origin"] @? "semitrust failed"
+	trustcheck Trust.SemiTrusted "semitrusted 1"
-	trustcheck Trust.SemiTrusted
+	git_annex "semitrust" ["-q", repo] @? "semitrust of semitrusted failed"
-	git_annex "semitrust" ["-q", "origin"] @? "semitrust of semitrusted failed"
+	trustcheck Trust.SemiTrusted "semitrusted 2"
-	trustcheck Trust.SemiTrusted
 	where
-		trustcheck expected = do
+		trustcheck expected msg = do
 			present <- annexeval $ do
+				Remotes.readConfigs
 				l <- Trust.trustGet expected
-				r <- Remotes.byName "origin"
+				r <- Remotes.byName repo
 				u <- UUID.getUUID r
 				return $ elem u l
-			assertEqual ("trust value " ++ show expected) True present
+			assertBool msg present
+		repo = "origin"
 
 test_fsck :: Test
-test_fsck = "git-annex fsck" ~: intmpclonerepo $ do
+test_fsck = "git-annex fsck" ~: TestList [basicfsck, withlocaluntrusted]
+	where
+		basicfsck = TestCase $ intmpclonerepo $ do
 			git_annex "fsck" ["-q"] @? "fsck failed"
 			Utility.boolSystem "git" ["config", "annex.numcopies", "2"] @? "git config failed"
 			r <- git_annex "fsck" ["-q"]
@@ -321,7 +324,10 @@ test_fsck = "git-annex fsck" ~: intmpclonerepo $ do
 			Utility.boolSystem "git" ["config", "annex.numcopies", "1"] @? "git config failed"
 			corrupt annexedfile
 			corrupt sha1annexedfile
-	where
+		withlocaluntrusted = TestCase $ intmpcopyrepo $ do
+			git_annex "untrust" ["-q", "."] @? "untrust of current repo failed"
+			r <- git_annex "fsck" ["-q"]
+			not r @? "fsck failed to fail with content only available in untrusted (current) repository"
 		corrupt f = do
 			git_annex "get" ["-q", f] @? "get of file failed"
 			Content.allowWrite f