implement 3 level trust storage in trust.log
This commit is contained in:
parent
f7e3d6eea2
commit
268cb35e64
9 changed files with 153 additions and 65 deletions
35
Command/Semitrust.hs
Normal file
35
Command/Semitrust.hs
Normal 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
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
86
Trust.hs
Normal 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
30
UUID.hs
|
@ -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
|
|
||||||
|
|
|
@ -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
27
test.hs
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue