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 RemoteClass
|
||||
import qualified CryptoTypes
|
||||
import TrustLevel
|
||||
|
||||
-- git-annex's monad
|
||||
type Annex = StateT AnnexState IO
|
||||
|
@ -44,6 +45,7 @@ data AnnexState = AnnexState
|
|||
, toremote :: Maybe String
|
||||
, fromremote :: Maybe String
|
||||
, exclude :: [String]
|
||||
, forcetrust :: [(String, TrustLevel)]
|
||||
, cipher :: Maybe CryptoTypes.Cipher
|
||||
}
|
||||
|
||||
|
@ -63,6 +65,7 @@ newState gitrepo allbackends = AnnexState
|
|||
, toremote = Nothing
|
||||
, fromremote = Nothing
|
||||
, exclude = []
|
||||
, forcetrust = []
|
||||
, cipher = Nothing
|
||||
}
|
||||
|
||||
|
|
|
@ -21,6 +21,7 @@ import Data.String.Utils
|
|||
import BackendClass
|
||||
import LocationLog
|
||||
import qualified Remote
|
||||
import qualified RemoteUtils
|
||||
import qualified GitRepo as Git
|
||||
import Content
|
||||
import qualified Annex
|
||||
|
@ -53,7 +54,7 @@ dummyStore _ _ = return True
|
|||
- and copy it to here. -}
|
||||
copyKeyFile :: Key -> FilePath -> Annex Bool
|
||||
copyKeyFile key file = do
|
||||
(remotes, _) <- Remote.keyPossibilities key
|
||||
(remotes, _) <- RemoteUtils.keyPossibilities key
|
||||
if null remotes
|
||||
then do
|
||||
showNote "not available"
|
||||
|
@ -96,7 +97,7 @@ checkRemoveKey key numcopiesM = do
|
|||
if force || numcopiesM == Just 0
|
||||
then return True
|
||||
else do
|
||||
(remotes, trusteduuids) <- Remote.keyPossibilities key
|
||||
(remotes, trusteduuids) <- RemoteUtils.keyPossibilities key
|
||||
untrusteduuids <- trustGet UnTrusted
|
||||
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
|
||||
numcopies <- getNumCopies numcopiesM
|
||||
|
|
|
@ -16,6 +16,7 @@ import LocationLog
|
|||
import Types
|
||||
import Content
|
||||
import qualified Remote
|
||||
import qualified RemoteUtils
|
||||
import UUID
|
||||
import Messages
|
||||
|
||||
|
@ -89,7 +90,7 @@ toPerform dest move key = do
|
|||
let fastcheck = fast && not move && not (Remote.hasKeyCheap dest)
|
||||
isthere <- if fastcheck
|
||||
then do
|
||||
(remotes, _) <- Remote.keyPossibilities key
|
||||
(remotes, _) <- RemoteUtils.keyPossibilities key
|
||||
return $ Right $ dest `elem` remotes
|
||||
else Remote.hasKey dest key
|
||||
case isthere of
|
||||
|
@ -123,7 +124,7 @@ fromStart :: Remote.Remote Annex -> Bool -> CommandStartString
|
|||
fromStart src move file = isAnnexed file $ \(key, _) -> do
|
||||
g <- Annex.gitRepo
|
||||
u <- getUUID g
|
||||
(remotes, _) <- Remote.keyPossibilities key
|
||||
(remotes, _) <- RemoteUtils.keyPossibilities key
|
||||
if (u == Remote.uuid src) || (null $ filter (== src) remotes)
|
||||
then stop
|
||||
else do
|
||||
|
|
14
GitAnnex.hs
14
GitAnnex.hs
|
@ -14,6 +14,7 @@ import CmdLine
|
|||
import Command
|
||||
import Options
|
||||
import Utility
|
||||
import TrustLevel
|
||||
import qualified Annex
|
||||
|
||||
import qualified Command.Add
|
||||
|
@ -83,7 +84,9 @@ cmds = concat
|
|||
|
||||
options :: [Option]
|
||||
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"
|
||||
, Option ['f'] ["from"] (ReqArg setfrom paramRemote)
|
||||
"specify from where to transfer content"
|
||||
|
@ -91,8 +94,12 @@ options = commonOptions ++
|
|||
"skip files matching the glob pattern"
|
||||
, Option ['N'] ["numcopies"] (ReqArg setnumcopies paramNumber)
|
||||
"override default number of copies"
|
||||
, Option ['k'] ["key"] (ReqArg setkey paramKey)
|
||||
"specify a key to use"
|
||||
, Option [] ["trust"] (ReqArg (settrust Trusted) paramRemote)
|
||||
"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
|
||||
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) }
|
||||
setnumcopies v = Annex.changeState $ \s -> s {Annex.forcenumcopies = readMaybe 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 = "Usage: git-annex command [option ..]"
|
||||
|
|
28
Remote.hs
28
Remote.hs
|
@ -16,9 +16,9 @@ module Remote (
|
|||
hasKeyCheap,
|
||||
|
||||
remoteTypes,
|
||||
genList,
|
||||
byName,
|
||||
nameToUUID,
|
||||
keyPossibilities,
|
||||
remotesWithUUID,
|
||||
remotesWithoutUUID,
|
||||
|
||||
|
@ -42,8 +42,6 @@ import RemoteClass
|
|||
import Types
|
||||
import UUID
|
||||
import qualified Annex
|
||||
import Trust
|
||||
import LocationLog
|
||||
import Locations
|
||||
import Utility
|
||||
import Config
|
||||
|
@ -104,30 +102,6 @@ nameToUUID :: String -> Annex UUID
|
|||
nameToUUID "." = getUUID =<< Annex.gitRepo -- special case for current repo
|
||||
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. -}
|
||||
remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
|
||||
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>
|
||||
-
|
||||
|
@ -17,26 +17,15 @@ module Trust (
|
|||
import Control.Monad.State
|
||||
import qualified Data.Map as M
|
||||
|
||||
import TrustLevel
|
||||
import qualified GitRepo as Git
|
||||
import Types
|
||||
import UUID
|
||||
import Locations
|
||||
import qualified Annex
|
||||
import qualified Remote
|
||||
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
|
||||
|
@ -49,18 +38,23 @@ trustGet level = do
|
|||
m <- trustMap
|
||||
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 = do
|
||||
logfile <- trustLog
|
||||
overrides <- Annex.getState Annex.forcetrust >>= mapM findoverride
|
||||
s <- liftIO $ catch (readFile logfile) ignoreerror
|
||||
return $ trustMapParse s
|
||||
return $ M.fromList $ trustMapParse s ++ overrides
|
||||
where
|
||||
ignoreerror _ = return ""
|
||||
findoverride (name, t) = do
|
||||
uuid <- Remote.nameToUUID name
|
||||
return (uuid, t)
|
||||
|
||||
{- Trust map parser. -}
|
||||
trustMapParse :: String -> M.Map UUID TrustLevel
|
||||
trustMapParse s = M.fromList $ map pair $ filter (not . null) $ lines s
|
||||
trustMapParse :: String -> [(UUID, TrustLevel)]
|
||||
trustMapParse s = map pair $ filter (not . null) $ lines s
|
||||
where
|
||||
pair l
|
||||
| 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
|
||||
|
||||
* Add --numcopies option.
|
||||
* Add --trust, --untrust, and --semitrust options.
|
||||
|
||||
-- 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.
|
||||
> Update: Added. Also allows for things like `git annex drop
|
||||
> --numcopies=2` when in a repo that normally needs 3 copies, if you need
|
||||
> Update: Added. Also allows for things like `git annex drop --numcopies=2` when in a repo that normally needs 3 copies, if you need
|
||||
> to urgently free up space.
|
||||
* 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.)
|
||||
|
||||
> 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`
|
||||
|
|
|
@ -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
|
||||
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
|
||||
|
||||
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]].
|
||||
|
||||
(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
|
||||
|
||||
|
@ -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.
|
||||
|
||||
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`
|
||||
command.
|
||||
To configure a repository as fully and permanently trusted,
|
||||
use the `git annex trust` command.
|
||||
|
|
Loading…
Reference in a new issue