Add --trust, --untrust, and --semitrust options.
This commit is contained in:
parent
7a3d9d8c2e
commit
a8fb97d2ce
12 changed files with 117 additions and 58 deletions
3
Annex.hs
3
Annex.hs
|
@ -24,6 +24,7 @@ import qualified GitQueue
|
||||||
import qualified BackendClass
|
import qualified BackendClass
|
||||||
import qualified RemoteClass
|
import qualified RemoteClass
|
||||||
import qualified CryptoTypes
|
import qualified CryptoTypes
|
||||||
|
import TrustLevel
|
||||||
|
|
||||||
-- git-annex's monad
|
-- git-annex's monad
|
||||||
type Annex = StateT AnnexState IO
|
type Annex = StateT AnnexState IO
|
||||||
|
@ -44,6 +45,7 @@ data AnnexState = AnnexState
|
||||||
, toremote :: Maybe String
|
, toremote :: Maybe String
|
||||||
, fromremote :: Maybe String
|
, fromremote :: Maybe String
|
||||||
, exclude :: [String]
|
, exclude :: [String]
|
||||||
|
, forcetrust :: [(String, TrustLevel)]
|
||||||
, cipher :: Maybe CryptoTypes.Cipher
|
, cipher :: Maybe CryptoTypes.Cipher
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -63,6 +65,7 @@ newState gitrepo allbackends = AnnexState
|
||||||
, toremote = Nothing
|
, toremote = Nothing
|
||||||
, fromremote = Nothing
|
, fromremote = Nothing
|
||||||
, exclude = []
|
, exclude = []
|
||||||
|
, forcetrust = []
|
||||||
, cipher = Nothing
|
, cipher = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -21,6 +21,7 @@ import Data.String.Utils
|
||||||
import BackendClass
|
import BackendClass
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified RemoteUtils
|
||||||
import qualified GitRepo as Git
|
import qualified GitRepo as Git
|
||||||
import Content
|
import Content
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
@ -53,7 +54,7 @@ dummyStore _ _ = return True
|
||||||
- and copy it to here. -}
|
- and copy it to here. -}
|
||||||
copyKeyFile :: Key -> FilePath -> Annex Bool
|
copyKeyFile :: Key -> FilePath -> Annex Bool
|
||||||
copyKeyFile key file = do
|
copyKeyFile key file = do
|
||||||
(remotes, _) <- Remote.keyPossibilities key
|
(remotes, _) <- RemoteUtils.keyPossibilities key
|
||||||
if null remotes
|
if null remotes
|
||||||
then do
|
then do
|
||||||
showNote "not available"
|
showNote "not available"
|
||||||
|
@ -96,7 +97,7 @@ checkRemoveKey key numcopiesM = do
|
||||||
if force || numcopiesM == Just 0
|
if force || numcopiesM == Just 0
|
||||||
then return True
|
then return True
|
||||||
else do
|
else do
|
||||||
(remotes, trusteduuids) <- Remote.keyPossibilities key
|
(remotes, trusteduuids) <- RemoteUtils.keyPossibilities key
|
||||||
untrusteduuids <- trustGet UnTrusted
|
untrusteduuids <- trustGet UnTrusted
|
||||||
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
|
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
|
||||||
numcopies <- getNumCopies numcopiesM
|
numcopies <- getNumCopies numcopiesM
|
||||||
|
|
|
@ -16,6 +16,7 @@ import LocationLog
|
||||||
import Types
|
import Types
|
||||||
import Content
|
import Content
|
||||||
import qualified Remote
|
import qualified Remote
|
||||||
|
import qualified RemoteUtils
|
||||||
import UUID
|
import UUID
|
||||||
import Messages
|
import Messages
|
||||||
|
|
||||||
|
@ -89,7 +90,7 @@ toPerform dest move key = do
|
||||||
let fastcheck = fast && not move && not (Remote.hasKeyCheap dest)
|
let fastcheck = fast && not move && not (Remote.hasKeyCheap dest)
|
||||||
isthere <- if fastcheck
|
isthere <- if fastcheck
|
||||||
then do
|
then do
|
||||||
(remotes, _) <- Remote.keyPossibilities key
|
(remotes, _) <- RemoteUtils.keyPossibilities key
|
||||||
return $ Right $ dest `elem` remotes
|
return $ Right $ dest `elem` remotes
|
||||||
else Remote.hasKey dest key
|
else Remote.hasKey dest key
|
||||||
case isthere of
|
case isthere of
|
||||||
|
@ -123,7 +124,7 @@ fromStart :: Remote.Remote Annex -> Bool -> CommandStartString
|
||||||
fromStart src move file = isAnnexed file $ \(key, _) -> do
|
fromStart src move file = isAnnexed file $ \(key, _) -> do
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
u <- getUUID g
|
u <- getUUID g
|
||||||
(remotes, _) <- Remote.keyPossibilities key
|
(remotes, _) <- RemoteUtils.keyPossibilities key
|
||||||
if (u == Remote.uuid src) || (null $ filter (== src) remotes)
|
if (u == Remote.uuid src) || (null $ filter (== src) remotes)
|
||||||
then stop
|
then stop
|
||||||
else do
|
else do
|
||||||
|
|
14
GitAnnex.hs
14
GitAnnex.hs
|
@ -14,6 +14,7 @@ import CmdLine
|
||||||
import Command
|
import Command
|
||||||
import Options
|
import Options
|
||||||
import Utility
|
import Utility
|
||||||
|
import TrustLevel
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
|
||||||
import qualified Command.Add
|
import qualified Command.Add
|
||||||
|
@ -83,7 +84,9 @@ cmds = concat
|
||||||
|
|
||||||
options :: [Option]
|
options :: [Option]
|
||||||
options = commonOptions ++
|
options = commonOptions ++
|
||||||
[ Option ['t'] ["to"] (ReqArg setto paramRemote)
|
[ Option ['k'] ["key"] (ReqArg setkey paramKey)
|
||||||
|
"specify a key to use"
|
||||||
|
, Option ['t'] ["to"] (ReqArg setto paramRemote)
|
||||||
"specify to where to transfer content"
|
"specify to where to transfer content"
|
||||||
, Option ['f'] ["from"] (ReqArg setfrom paramRemote)
|
, Option ['f'] ["from"] (ReqArg setfrom paramRemote)
|
||||||
"specify from where to transfer content"
|
"specify from where to transfer content"
|
||||||
|
@ -91,8 +94,12 @@ options = commonOptions ++
|
||||||
"skip files matching the glob pattern"
|
"skip files matching the glob pattern"
|
||||||
, Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
|
, Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
|
||||||
"override default number of copies"
|
"override default number of copies"
|
||||||
, Option ['k'] ["key"] (ReqArg setkey paramKey)
|
, Option [] ["trust"] (ReqArg (settrust Trusted) paramRemote)
|
||||||
"specify a key to use"
|
"override trust setting"
|
||||||
|
, Option [] ["semitrust"] (ReqArg (settrust SemiTrusted) paramRemote)
|
||||||
|
"override trust setting back to default value"
|
||||||
|
, Option [] ["untrust"] (ReqArg (settrust UnTrusted) paramRemote)
|
||||||
|
"override trust setting to untrusted"
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
|
setto v = Annex.changeState $ \s -> s { Annex.toremote = Just v }
|
||||||
|
@ -100,6 +107,7 @@ options = commonOptions ++
|
||||||
addexclude v = Annex.changeState $ \s -> s { Annex.exclude = v:(Annex.exclude s) }
|
addexclude v = Annex.changeState $ \s -> s { Annex.exclude = v:(Annex.exclude s) }
|
||||||
setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
|
setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe v }
|
||||||
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
|
setkey v = Annex.changeState $ \s -> s { Annex.defaultkey = Just v }
|
||||||
|
settrust t v = Annex.changeState $ \s -> s { Annex.forcetrust = (v, t):(Annex.forcetrust s) }
|
||||||
|
|
||||||
header :: String
|
header :: String
|
||||||
header = "Usage: git-annex command [option ..]"
|
header = "Usage: git-annex command [option ..]"
|
||||||
|
|
28
Remote.hs
28
Remote.hs
|
@ -16,9 +16,9 @@ module Remote (
|
||||||
hasKeyCheap,
|
hasKeyCheap,
|
||||||
|
|
||||||
remoteTypes,
|
remoteTypes,
|
||||||
|
genList,
|
||||||
byName,
|
byName,
|
||||||
nameToUUID,
|
nameToUUID,
|
||||||
keyPossibilities,
|
|
||||||
remotesWithUUID,
|
remotesWithUUID,
|
||||||
remotesWithoutUUID,
|
remotesWithoutUUID,
|
||||||
|
|
||||||
|
@ -42,8 +42,6 @@ import RemoteClass
|
||||||
import Types
|
import Types
|
||||||
import UUID
|
import UUID
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
import Trust
|
|
||||||
import LocationLog
|
|
||||||
import Locations
|
import Locations
|
||||||
import Utility
|
import Utility
|
||||||
import Config
|
import Config
|
||||||
|
@ -104,30 +102,6 @@ nameToUUID :: String -> Annex UUID
|
||||||
nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
|
nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
|
||||||
nameToUUID n = liftM uuid (byName n)
|
nameToUUID n = liftM uuid (byName n)
|
||||||
|
|
||||||
{- Cost ordered lists of remotes that the LocationLog indicate may have a key.
|
|
||||||
-
|
|
||||||
- Also returns a list of UUIDs that are trusted to have the key
|
|
||||||
- (some may not have configured remotes).
|
|
||||||
-}
|
|
||||||
keyPossibilities :: Key -> Annex ([Remote Annex], [UUID])
|
|
||||||
keyPossibilities key = do
|
|
||||||
g <- Annex.gitRepo
|
|
||||||
u <- getUUID g
|
|
||||||
trusted <- trustGet Trusted
|
|
||||||
|
|
||||||
-- get uuids of all remotes that are recorded to have the key
|
|
||||||
uuids <- liftIO $ keyLocations g key
|
|
||||||
let validuuids = filter (/= u) uuids
|
|
||||||
|
|
||||||
-- note that validuuids is assumed to not have dups
|
|
||||||
let validtrusteduuids = intersect validuuids trusted
|
|
||||||
|
|
||||||
-- remotes that match uuids that have the key
|
|
||||||
allremotes <- genList
|
|
||||||
let validremotes = remotesWithUUID allremotes validuuids
|
|
||||||
|
|
||||||
return (sort validremotes, validtrusteduuids)
|
|
||||||
|
|
||||||
{- Filters a list of remotes to ones that have the listed uuids. -}
|
{- Filters a list of remotes to ones that have the listed uuids. -}
|
||||||
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
|
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
|
||||||
remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
|
remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
|
||||||
|
|
42
RemoteUtils.hs
Normal file
42
RemoteUtils.hs
Normal file
|
@ -0,0 +1,42 @@
|
||||||
|
{- git-annex remotes overflow (can't go in there due to dependency cycles)
|
||||||
|
-
|
||||||
|
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module RemoteUtils where
|
||||||
|
|
||||||
|
import Control.Monad.State (liftIO)
|
||||||
|
import Data.List
|
||||||
|
|
||||||
|
import Annex
|
||||||
|
import Trust
|
||||||
|
import Remote
|
||||||
|
import UUID
|
||||||
|
import LocationLog
|
||||||
|
import Key
|
||||||
|
|
||||||
|
{- Cost ordered lists of remotes that the LocationLog indicate may have a key.
|
||||||
|
-
|
||||||
|
- Also returns a list of UUIDs that are trusted to have the key
|
||||||
|
- (some may not have configured remotes).
|
||||||
|
-}
|
||||||
|
keyPossibilities :: Key -> Annex ([Remote Annex], [UUID])
|
||||||
|
keyPossibilities key = do
|
||||||
|
g <- Annex.gitRepo
|
||||||
|
u <- getUUID g
|
||||||
|
trusted <- trustGet Trusted
|
||||||
|
|
||||||
|
-- get uuids of all remotes that are recorded to have the key
|
||||||
|
uuids <- liftIO $ keyLocations g key
|
||||||
|
let validuuids = filter (/= u) uuids
|
||||||
|
|
||||||
|
-- note that validuuids is assumed to not have dups
|
||||||
|
let validtrusteduuids = intersect validuuids trusted
|
||||||
|
|
||||||
|
-- remotes that match uuids that have the key
|
||||||
|
allremotes <- genList
|
||||||
|
let validremotes = remotesWithUUID allremotes validuuids
|
||||||
|
|
||||||
|
return (sort validremotes, validtrusteduuids)
|
30
Trust.hs
30
Trust.hs
|
@ -1,4 +1,4 @@
|
||||||
{- git-annex trust levels
|
{- git-annex trust
|
||||||
-
|
-
|
||||||
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||||||
-
|
-
|
||||||
|
@ -17,26 +17,15 @@ module Trust (
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
|
||||||
|
import TrustLevel
|
||||||
import qualified GitRepo as Git
|
import qualified GitRepo as Git
|
||||||
import Types
|
import Types
|
||||||
import UUID
|
import UUID
|
||||||
import Locations
|
import Locations
|
||||||
import qualified Annex
|
import qualified Annex
|
||||||
|
import qualified Remote
|
||||||
import Utility
|
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. -}
|
{- Filename of trust.log. -}
|
||||||
trustLog :: Annex FilePath
|
trustLog :: Annex FilePath
|
||||||
trustLog = do
|
trustLog = do
|
||||||
|
@ -49,18 +38,23 @@ trustGet level = do
|
||||||
m <- trustMap
|
m <- trustMap
|
||||||
return $ M.keys $ M.filter (== level) m
|
return $ M.keys $ M.filter (== level) m
|
||||||
|
|
||||||
{- Read the trustLog into a map. -}
|
{- Read the trustLog into a map, overriding with any
|
||||||
|
- values from forcetrust -}
|
||||||
trustMap :: Annex (M.Map UUID TrustLevel)
|
trustMap :: Annex (M.Map UUID TrustLevel)
|
||||||
trustMap = do
|
trustMap = do
|
||||||
logfile <- trustLog
|
logfile <- trustLog
|
||||||
|
overrides <- Annex.getState Annex.forcetrust >>= mapM findoverride
|
||||||
s <- liftIO $ catch (readFile logfile) ignoreerror
|
s <- liftIO $ catch (readFile logfile) ignoreerror
|
||||||
return $ trustMapParse s
|
return $ M.fromList $ trustMapParse s ++ overrides
|
||||||
where
|
where
|
||||||
ignoreerror _ = return ""
|
ignoreerror _ = return ""
|
||||||
|
findoverride (name, t) = do
|
||||||
|
uuid <- Remote.nameToUUID name
|
||||||
|
return (uuid, t)
|
||||||
|
|
||||||
{- Trust map parser. -}
|
{- Trust map parser. -}
|
||||||
trustMapParse :: String -> M.Map UUID TrustLevel
|
trustMapParse :: String -> [(UUID, TrustLevel)]
|
||||||
trustMapParse s = M.fromList $ map pair $ filter (not . null) $ lines s
|
trustMapParse s = map pair $ filter (not . null) $ lines s
|
||||||
where
|
where
|
||||||
pair l
|
pair l
|
||||||
| length w > 1 = (w !! 0, read (w !! 1) :: TrustLevel)
|
| length w > 1 = (w !! 0, read (w !! 1) :: TrustLevel)
|
||||||
|
|
23
TrustLevel.hs
Normal file
23
TrustLevel.hs
Normal file
|
@ -0,0 +1,23 @@
|
||||||
|
{- git-annex trust levels
|
||||||
|
-
|
||||||
|
- Copyright 2010 Joey Hess <joey@kitenet.net>
|
||||||
|
-
|
||||||
|
- Licensed under the GNU GPL version 3 or higher.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module TrustLevel (
|
||||||
|
TrustLevel(..),
|
||||||
|
) where
|
||||||
|
|
||||||
|
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, "")]
|
1
debian/changelog
vendored
1
debian/changelog
vendored
|
@ -1,6 +1,7 @@
|
||||||
git-annex (0.20110602) UNRELEASED; urgency=low
|
git-annex (0.20110602) UNRELEASED; urgency=low
|
||||||
|
|
||||||
* Add --numcopies option.
|
* Add --numcopies option.
|
||||||
|
* Add --trust, --untrust, and --semitrust options.
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Wed, 01 Jun 2011 16:26:48 -0400
|
-- Joey Hess <joeyh@debian.org> Wed, 01 Jun 2011 16:26:48 -0400
|
||||||
|
|
||||||
|
|
|
@ -5,13 +5,14 @@ Here are a few I've been considering:
|
||||||
---
|
---
|
||||||
|
|
||||||
* --numcopies would be a useful command line switch.
|
* --numcopies would be a useful command line switch.
|
||||||
> Update: Added. Also allows for things like `git annex drop
|
> Update: Added. Also allows for things like `git annex drop --numcopies=2` when in a repo that normally needs 3 copies, if you need
|
||||||
> --numcopies=2` when in a repo that normally needs 3 copies, if you need
|
|
||||||
> to urgently free up space.
|
> to urgently free up space.
|
||||||
* A way to make `drop` and other commands temporarily trust a given remote, or possibly all remotes.
|
* A way to make `drop` and other commands temporarily trust a given remote, or possibly all remotes.
|
||||||
|
|
||||||
Combined, this would allow `git annex drop --numcopies=2 --trust=repoa --trust=repob` to remove files that have been replicated out to the other 2 repositories, which could be offline. (Slightly unsafe, but in this case the files are podcasts so not really.)
|
Combined, this would allow `git annex drop --numcopies=2 --trust=repoa --trust=repob` to remove files that have been replicated out to the other 2 repositories, which could be offline. (Slightly unsafe, but in this case the files are podcasts so not really.)
|
||||||
|
|
||||||
|
> Update: done --[[Joey]]
|
||||||
|
|
||||||
---
|
---
|
||||||
|
|
||||||
[[wishlist:_git-annex_replicate]] suggests some way for git-annex to have the smarts to copy content around on its own to ensure numcopies is satisfied. I'd be satisfied with a `git annex copy --to foo --if-needed-by-numcopies`
|
[[wishlist:_git-annex_replicate]] suggests some way for git-annex to have the smarts to copy content around on its own to ensure numcopies is satisfied. I'd be satisfied with a `git annex copy --to foo --if-needed-by-numcopies`
|
||||||
|
|
|
@ -359,6 +359,14 @@ Many git-annex commands will stage changes for later `git commit` by you.
|
||||||
Overrides the `annex.numcopies` setting, forcing git-annex to ensure the
|
Overrides the `annex.numcopies` setting, forcing git-annex to ensure the
|
||||||
specified number of copies exist.
|
specified number of copies exist.
|
||||||
|
|
||||||
|
* --trust=repository
|
||||||
|
* --semitrust=repository
|
||||||
|
* --untrust=repository
|
||||||
|
|
||||||
|
Overrides trust settings for a repository. May be specified more than once.
|
||||||
|
|
||||||
|
The repository should be specified using the name of a configured remote.
|
||||||
|
|
||||||
* --backend=name
|
* --backend=name
|
||||||
|
|
||||||
Specifies which key-value backend to use. This can be used when
|
Specifies which key-value backend to use. This can be used when
|
||||||
|
|
|
@ -20,7 +20,9 @@ depended on to retain a copy of the file content; possibly the only
|
||||||
[[copy|copies]].
|
[[copy|copies]].
|
||||||
|
|
||||||
(Being semitrusted is the default. The `git annex semitrust` command
|
(Being semitrusted is the default. The `git annex semitrust` command
|
||||||
restores a repository to this default, when it has been overridden.)
|
restores a repository to this default, when it has been overridden.
|
||||||
|
The `--semitrust` option can temporarily restore a repository to this
|
||||||
|
default.)
|
||||||
|
|
||||||
## untrusted
|
## untrusted
|
||||||
|
|
||||||
|
@ -42,7 +44,8 @@ archival drive, from which you rarely or never remove content. Deciding
|
||||||
when it makes sense to trust the tracking info is up to you.
|
when it makes sense to trust the tracking info is up to you.
|
||||||
|
|
||||||
One way to handle this is just to use `--force` when a command cannot
|
One way to handle this is just to use `--force` when a command cannot
|
||||||
access a remote you trust.
|
access a remote you trust. Or to use `--trust` to specify a repisitory to
|
||||||
|
trust temporarily.
|
||||||
|
|
||||||
To configure a repository as fully trusted, use the `git annex trust`
|
To configure a repository as fully and permanently trusted,
|
||||||
command.
|
use the `git annex trust` command.
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue