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…
	
	Add table
		Add a link
		
	
		Reference in a new issue