implement 3 level trust storage in trust.log

This commit is contained in:
Joey Hess 2011-01-26 15:37:16 -04:00
parent f7e3d6eea2
commit 268cb35e64
9 changed files with 153 additions and 65 deletions

35
Command/Semitrust.hs Normal file
View file

@ -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

View file

@ -7,13 +7,10 @@
module Command.Trust where module Command.Trust where
import Control.Monad.State (liftIO)
import Control.Monad (unless)
import Command import Command
import qualified Annex
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Remotes import qualified Remotes
import Trust
import UUID import UUID
import Messages import Messages
@ -34,11 +31,5 @@ start name = do
perform :: Git.Repo -> CommandPerform perform :: Git.Repo -> CommandPerform
perform repo = do perform repo = do
uuid <- getUUID repo uuid <- getUUID repo
trusted <- getTrusted trustSet uuid Trusted
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]
return $ Just $ return True return $ Just $ return True

View file

@ -7,14 +7,11 @@
module Command.Untrust where module Command.Untrust where
import Control.Monad.State (liftIO)
import Control.Monad (when)
import Command import Command
import qualified Annex
import qualified GitRepo as Git import qualified GitRepo as Git
import qualified Remotes import qualified Remotes
import UUID import UUID
import Trust
import Messages import Messages
command :: [Command] command :: [Command]
@ -34,11 +31,5 @@ start name = do
perform :: Git.Repo -> CommandPerform perform :: Git.Repo -> CommandPerform
perform repo = do perform repo = do
uuid <- getUUID repo uuid <- getUUID repo
trusted <- getTrusted trustSet uuid UnTrusted
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]
return $ Just $ return True return $ Just $ return True

View file

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

View file

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

86
Trust.hs Normal file
View file

@ -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

30
UUID.hs
View file

@ -17,10 +17,7 @@ module UUID (
reposWithoutUUID, reposWithoutUUID,
prettyPrintUUIDs, prettyPrintUUIDs,
describeUUID, describeUUID,
uuidLog, uuidLog
trustLog,
getTrusted,
setTrusted
) where ) where
import Control.Monad.State import Control.Monad.State
@ -141,28 +138,3 @@ uuidLog :: Annex FilePath
uuidLog = do uuidLog = do
g <- Annex.gitRepo g <- Annex.gitRepo
return $ gitStateDir g ++ "uuid.log" 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

View file

@ -188,9 +188,13 @@ Many git-annex commands will stage changes for later `git commit` by you.
* untrust [repository ...] * 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. at any time.
* semitrust [repository ...]
Returns a repository to the default [[semi trusted|trust]] state.
* fromkey file * fromkey file
This can be used to maually set up a file to link to a specified key 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 `.git-annex/uuid.log` is used to map between repository UUID and
decscriptions. 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 `.git-annex/*.log` is where git-annex records its content tracking
information. These files should be committed to git. information. These files should be committed to git.

27
test.hs
View file

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