packages feed

git-annex 5.20140210 → 5.20140221

raw patch · 164 files changed

+3747/−586 lines, 164 filesbinary-added

Files

Annex.hs view
@@ -58,6 +58,7 @@ import Types.FileMatcher import Types.NumCopies import Types.LockPool+import Types.MetaData import qualified Utility.Matcher import qualified Data.Map as M import qualified Data.Set as S@@ -109,6 +110,7 @@ 	, lockpool :: LockPool 	, flags :: M.Map String Bool 	, fields :: M.Map String String+	, modmeta :: [ModMeta] 	, cleanup :: M.Map String (Annex ()) 	, inodeschanged :: Maybe Bool 	, useragent :: Maybe String@@ -146,6 +148,7 @@ 	, lockpool = M.empty 	, flags = M.empty 	, fields = M.empty+	, modmeta = [] 	, cleanup = M.empty 	, inodeschanged = Nothing 	, useragent = Nothing
Annex/Branch.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}- module Annex.Branch ( 	fullname, 	name,@@ -30,11 +28,11 @@ import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Set as S import qualified Data.Map as M-import qualified Control.Exception as E  import Common.Annex import Annex.BranchState import Annex.Journal+import Annex.Index import qualified Git import qualified Git.Command import qualified Git.Ref@@ -47,15 +45,12 @@ import Git.FilePath import Annex.CatFile import Annex.Perms-import qualified Annex-import Utility.Env import Logs import Logs.Transitions import Logs.Trust.Pure import Annex.ReplaceFile import qualified Annex.Queue import Annex.Branch.Transitions-import Annex.Exception  {- Name of the branch that is used to store git-annex's information. -} name :: Git.Ref@@ -63,11 +58,11 @@  {- Fully qualified name of the branch. -} fullname :: Git.Ref-fullname = Git.Ref $ "refs/heads/" ++ show name+fullname = Git.Ref $ "refs/heads/" ++ fromRef name  {- Branch's name in origin. -} originname :: Git.Ref-originname = Git.Ref $ "origin/" ++ show name+originname = Git.Ref $ "origin/" ++ fromRef name  {- Does origin/git-annex exist? -} hasOrigin :: Annex Bool@@ -92,8 +87,8 @@   where 	go True = do 		inRepo $ Git.Command.run-			[Param "branch", Param $ show name, Param $ show originname]-		fromMaybe (error $ "failed to create " ++ show name)+			[Param "branch", Param $ fromRef name, Param $ fromRef originname]+		fromMaybe (error $ "failed to create " ++ fromRef name) 			<$> branchsha 	go False = withIndex' True $ 		inRepo $ Git.Branch.commitAlways "branch created" fullname []@@ -159,7 +154,7 @@ 			then "update" 			else "merging " ++ 				unwords (map Git.Ref.describe branches) ++ -				" into " ++ show name+				" into " ++ fromRef name 		localtransitions <- parseTransitionsStrictly "local" 			<$> getLocal transitionsLog 		unless (null branches) $ do@@ -296,7 +291,7 @@ branchFiles :: Annex [FilePath] branchFiles = withIndex $ inRepo $ Git.Command.pipeNullSplitZombie 	[ Params "ls-tree --name-only -r -z"-	, Param $ show fullname+	, Param $ fromRef fullname 	]  {- Populates the branch's index file with the current branch contents.@@ -338,32 +333,12 @@ withIndex' :: Bool -> Annex a -> Annex a withIndex' bootstrapping a = do 	f <- fromRepo gitAnnexIndex-	g <- gitRepo-#ifdef __ANDROID__-	{- This should not be necessary on Android, but there is some-	 - weird getEnvironment breakage. See-	 - https://github.com/neurocyte/ghc-android/issues/7-	 - Use getEnv to get some key environment variables that-	 - git expects to have. -}-	let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"-	let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k-	e <- liftIO $ catMaybes <$> forM keyenv getEnvPair-	let e' = ("GIT_INDEX_FILE", f):e-#else-	e <- liftIO getEnvironment-	let e' = addEntry "GIT_INDEX_FILE" f e-#endif-	let g' = g { gitEnv = Just e' }--	r <- tryAnnex $ do-		Annex.changeState $ \s -> s { Annex.repo = g' }+	withIndexFile f $ do 		checkIndexOnce $ unlessM (liftIO $ doesFileExist f) $ do 			unless bootstrapping create 			createAnnexDirectory $ takeDirectory f 			unless bootstrapping $ inRepo genIndex 		a-	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }-	either E.throw return r  {- Updates the branch's index to reflect the current contents of the branch.  - Any changes staged in the index will be preserved.@@ -393,7 +368,7 @@ setIndexSha :: Git.Ref -> Annex () setIndexSha ref = do 	f <- fromRepo gitAnnexIndexStatus-	liftIO $ writeFile f $ show ref ++ "\n"+	liftIO $ writeFile f $ fromRef ref ++ "\n" 	setAnnexFilePerm f  {- Stages the journal into the index and returns an action that will@@ -467,7 +442,7 @@ 	let s = S.unions [old, S.fromList rs] 	f <- fromRepo gitAnnexIgnoredRefs 	replaceFile f $ \tmp -> liftIO $ writeFile tmp $-		unlines $ map show $ S.elems s+		unlines $ map fromRef $ S.elems s  getIgnoredRefs :: Annex (S.Set Git.Ref) getIgnoredRefs = S.fromList . mapMaybe Git.Sha.extractSha . lines <$> content
Annex/Branch/Transitions.hs view
@@ -41,7 +41,7 @@ 		in if null newlog 			then RemoveFile 			else ChangeFile $ Presence.showLog newlog-	Just SingleValueLog -> PreserveFile+	Just OtherLog -> PreserveFile 	Nothing -> PreserveFile  dropDeadFromUUIDBasedLog :: TrustMap -> UUIDBased.Log String -> UUIDBased.Log String
Annex/Content.hs view
@@ -243,10 +243,9 @@ 			moveAnnex key tmpfile 			logStatus key InfoPresent 			return True-		, do-			-- the tmp file is left behind, in case caller wants-			-- to resume its transfer-			return False+		-- the tmp file is left behind, in case caller wants+		-- to resume its transfer+		, return False 		)  prepTmp :: Key -> Annex FilePath@@ -492,9 +491,11 @@  	{- In indirect mode, look for the key. In direct mode, 	 - the inode cache file is only present when a key's content-	 - is present. -}+	 - is present, so can be used as a surrogate if the content+	 - is not located in the annex directory. -} 	present False d = doesFileExist $ contentfile d-	present True d = doesFileExist $ contentfile d ++ ".cache"+	present True d = doesFileExist (contentfile d ++ ".cache")+		<||> present False d 	contentfile d = d </> takeFileName d  {- Things to do to record changes to content when shutting down.
Annex/Content/Direct.hs view
@@ -66,7 +66,7 @@ 	mapping <- calcRepo $ gitAnnexMapping key 	files <- associatedFilesRelative key 	let files' = transform files-	when (files /= files') $ do+	when (files /= files') $ 		modifyContent mapping $ 			liftIO $ viaTmp writeFileAnyEncoding mapping $ 				unlines files'
Annex/Direct.hs view
@@ -184,7 +184,7 @@ 			tryAnnex . maybe (araw f item) (\k -> void $ a k f) 				=<< catKey (getsha item) (getmode item) -	moveout k f = removeDirect k f+	moveout = removeDirect  	{- Files deleted by the merge are removed from the work tree. 	 - Empty work tree directories are removed, per git behavior. -}@@ -286,18 +286,18 @@  - this way things that show HEAD (eg shell prompts) will  - hopefully show just "master". -} directBranch :: Ref -> Ref-directBranch orighead = case split "/" $ show orighead of+directBranch orighead = case split "/" $ fromRef orighead of 	("refs":"heads":"annex":"direct":_) -> orighead 	("refs":"heads":rest) -> 		Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest-	_ -> Ref $ "refs/heads/" ++ show (Git.Ref.base orighead)+	_ -> Ref $ "refs/heads/" ++ fromRef (Git.Ref.base orighead)  {- Converts a directBranch back to the original branch.  -  - Any other ref is left unchanged.  -} fromDirectBranch :: Ref -> Ref-fromDirectBranch directhead = case split "/" $ show directhead of+fromDirectBranch directhead = case split "/" $ fromRef directhead of 	("refs":"heads":"annex":"direct":rest) ->  		Ref $ "refs/heads/" ++ intercalate "/" rest 	_ -> directhead
Annex/FileMatcher.hs view
@@ -43,7 +43,7 @@ fileMatchInfo :: FilePath -> Annex MatchInfo fileMatchInfo file = do 	matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)-	return $ MatchingFile $ FileInfo+	return $ MatchingFile FileInfo 		{ matchFile = matchfile 		, relFile = file 		}@@ -83,6 +83,7 @@ 			, ("inbackend", limitInBackend) 			, ("largerthan", limitSize (>)) 			, ("smallerthan", limitSize (<))+			, ("metadata", limitMetaData) 			, ("inallgroup", limitInAllGroup groupmap) 			]   where
+ Annex/Index.hs view
@@ -0,0 +1,46 @@+{- Using other git index files+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Annex.Index (+	withIndexFile,+) where++import qualified Control.Exception as E++import Common.Annex+import Git.Types+import qualified Annex+import Utility.Env+import Annex.Exception++{- Runs an action using a different git index file. -}+withIndexFile :: FilePath -> Annex a -> Annex a+withIndexFile f a = do+	g <- gitRepo+#ifdef __ANDROID__+	{- This should not be necessary on Android, but there is some+	 - weird getEnvironment breakage. See+	 - https://github.com/neurocyte/ghc-android/issues/7+	 - Use getEnv to get some key environment variables that+	 - git expects to have. -}+	let keyenv = words "USER PATH GIT_EXEC_PATH HOSTNAME HOME"+	let getEnvPair k = maybe Nothing (\v -> Just (k, v)) <$> getEnv k+	e <- liftIO $ catMaybes <$> forM keyenv getEnvPair+	let e' = ("GIT_INDEX_FILE", f):e+#else+	e <- liftIO getEnvironment+	let e' = addEntry "GIT_INDEX_FILE" f e+#endif+	let g' = g { gitEnv = Just e' }++	r <- tryAnnex $ do+		Annex.changeState $ \s -> s { Annex.repo = g' }+		a+	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }+	either E.throw return r
Annex/Init.hs view
@@ -70,11 +70,10 @@ 		( do 			enableDirectMode 			setDirect True-		, do-			-- Handle case where this repo was cloned from a-			-- direct mode repo.-			unlessM isBare-				switchHEADBack+		-- Handle case where this repo was cloned from a+		-- direct mode repo+		, unlessM isBare+			switchHEADBack 		) 	createInodeSentinalFile 	u <- getUUID@@ -227,7 +226,7 @@ 		logStatus k InfoPresent 	let dotgit = d </> ".git" 	liftIO $ removeDirectoryRecursive dotgit-		`catchIO` (const $ renameDirectory dotgit (d </> "removeme"))+		`catchIO` const (renameDirectory dotgit (d </> "removeme"))  {- A repostory with the problem won't know it's a bare repository, but will  - have no pre-commit hook (which is not set up in a bare repository),
Annex/Link.hs view
@@ -94,6 +94,10 @@ hashSymlink linktarget = inRepo $ Git.HashObject.hashObject BlobObject $  	toInternalGitPath linktarget +hashSymlink' :: Git.HashObject.HashObjectHandle -> LinkTarget -> Annex Sha+hashSymlink' h linktarget = liftIO $ Git.HashObject.hashBlob h $+	toInternalGitPath linktarget+ {- Stages a symlink to the annex, using a Sha of its target. -} stageSymlink :: FilePath -> Sha -> Annex () stageSymlink file sha =
Annex/Ssh.hs view
@@ -76,7 +76,7 @@   	-- ssh appends a 16 char extension to the socket when setting it 	-- up, which needs to be taken into account when checking 	-- that a valid socket was constructed.-  	sshgarbage = take (1+16) $ repeat 'X'+  	sshgarbage = replicate (1+16) 'X'  sshConnectionCachingParams :: FilePath -> [CommandParam] sshConnectionCachingParams socketfile =
Annex/TaggedPush.hs view
@@ -35,11 +35,11 @@ 	[ Just "refs/synced" 	, Just $ fromUUID u 	, toB64 <$> info-	, Just $ show $ Git.Ref.base b+	, Just $ Git.fromRef $ Git.Ref.base b 	]  fromTaggedBranch :: Git.Branch -> Maybe (UUID, Maybe String)-fromTaggedBranch b = case split "/" $ show b of+fromTaggedBranch b = case split "/" $ Git.fromRef b of 	("refs":"synced":u:info:_base) -> 		Just (toUUID u, fromB64Maybe info) 	("refs":"synced":u:_base) ->@@ -58,4 +58,4 @@         , Param $ refspec branch         ]   where-	refspec b = show b ++ ":" ++ show (toTaggedBranch u info b)+	refspec b = Git.fromRef b ++ ":" ++ Git.fromRef (toTaggedBranch u info b)
+ Annex/View.hs view
@@ -0,0 +1,429 @@+{- metadata based branch views+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Annex.View where++import Common.Annex+import Types.View+import Types.MetaData+import qualified Git+import qualified Git.DiffTree as DiffTree+import qualified Git.Branch+import qualified Git.LsFiles+import qualified Git.Ref+import Git.UpdateIndex+import Git.Sha+import Git.HashObject+import Git.Types+import Git.FilePath+import qualified Backend+import Annex.Index+import Annex.Link+import Annex.CatFile+import Logs.MetaData+import Logs.View+import Utility.FileMode+import Types.Command+import Config+import CmdLine.Action++import qualified Data.Set as S+import System.Path.WildMatch+import "mtl" Control.Monad.Writer++#ifdef WITH_TDFA+import Text.Regex.TDFA+import Text.Regex.TDFA.String+#else+import Text.Regex+#endif++{- Each visible ViewFilter in a view results in another level of+ - subdirectory nesting. When a file matches multiple ways, it will appear+ - in multiple subdirectories. This means there is a bit of an exponential+ - blowup with a single file appearing in a crazy number of places!+ -+ - Capping the view size to 5 is reasonable; why wants to dig+ - through 5+ levels of subdirectories to find anything?+ -}+viewTooLarge :: View -> Bool+viewTooLarge view = visibleViewSize view > 5++visibleViewSize :: View -> Int+visibleViewSize = length . filter viewVisible . viewComponents++data ViewChange = Unchanged | Narrowing | Widening+	deriving (Ord, Eq, Show)++{- Updates a view, adding new fields to filter on (Narrowing), + - or allowing new values in an existing field (Widening). -}+refineView :: View -> [(MetaField, String)] -> (View, ViewChange)+refineView = go Unchanged+  where+  	go c v [] = (v, c)+	go c v ((f, s):rest) =+		let (v', c') = refineView' v f s+		in go (max c c') v' rest++{- Adds an additional filter to a view. This can only result in narrowing+ - the view. Multivalued filters are added in non-visible form. -}+filterView :: View -> [(MetaField, String)] -> View+filterView v vs = v { viewComponents = viewComponents f' ++ viewComponents v}+  where+	f = fst $ refineView (v {viewComponents = []}) vs+	f' = f { viewComponents = map toinvisible (viewComponents f) }+	toinvisible c = c { viewVisible = False }++refineView' :: View -> MetaField -> String -> (View, ViewChange)+refineView' view field wanted+	| field `elem` (map viewField components) = +		let (components', viewchanges) = runWriter $ mapM updatefield components+		in (view { viewComponents = components' }, maximum viewchanges)+	| otherwise = +		let component = ViewComponent field viewfilter (multiValue viewfilter)+		    view' = view { viewComponents = component : components }+		in if viewTooLarge view'+			then error $ "View is too large (" ++ show (visibleViewSize view') ++ " levels of subdirectories)"+			else (view', Narrowing)+  where+  	components = viewComponents view+	viewfilter+		| any (`elem` wanted) "*?" = FilterGlob wanted+		| otherwise = FilterValues $ S.singleton $ toMetaValue wanted+	updatefield :: ViewComponent -> Writer [ViewChange] ViewComponent+	updatefield v+		| viewField v == field = do+			let (newvf, viewchange) = combineViewFilter (viewFilter v) viewfilter+			tell [viewchange]+			return $ v { viewFilter = newvf }+		| otherwise = return v++{- Combine old and new ViewFilters, yielding a result that matches+ - either old+new, or only new.+ -+ - If we have FilterValues and change to a FilterGlob,+ - it's always a widening change, because the glob could match other+ - values. OTOH, going the other way, it's a Narrowing change if the old+ - glob matches all the new FilterValues.+ -+ - With two globs, the old one is discarded, and the new one is used.+ - We can tell if that's a narrowing change by checking if the old+ - glob matches the new glob. For example, "*" matches "foo*",+ - so that's narrowing. While "f?o" does not match "f??", so that's+ - widening.+ -}+combineViewFilter :: ViewFilter -> ViewFilter -> (ViewFilter, ViewChange)+combineViewFilter old@(FilterValues olds) (FilterValues news)+	| combined == old = (combined, Unchanged)+	| otherwise = (combined, Widening)+  where+	combined = FilterValues (S.union olds news)+combineViewFilter (FilterValues _) newglob@(FilterGlob _) =+	(newglob, Widening)+combineViewFilter (FilterGlob oldglob) new@(FilterValues s)+	| all (matchGlob (compileGlob oldglob) . fromMetaValue) (S.toList s) = (new, Narrowing)+	| otherwise = (new, Widening)+combineViewFilter (FilterGlob old) newglob@(FilterGlob new)+	| old == new = (newglob, Unchanged)+	| matchGlob (compileGlob old) new = (newglob, Narrowing)+	| otherwise = (newglob, Widening)++{- Converts a filepath used in a reference branch to the+ - filename that will be used in the view.+ -+ - No two filepaths from the same branch should yeild the same result,+ - so all directory structure needs to be included in the output file+ - in some way. However, the branch's directory structure is not relevant+ - in the view.+ -+ - So, from dir/subdir/file.foo, generate file_{dir;subdir}.foo+ -+ - (To avoid collisions with a filename that already contains {foo},+ - that is doubled to {{foo}}.)+ -}+fileViewFromReference :: MkFileView+fileViewFromReference f = concat+	[ double base+	, if null dirs then "" else "_{" ++ double (intercalate ";" dirs) ++ "}"+	, double $ concat extensions+	]+  where+	(path, basefile) = splitFileName f+	dirs = filter (/= ".") $ map dropTrailingPathSeparator (splitPath path)+	(base, extensions) = splitShortExtensions basefile++	double = replace "{" "{{" . replace "}" "}}"++fileViewReuse :: MkFileView+fileViewReuse = takeFileName++{- Generates views for a file from a branch, based on its metadata+ - and the filename used in the branch.+ -+ - Note that a file may appear multiple times in a view, when it+ - has multiple matching values for a MetaField used in the View.+ -+ - Of course if its MetaData does not match the View, it won't appear at+ - all.+ -+ - Note that for efficiency, it's useful to partially+ - evaluate this function with the view parameter and reuse+ - the result. The globs in the view will then be compiled and memoized.+ -}+fileViews :: View -> MkFileView -> FilePath -> MetaData -> [FileView]+fileViews view = +	let matchers = map viewComponentMatcher (viewComponents view)+	in \mkfileview file metadata ->+		let matches = map (\m -> m metadata) matchers+		in if any isNothing matches+			then []+			else +				let paths = pathProduct $+					map (map toViewPath) (visible matches)+				in if null paths+					then [mkfileview file]+					else map (</> mkfileview file) paths+  where+	visible = map (fromJust . snd) .+		filter (viewVisible . fst) .+		zip (viewComponents view)++{- Checks if metadata matches a ViewComponent filter, and if so+ - returns the value, or values that match. Self-memoizing on ViewComponent. -}+viewComponentMatcher :: ViewComponent -> (MetaData -> Maybe [MetaValue])+viewComponentMatcher viewcomponent = \metadata -> +	let s = matcher (currentMetaDataValues metafield metadata)+	in if S.null s then Nothing else Just (S.toList s)+  where+  	metafield = viewField viewcomponent+	matcher = case viewFilter viewcomponent of+		FilterValues s -> \values -> S.intersection s values+		FilterGlob glob ->+			let regex = compileGlob glob+			in \values -> +				S.filter (matchGlob regex . fromMetaValue) values++compileGlob :: String -> Regex+compileGlob glob = +#ifdef WITH_TDFA+	case compile (defaultCompOpt {caseSensitive = False}) defaultExecOpt regex of+		Right r -> r+		Left _ -> error $ "failed to compile regex: " ++ regex+#else+	mkRegexWithOpts regex False True+#endif+  where+	regex = '^':wildToRegex glob++matchGlob :: Regex -> String -> Bool+matchGlob regex val = +#ifdef WITH_TDFA+	case execute regex val of+		Right (Just _) -> True+		_ -> False+#else+	isJust $ matchRegex regex val+#endif++toViewPath :: MetaValue -> FilePath+toViewPath = concatMap escapeslash . fromMetaValue+  where+	escapeslash c+		| c == '/' = [pseudoSlash]+		| c == '\\' = [pseudoBackslash]+		| c == pseudoSlash = [pseudoSlash, pseudoSlash]+		| c == pseudoBackslash = [pseudoBackslash, pseudoBackslash]+		| otherwise = [c]++fromViewPath :: FilePath -> MetaValue+fromViewPath = toMetaValue . deescapeslash []+  where+  	deescapeslash s [] = reverse s+  	deescapeslash s (c:cs)+		| c == pseudoSlash = case cs of+			(c':cs')+				| c' == pseudoSlash -> deescapeslash (pseudoSlash:s) cs'+			_ -> deescapeslash ('/':s) cs+		| c == pseudoBackslash = case cs of+			(c':cs')+				| c' == pseudoBackslash -> deescapeslash (pseudoBackslash:s) cs'+			_ -> deescapeslash ('/':s) cs+		| otherwise = deescapeslash (c:s) cs++pseudoSlash :: Char+pseudoSlash = '\8725' -- '∕' /= '/'++pseudoBackslash :: Char+pseudoBackslash = '\9586' -- '╲' /= '\'++pathProduct :: [[FilePath]] -> [FilePath]+pathProduct [] = []+pathProduct (l:ls) = foldl combinel l ls+  where+	combinel xs ys = [combine x y | x <- xs, y <- ys]++{- Extracts the metadata from a fileview, based on the view that was used+ - to construct it. -}+fromView :: View -> FileView -> MetaData+fromView view f = foldr (uncurry updateMetaData) newMetaData (zip fields values)+  where+	visible = filter viewVisible (viewComponents view)+	fields = map viewField visible+	paths = splitDirectories $ dropFileName f+	values = map fromViewPath paths++{- Constructing a view that will match arbitrary metadata, and applying+ - it to a file yields a set of FileViews which all contain the same+ - MetaFields that were present in the input metadata+ - (excluding fields that are not visible). -}+prop_view_roundtrips :: FilePath -> MetaData -> Bool -> Bool+prop_view_roundtrips f metadata visible = null f || viewTooLarge view ||+	all hasfields (fileViews view fileViewFromReference f metadata)+  where+	view = View (Git.Ref "master") $+		map (\(mf, mv) -> ViewComponent mf (FilterValues $ S.filter (not . null . fromMetaValue) mv) visible)+			(fromMetaData metadata)+	visiblefields = sort (map viewField $ filter viewVisible (viewComponents view))+	hasfields fv = sort (map fst (fromMetaData (fromView view fv))) == visiblefields++{- Applies a view to the currently checked out branch, generating a new+ - branch for the view.+ -}+applyView :: View -> Annex Git.Branch+applyView view = applyView' fileViewFromReference view++{- Generates a new branch for a View, which must be a more narrow+ - version of the View originally used to generate the currently+ - checked out branch. That is, it must match a subset of the files+ - in view, not any others.+ -}+narrowView :: View -> Annex Git.Branch+narrowView = applyView' fileViewReuse++{- Go through each file in the currently checked out branch.+ - If the file is not annexed, skip it, unless it's a dotfile in the top.+ - Look up the metadata of annexed files, and generate any FileViews,+ - and stage them.+ -+ - Currently only works in indirect mode. Must be run from top of+ - repository.+ -}+applyView' :: MkFileView -> View -> Annex Git.Branch+applyView' mkfileview view = do+	top <- fromRepo Git.repoPath+	(l, clean) <- inRepo $ Git.LsFiles.inRepo [top]+	liftIO . nukeFile =<< fromRepo gitAnnexViewIndex+	genViewBranch view $ do+		uh <- inRepo Git.UpdateIndex.startUpdateIndex+		hasher <- inRepo hashObjectStart+		forM_ l $ \f ->+			go uh hasher f =<< Backend.lookupFile f+		liftIO $ do+			hashObjectStop hasher+			void $ stopUpdateIndex uh+			void clean+  where+	genfileviews = fileViews view mkfileview -- enables memoization+	go uh hasher f (Just (k, _)) = do+		metadata <- getCurrentMetaData k+		forM_ (genfileviews f metadata) $ \fv -> do+			stagesymlink uh hasher fv =<< inRepo (gitAnnexLink fv k)+	go uh hasher f Nothing+		| "." `isPrefixOf` f = do+			s <- liftIO $ getSymbolicLinkStatus f+			if isSymbolicLink s+				then stagesymlink uh hasher f =<< liftIO (readSymbolicLink f)+				else do+					sha <- liftIO $ Git.HashObject.hashFile hasher f+					let blobtype = if isExecutable (fileMode s)+						then ExecutableBlob+						else FileBlob+					liftIO . Git.UpdateIndex.streamUpdateIndex' uh+						=<< inRepo (Git.UpdateIndex.stageFile sha blobtype f)+		| otherwise = noop+	stagesymlink uh hasher f linktarget = do+		sha <- hashSymlink' hasher linktarget+		liftIO . Git.UpdateIndex.streamUpdateIndex' uh+			=<< inRepo (Git.UpdateIndex.stageSymlink f sha)++{- Applies a view to the reference branch, generating a new branch+ - for the View.+ -+ - This needs to work incrementally, to quickly update the view branch+ - when the reference branch is changed. So, it works based on an+ - old version of the reference branch, uses diffTree to find the+ - changes, and applies those changes to the view branch.+ -}+updateView :: View -> Git.Ref -> Git.Ref -> Annex Git.Branch+updateView view ref oldref = genViewBranch view $ do+	(diffs, cleanup) <- inRepo $ DiffTree.diffTree oldref ref+	forM_ diffs go+	void $ liftIO cleanup+  where+	go diff+		| DiffTree.dstsha diff == nullSha = error "TODO delete file"+		| otherwise = error "TODO add file"++{- Diff between currently checked out branch and staged changes, and+ - update metadata to reflect the changes that are being committed to the+ - view.+ -+ - Adding a file to a directory adds the metadata represented by+ - that directory to the file, and removing a file from a directory+ - removes the metadata.+ -+ - Note that removes must be handled before adds. This is so+ - that moving a file from x/foo/ to x/bar/ adds back the metadata for x.+ -}+withViewChanges :: (FileView -> Key -> CommandStart) -> (FileView -> Key -> CommandStart) -> Annex ()+withViewChanges addmeta removemeta = do+	makeabs <- flip fromTopFilePath <$> gitRepo+	(diffs, cleanup) <- inRepo $ DiffTree.diffIndex Git.Ref.headRef+	forM_ diffs handleremovals+	forM_ diffs (handleadds makeabs)+	void $ liftIO cleanup+  where+	handleremovals item+		| DiffTree.srcsha item /= nullSha =+			handle item removemeta+				=<< catKey (DiffTree.srcsha item) (DiffTree.srcmode item)+		| otherwise = noop+	handleadds makeabs item+		| DiffTree.dstsha item /= nullSha = +			handle item addmeta+				=<< ifM isDirect+					( catKey (DiffTree.dstsha item) (DiffTree.dstmode item)+					-- optimisation+					, isAnnexLink $ makeabs $ DiffTree.file item+					)+		| otherwise = noop+	handle item a = maybe noop+		(void . commandAction . a (getTopFilePath $ DiffTree.file item))++{- Generates a branch for a view. This is done using a different index+ - file. An action is run to stage the files that will be in the branch.+ - Then a commit is made, to the view branch. The view branch is not+ - checked out, but entering it will display the view. -}+genViewBranch :: View -> Annex () -> Annex Git.Branch+genViewBranch view a = withIndex $ do+	a+	let branch = branchView view+	void $ inRepo $ Git.Branch.commit True (fromRef branch) branch []+	return branch++{- Runs an action using the view index file.+ - Note that the file does not necessarily exist, or can contain+ - info staged for an old view. -}+withIndex :: Annex a -> Annex a+withIndex a = do+	f <- fromRepo gitAnnexViewIndex+	withIndexFile f a++withCurrentView :: (View -> Annex a) -> Annex a+withCurrentView a = maybe (error "Not in a view.") a =<< currentView
Assistant.hs view
@@ -93,7 +93,8 @@ 			start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing #else 	-- Windows is always foreground, and has no log file.-	start id $+	liftIO $ Utility.Daemon.lockPidFile pidfile+	start id $ do 		case startbrowser of 			Nothing -> Nothing 			Just a -> Just $ a Nothing Nothing
Assistant/MakeRemote.hs view
@@ -48,9 +48,10 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $ 	go =<< Command.InitRemote.findExisting name   where-  	go Nothing = setupSpecialRemote name Rsync.remote config+  	go Nothing = setupSpecialRemote name Rsync.remote config Nothing 		(Nothing, Command.InitRemote.newConfig name)-	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config (Just u, c)+	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing+		(Just u, c) 	config = M.fromList 		[ ("encryption", "shared") 		, ("rsyncurl", location)@@ -60,44 +61,44 @@ {- Inits a gcrypt special remote, and returns its name. -} makeGCryptRemote :: RemoteName -> String -> KeyId -> Annex RemoteName makeGCryptRemote remotename location keyid = -	initSpecialRemote remotename GCrypt.remote $ M.fromList+	initSpecialRemote remotename GCrypt.remote Nothing $ M.fromList 		[ ("type", "gcrypt") 		, ("gitrepo", location) 		, configureEncryption HybridEncryption 		, ("keyid", keyid) 		] -type SpecialRemoteMaker = RemoteName -> RemoteType -> R.RemoteConfig -> Annex RemoteName+type SpecialRemoteMaker = RemoteName -> RemoteType -> Maybe CredPair -> R.RemoteConfig -> Annex RemoteName  {- Inits a new special remote. The name is used as a suggestion, but  - will be changed if there is already a special remote with that name. -} initSpecialRemote :: SpecialRemoteMaker-initSpecialRemote name remotetype config = go 0+initSpecialRemote name remotetype mcreds config = go 0   where 	go :: Int -> Annex RemoteName 	go n = do 		let fullname = if n == 0  then name else name ++ show n 		r <- Command.InitRemote.findExisting fullname 		case r of-			Nothing -> setupSpecialRemote fullname remotetype config+			Nothing -> setupSpecialRemote fullname remotetype config mcreds 				(Nothing, Command.InitRemote.newConfig fullname) 			Just _ -> go (n + 1)  {- Enables an existing special remote. -} enableSpecialRemote :: SpecialRemoteMaker-enableSpecialRemote name remotetype config = do+enableSpecialRemote name remotetype mcreds config = do 	r <- Command.InitRemote.findExisting name 	case r of 		Nothing -> error $ "Cannot find a special remote named " ++ name-		Just (u, c) -> setupSpecialRemote name remotetype config (Just u, c)+		Just (u, c) -> setupSpecialRemote name remotetype config mcreds (Just u, c) -setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName-setupSpecialRemote name remotetype config (mu, c) = do+setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName+setupSpecialRemote name remotetype config mcreds (mu, c) = do 	{- Currently, only 'weak' ciphers can be generated from the 	 - assistant, because otherwise GnuPG may block once the entropy 	 - pool is drained, and as of now there's no way to tell the user 	 - to perform IO actions to refill the pool. -}-	(c', u) <- R.setup remotetype mu $+	(c', u) <- R.setup remotetype mu mcreds $ 		M.insert "highRandomQuality" "false" $ M.union config c 	describeUUID u name 	configSet u c'
Assistant/Restart.hs view
@@ -16,6 +16,7 @@ import Utility.ThreadScheduler import Utility.NotificationBroadcaster import Utility.Url+import Utility.PID import qualified Git.Construct import qualified Git.Config import Config.Files@@ -25,10 +26,9 @@ import Control.Concurrent import System.Process (cwd) #ifndef mingw32_HOST_OS-import System.Posix (getProcessID, signalProcess, sigTERM)+import System.Posix (signalProcess, sigTERM) #else-import System.Win32.Process.Current (getCurrentProcessId)-import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT)+import Utility.WinProcess #endif  {- Before the assistant can be restarted, have to remove our @@ -53,9 +53,9 @@ 	void $ liftIO $ forkIO $ do 		threadDelaySeconds (Seconds 120) #ifndef mingw32_HOST_OS-		signalProcess sigTERM =<< getProcessID+		signalProcess sigTERM =<< getPID #else-		generateConsoleCtrlEvent cTRL_C_EVENT =<< getCurrentProcessId+		terminatePID =<< getPID #endif  runRestart :: Assistant URLString@@ -86,10 +86,13 @@ 		threadDelay 100000 -- 1/10th of a second 		a -{- Returns once the assistant has daemonized, but possibly before it's- - listening for web connections. -}+{- Does not wait for assistant to be listening for web connections. + -+ - On windows, the assistant does not daemonize, which is why the forkIO is+ - done.+ -} startAssistant :: FilePath -> IO ()-startAssistant repo = do+startAssistant repo = void $ forkIO $ do 	program <- readProgramFile 	(_, _, _, pid) <-  		createProcess $
Assistant/Threads/Merger.hs view
@@ -80,8 +80,8 @@ 	mergecurrent (Just current) 		| equivBranches changedbranch current = do 			debug-				[ "merging", show changedbranch-				, "into", show current+				[ "merging", Git.fromRef changedbranch+				, "into", Git.fromRef current 				] 			void $ liftAnnex  $ Command.Sync.mergeFrom changedbranch 	mergecurrent _ = noop@@ -105,12 +105,12 @@ equivBranches :: Git.Ref -> Git.Ref -> Bool equivBranches x y = base x == base y   where-	base = takeFileName . show+	base = takeFileName . Git.fromRef  isAnnexBranch :: FilePath -> Bool isAnnexBranch f = n `isSuffixOf` f   where-	n = '/' : show Annex.Branch.name+	n = '/' : Git.fromRef Annex.Branch.name  fileToBranch :: FilePath -> Git.Ref fileToBranch f = Git.Ref $ "refs" </> base
Assistant/Threads/SanityChecker.hs view
@@ -194,8 +194,13 @@  hourlyCheck :: Assistant () hourlyCheck = do+#ifndef mingw32_HOST_OS 	checkLogSize 0+#else+	noop+#endif +#ifndef mingw32_HOST_OS {- Rotate logs until log file size is < 1 mb. -} checkLogSize :: Int -> Assistant () checkLogSize n = do@@ -209,6 +214,7 @@ 			checkLogSize $ n + 1   where 	filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f)+#endif  oneMegabyte :: Int oneMegabyte = 1000000
Assistant/TransferSlots.hs view
@@ -39,7 +39,7 @@ import System.Posix.Process (getProcessGroupIDOf) import System.Posix.Signals (signalProcessGroup, sigTERM, sigKILL) #else-import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT, cTRL_BREAK_EVENT)+import Utility.WinProcess #endif  type TransferGenerator = Assistant (Maybe (Transfer, TransferInfo, Transferrer -> Assistant ()))@@ -256,23 +256,19 @@ 	signalthread tid 		| pause = throwTo tid PauseTransfer 		| otherwise = killThread tid-	{- In order to stop helper processes like rsync,-	 - kill the whole process group of the process-	 - running the transfer. -} 	killproc pid = void $ tryIO $ do #ifndef mingw32_HOST_OS+		{- In order to stop helper processes like rsync,+		 - kill the whole process group of the process+		 - running the transfer. -} 		g <- getProcessGroupIDOf pid 		let signal sig = void $ tryIO $ signalProcessGroup sig g 		signal sigTERM-		graceperiod+		threadDelay 50000 -- 0.05 second grace period 		signal sigKILL #else-		let signal sig = void $ tryIO $ generateConsoleCtrlEvent sig pid-		signal cTRL_C_EVENT-		graceperiod-		signal cTRL_BREAK_EVENT+		terminatePID pid #endif-	graceperiod = threadDelay 50000 -- 0.05 second  {- Start or resume a transfer. -} startTransfer :: Transfer -> Assistant ()
Assistant/Types/NetMessager.hs view
@@ -32,7 +32,7 @@ 	| PairingNotification PairStage ClientID UUID 	-- used for git push over the network messager 	| Pushing ClientID PushStage-	deriving (Show, Eq, Ord)+	deriving (Eq, Ord, Show)  {- Something used to identify the client, or clients to send the message to. -} type ClientID = Text@@ -50,7 +50,7 @@ 	| SendPackOutput SequenceNum ByteString 	-- sent when git receive-pack exits, with its exit code 	| ReceivePackDone ExitCode-	deriving (Show, Eq, Ord)+	deriving (Eq, Ord, Show)  {- A sequence number. Incremented by one per packet in a sequence,  - starting with 1 for the first packet. 0 means sequence numbers are
Assistant/WebApp/Configurators/AWS.hs view
@@ -202,11 +202,11 @@ #endif  makeAWSRemote :: SpecialRemoteMaker -> RemoteType -> StandardGroup -> AWSCreds -> RemoteName -> RemoteConfig -> Handler ()-makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config = do-	liftIO $ AWS.setCredsEnv (T.unpack ak, T.unpack sk)+makeAWSRemote maker remotetype defaultgroup (AWSCreds ak sk) name config =  	setupCloudRemote defaultgroup Nothing $-		maker hostname remotetype config+		maker hostname remotetype (Just creds) config   where+  	creds = (T.unpack ak, T.unpack sk) 	{- AWS services use the remote name as the basis for a host 	 - name, so filter it to contain valid characters. -} 	hostname = case filter isAlphaNum name of
Assistant/WebApp/Configurators/Local.hs view
@@ -300,7 +300,6 @@ getFinishAddDriveR :: RemovableDrive -> RepoKey -> Handler Html getFinishAddDriveR drive = go   where-  	{- Set up new gcrypt special remote. -} 	go (RepoKey keyid) = whenGcryptInstalled $ makewith $ const $ do 		r <- liftAnnex $ addRemote $ 			makeGCryptRemote remotename dir keyid@@ -314,7 +313,7 @@ 		remotename' <- liftAnnex $ getGCryptRemoteName u dir 		makewith $ const $ do 			r <- liftAnnex $ addRemote $-				enableSpecialRemote remotename' GCrypt.remote $ M.fromList+				enableSpecialRemote remotename' GCrypt.remote Nothing $ M.fromList 					[("gitrepo", dir)] 			return (u, r) 	{- Making a new unencrypted repo, or combining with an existing one. -}
Assistant/WebApp/Configurators/Ssh.hs view
@@ -25,6 +25,11 @@ import Annex.UUID import Logs.UUID +#ifdef mingw32_HOST_OS+import Utility.Tmp+import Utility.Rsync+#endif+ import qualified Data.Text as T import qualified Data.Map as M import Network.Socket@@ -354,7 +359,7 @@ enableGCrypt :: SshData -> RemoteName -> Handler Html enableGCrypt sshdata reponame =  	setupCloudRemote TransferGroup Nothing $ -		enableSpecialRemote reponame GCrypt.remote $ M.fromList+		enableSpecialRemote reponame GCrypt.remote Nothing $ M.fromList 			[("gitrepo", genSshUrl sshdata)]  {- Combining with a gcrypt repository that may not be@@ -468,8 +473,18 @@ 	notencrypted = error "Unexpectedly found a non-encrypted git repository, instead of the expected encrypted git repository." 	notinstalled = error "internal" -{- Prepares rsync.net ssh key, and if successful, runs an action with- - its SshData. -}+{- Prepares rsync.net ssh key and creates the directory that will be + - used on rsync.net. If successful, runs an action with its SshData.+ -+ - To append the ssh key to rsync.net's authorized_keys, their+ - documentation recommends a dd methodd, where the line is fed+ - in to ssh over stdin.+ -+ - On Windows, ssh password prompting happens on stdin, so cannot+ - feed the key in that way. Instead, first rsync down any current+ - authorized_keys file, then modifiy it, and then rsync it back up.+ - This means 2 password prompts rather than one for Windows.+ -} prepRsyncNet :: SshInput -> String -> (SshData -> Handler Html) -> Handler Html prepRsyncNet sshinput reponame a = do 	knownhost <- liftIO $ maybe (return False) knownHost (inputHostname sshinput)@@ -480,25 +495,37 @@ 			, needsPubKey = True 			, sshCapabilities = [RsyncCapable] 			}+	let sshhost = genSshHost (sshHostName sshdata) (sshUserName sshdata)+	let torsyncnet cmd = filter (not . null)+		[ if knownhost then "" else sshOpt "StrictHostKeyChecking" "no"+		, sshhost+		, cmd+		]+#ifndef mingw32_HOST_OS 	{- I'd prefer to separate commands with && , but-	 - rsync.net's shell does not support that.-	 --	 - The dd method of appending to the authorized_keys file is the-	 - one recommended by rsync.net documentation. I touch the file first-	 - to not need to use a different method to create it.-	 -}+	 - rsync.net's shell does not support that. -} 	let remotecommand = intercalate ";" 		[ "mkdir -p .ssh" 		, "touch .ssh/authorized_keys" 		, "dd of=.ssh/authorized_keys oflag=append conv=notrunc" 		, "mkdir -p " ++ T.unpack (sshDirectory sshdata) 		]-	let sshopts = filter (not . null)-		[ if knownhost then "" else sshOpt "StrictHostKeyChecking" "no"-		, genSshHost (sshHostName sshdata) (sshUserName sshdata)-		, remotecommand-		]-	sshSetup sshopts (Just $ sshPubKey keypair) $ a sshdata+	sshSetup (torsyncnet remotecommand) (Just $ sshPubKey keypair) (a sshdata)+#else+	liftIO $ withTmpDir "rsyncnet" $ \tmpdir -> do+		createDirectory $ tmpdir </> ".ssh"+		(oldkeys, _) <- sshTranscript (torsyncnet "cat .ssh/authorized_keys") Nothing+		writeFile (tmpdir </> ".ssh" </> "authorized_keys")+			(sshPubKey keypair ++ "\n" ++ oldkeys)+		liftIO $ putStrLn "May need to prompt for your rsync.net password one more time..."+		void $ rsync+			[ Param "-r"+			, File $ tmpdir </> ".ssh/"+			, Param $ sshhost ++ ":.ssh/"+			]+	let remotecommand = "mkdir -p " ++ T.unpack (sshDirectory sshdata)+	sshSetup (torsyncnet remotecommand) Nothing (a sshdata)+#endif  isRsyncNet :: Maybe Text -> Bool isRsyncNet Nothing = False
Assistant/WebApp/Configurators/WebDAV.hs view
@@ -123,10 +123,9 @@  #ifdef WITH_WEBDAV makeWebDavRemote :: SpecialRemoteMaker -> RemoteName -> CredPair -> RemoteConfig -> Handler ()-makeWebDavRemote maker name creds config = do-	liftIO $ WebDAV.setCredsEnv creds+makeWebDavRemote maker name creds config =  	setupCloudRemote TransferGroup Nothing $-		maker name WebDAV.remote config+		maker name WebDAV.remote (Just creds) config  {- Only returns creds previously used for the same hostname. -} previouslyUsedWebDAVCreds :: String -> Annex (Maybe CredPair)
Assistant/WebApp/Control.hs view
@@ -16,15 +16,15 @@ import Assistant.Restart import Utility.LogFile import Utility.NotificationBroadcaster+import Utility.PID  import Control.Concurrent import qualified Data.Map as M import qualified Data.Text as T #ifndef mingw32_HOST_OS-import System.Posix (getProcessID, signalProcess, sigTERM)+import System.Posix (signalProcess, sigTERM) #else-import System.Win32.Process.Current (getCurrentProcessId)-import System.Win32.Console (generateConsoleCtrlEvent, cTRL_C_EVENT)+import Utility.WinProcess #endif  getShutdownR :: Handler Html@@ -54,9 +54,9 @@ 	void $ liftIO $ forkIO $ do 		threadDelay 2000000 #ifndef mingw32_HOST_OS-		signalProcess sigTERM =<< getProcessID+		signalProcess sigTERM =<< getPID #else-		generateConsoleCtrlEvent cTRL_C_EVENT =<< getCurrentProcessId+		terminatePID =<< getPID #endif 	redirect NotRunningR
Assistant/WebApp/DashBoard.hs view
@@ -130,8 +130,23 @@ #endif 	ifM (liftIO $ inPath cmd) 		( do-			void $ liftIO $ forkIO $ void $+			let run = void $ liftIO $ forkIO $ void $ 				boolSystem cmd params+			run+#ifdef mingw32_HOST_OS+			{- On windows, if the file browser is not+			 - already open, it comes up below the+			 - web browser when started. +			 -+			 - Running it a second time brings it+			 - to the foreground.+			 -+			 - Seems to need a delay long enough for the file+			 - browser to be open in order to work. Here 1+			 - second. -}+			liftIO $ threadDelay 1000000+			run+#endif 			return True 		, do 			void $ redirect $ "file://" ++ path
Assistant/WebApp/MakeRemote.hs view
@@ -28,8 +28,8 @@  - and finishes setting it up, then starts syncing with it,  - and finishes by displaying the page to edit it. -} setupCloudRemote :: StandardGroup -> Maybe Cost -> Annex RemoteName -> Handler a-setupCloudRemote defaultgroup mcost maker = do-	r <- liftAnnex $ addRemote maker+setupCloudRemote defaultgroup mcost name = do+	r <- liftAnnex $ addRemote name 	liftAnnex $ do 		setStandardGroup (Remote.uuid r) defaultgroup 		maybe noop (Config.setRemoteCost (Remote.repo r)) mcost
Assistant/XMPP.hs view
@@ -13,6 +13,7 @@ import Assistant.Types.NetMessager import Assistant.Pairing import Git.Sha (extractSha)+import Git  import Network.Protocol.XMPP hiding (Node) import Data.Text (Text)@@ -152,7 +153,7 @@   where 	encode (CanPush u shas) = 		gitAnnexTag canPushAttr $ T.pack $ unwords $-			fromUUID u : map show shas+			fromUUID u : map fromRef shas 	encode (PushRequest u) = 		gitAnnexTag pushRequestAttr $ T.pack $ fromUUID u 	encode (StartingPush u) =
Backend/Hash.hs view
@@ -101,6 +101,7 @@ 	case (mstat, fast) of 		(Just stat, False) -> do 			let filesize = fromIntegral $ fileSize stat+			showSideAction "checksum" 			check <$> hashFile hash file filesize 		_ -> return True   where
Build/DistributionUpdate.hs view
@@ -25,7 +25,7 @@ 	version <- liftIO getChangelogVersion 	now <- liftIO getCurrentTime 	liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir-	fs <- liftIO $ dirContentsRecursiveSkipping (== "info") True (basedir </> "git-annex")+	fs <- liftIO $ dirContentsRecursiveSkipping (const False) True (basedir </> "git-annex") 	forM_ fs $ \f -> do 		v <- lookupFile f 		case v of@@ -54,6 +54,19 @@ 		[ Param "annex" 		, Params "sync" 		]+	+	{- Check for out of date info files. -}+	infos <- liftIO $ filter (".info" `isSuffixOf`)+		<$> dirContentsRecursive (basedir </> "git-annex")+	ds <- liftIO $ forM infos (readish <$$> readFile)+	let dis = zip infos ds+	let ood = filter (outofdate version) dis+	unless (null ood) $+		error $ "Some info files are out of date: " ++ show (map fst ood)+  where+	outofdate version (_, md) = case md of+		Nothing -> True+		Just d -> distributionVersion d /= version  getRepoDir :: IO FilePath getRepoDir = do
Build/EvilLinker.hs view
@@ -17,6 +17,7 @@ import Control.Monad import System.Directory import Data.Maybe+import Data.List  import Utility.Monad import Utility.Process@@ -94,13 +95,19 @@ 	path <- manyTill anyChar (try $ string ldcmd) 	void $ char ' ' 	params <- restOfLine-	return $ CmdParams (path ++ ldcmd) (escapeDosPaths params) Nothing+	return $ CmdParams (path ++ ldcmd) (skipHack $ escapeDosPaths params) Nothing   where 	ldcmd = "ld.exe" 	versionline = do 		void $ string "collect2 version" 		restOfLine-	++{- For unknown reasons, asking the linker to link this in fails,+ - with error about multiple definitions of a symbol from the library.+ - This is a horrible hack. -}+skipHack :: String -> String+skipHack = replace "dist/build/git-annex/git-annex-tmp/Utility/winprocess.o" ""+ {- Input contains something like   - c:/program files/haskell platform/foo -LC:/Program Files/Haskell Platform/ -L...  - and the *right* spaces must be escaped with \
CHANGELOG view
@@ -1,3 +1,34 @@+git-annex (5.20140221) unstable; urgency=medium++  * metadata: New command that can attach metadata to files.+  * --metadata can be used to limit commands to acting on files+    that have particular metadata.+  * Preferred content expressions can use metadata=field=value+    to limit them to acting on files that have particular metadata.+  * view: New command that creates and checks out a branch that provides+    a structured view of selected metadata.+  * vfilter, vadd, vpop, vcycle: New commands for operating within views.+  * pre-commit: Update metadata when committing changes to locations+    of annexed files within a view.+  * Add progress display for transfers to/from external special remotes.+  * unused: Fix to actually detect unused keys when in direct mode.+  * fsck: When run with --all or --unused, while .gitattributes+    annex.numcopies cannot be honored since it's operating on keys+    instead of files, make it honor the global numcopies setting,+    and the annex.numcopies git config setting.+  * trust, untrust, semitrust, dead: Warn when the trust level is+    overridden in .git/config.+  * glacier: Do not try to run glacier value create when an existing glacier+    remote is enabled.+  * fsck: Refuse to do anything if more than one of --incremental, --more,+    and --incremental-schedule are given, since it's not clear which option+    should win.+  * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes+  * Windows webapp: Can create repos on removable drives.+  * Windows: Ensure HOME is set, as needed by bundled cygwin utilities.++ -- Joey Hess <joeyh@debian.org>  Fri, 21 Feb 2014 11:23:59 -0400+ git-annex (5.20140210) unstable; urgency=medium    * --in can now refer to files that were located in a repository at
CmdLine/GitAnnex.hs view
@@ -26,6 +26,12 @@ import qualified Command.TransferKey import qualified Command.TransferKeys import qualified Command.ReKey+import qualified Command.MetaData+import qualified Command.View+import qualified Command.VAdd+import qualified Command.VFilter+import qualified Command.VPop+import qualified Command.VCycle import qualified Command.Reinject import qualified Command.Fix import qualified Command.Init@@ -134,6 +140,12 @@ 	, Command.TransferKey.def 	, Command.TransferKeys.def 	, Command.ReKey.def+	, Command.MetaData.def+	, Command.View.def+	, Command.VAdd.def+	, Command.VFilter.def+	, Command.VPop.def+	, Command.VCycle.def 	, Command.Fix.def 	, Command.Fsck.def 	, Command.Repair.def
CmdLine/GitAnnex/Options.hs view
@@ -54,6 +54,8 @@ 		"match files larger than a size" 	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize) 		"match files smaller than a size"+	, Option [] ["metadata"] (ReqArg Limit.addMetaData "FIELD=VALUE")+		"match files with attached metadata" 	, Option [] ["want-get"] (NoArg Limit.Wanted.addWantGet) 		"match files the repository wants to get" 	, Option [] ["want-drop"] (NoArg Limit.Wanted.addWantDrop)
Command.hs view
@@ -5,8 +5,6 @@  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE BangPatterns #-}- module Command ( 	command, 	noRepo,
Command/Dead.hs view
@@ -7,34 +7,13 @@  module Command.Dead where -import Common.Annex import Command-import qualified Remote-import Logs.Trust-import Logs.Group--import qualified Data.Set as S+import Types.TrustLevel+import Command.Trust (trustCommand)  def :: [Command] def = [command "dead" (paramRepeating paramRemote) seek 	SectionSetup "hide a lost repository"]  seek :: CommandSeek-seek = withWords start--start :: [String] -> CommandStart-start ws = do-	let name = unwords ws-	showStart "dead" name-	u <- Remote.nameToUUID name-	next $ perform u--perform :: UUID -> CommandPerform-perform uuid = do-	markDead uuid-	next $ return True--markDead :: UUID -> Annex ()-markDead uuid = do-	trustSet uuid DeadTrusted-	groupSet uuid S.empty+seek = trustCommand "dead" DeadTrusted
Command/EnableRemote.hs view
@@ -47,7 +47,7 @@  perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform perform t u c = do-	(c', u') <- R.setup t (Just u) c+	(c', u') <- R.setup t (Just u) Nothing c 	next $ cleanup u' c'  cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
Command/Fsck.hs view
@@ -31,12 +31,8 @@ import Types.Key import Utility.HumanTime import Git.FilePath+import Utility.PID -#ifndef mingw32_HOST_OS-import System.Posix.Process (getProcessID)-#else-import System.Win32.Process.Current (getCurrentProcessId)-#endif import Data.Time.Clock.POSIX import Data.Time import System.Posix.Types (EpochTime)@@ -72,7 +68,7 @@ 	from <- getOptionField fsckFromOption Remote.byNameWithUUID 	i <- getIncremental 	withKeyOptions-		(startKey i)+		(\k -> startKey i k =<< getNumCopies) 		(withFilesInGit $ whenAnnexed $ start from i) 		ps @@ -84,11 +80,12 @@ 	morei <- Annex.getFlag (optionName moreIncrementalOption) 	case (i, starti, morei) of 		(False, False, False) -> return NonIncremental-		(False, True, _) -> startIncremental+		(False, True, False) -> startIncremental 		(False ,False, True) -> ContIncremental <$> getStartTime-		(True, _, _) ->+		(True, False, False) -> 			maybe startIncremental (return . ContIncremental . Just) 				=<< getStartTime+		_ -> error "Specify only one of --incremental, --more, or --incremental-schedule"   where 	startIncremental = do 		recordStartTime@@ -149,14 +146,10 @@ 		, checkKeyNumCopies key file numcopies 		] 	withtmp a = do-#ifndef mingw32_HOST_OS-		v <- liftIO getProcessID-#else-		v <- liftIO getCurrentProcessId-#endif+		pid <- liftIO getPID 		t <- fromRepo gitAnnexTmpDir 		createAnnexDirectory t-		let tmp = t </> "fsck" ++ show v ++ "." ++ keyFile key+		let tmp = t </> "fsck" ++ show pid ++ "." ++ keyFile key 		let cleanup = liftIO $ catchIO (removeFile tmp) (const noop) 		cleanup 		cleanup `after` a tmp@@ -170,18 +163,19 @@ 			) 	dummymeter _ = noop -startKey :: Incremental -> Key -> CommandStart-startKey inc key = case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of-	Nothing -> stop-	Just backend -> runFsck inc (key2file key) key $ performAll key backend+startKey :: Incremental -> Key -> NumCopies -> CommandStart+startKey inc key numcopies =+	case Backend.maybeLookupBackendName (Types.Key.keyBackendName key) of+		Nothing -> stop+		Just backend -> runFsck inc (key2file key) key $+			performKey key backend numcopies -{- Note that numcopies cannot be checked in --all mode, since we do not- - have associated filenames to look up in the .gitattributes file. -}-performAll :: Key -> Backend -> Annex Bool-performAll key backend = check+performKey :: Key -> Backend -> NumCopies -> Annex Bool+performKey key backend numcopies = check 	[ verifyLocationLog key (key2file key) 	, checkKeySize key 	, checkBackend backend key Nothing+	, checkKeyNumCopies key (key2file key) numcopies 	]  check :: [Annex Bool] -> Annex Bool@@ -365,7 +359,7 @@ 				, return True 				) -checkKeyNumCopies :: Key -> FilePath -> NumCopies -> Annex Bool+checkKeyNumCopies :: Key -> String -> NumCopies -> Annex Bool checkKeyNumCopies key file numcopies = do 	(untrustedlocations, safelocations) <- trustPartition UnTrusted =<< Remote.keyLocations key 	let present = NumCopies (length safelocations)@@ -415,7 +409,7 @@ 		++ Remote.name remote  data Incremental = StartIncremental | ContIncremental (Maybe EpochTime) | NonIncremental-	deriving (Eq)+	deriving (Eq, Show)  runFsck :: Incremental -> FilePath -> Key -> Annex Bool -> CommandStart runFsck inc file key a = ifM (needFsck inc key)@@ -471,7 +465,9 @@  -  - To guard against time stamp damange (for example, if an annex directory  - is copied without -a), the fsckstate file contains a time that should- - be identical to its modification time. -}+ - be identical to its modification time.+ - (This is not possible to do on Windows.)+ -} recordStartTime :: Annex () recordStartTime = do 	f <- fromRepo gitAnnexFsckState@@ -479,8 +475,12 @@ 	liftIO $ do 		nukeFile f 		withFile f WriteMode $ \h -> do+#ifndef mingw32_HOST_OS 			t <- modificationTime <$> getFileStatus f 			hPutStr h $ showTime $ realToFrac t+#else+			noop+#endif   where 	showTime :: POSIXTime -> String 	showTime = show@@ -494,10 +494,14 @@ 	f <- fromRepo gitAnnexFsckState 	liftIO $ catchDefaultIO Nothing $ do 		timestamp <- modificationTime <$> getFileStatus f+#ifndef mingw32_HOST_OS 		t <- readishTime <$> readFile f 		return $ if Just (realToFrac timestamp) == t 			then Just timestamp 			else Nothing+#else+		return $ Just timestamp+#endif   where 	readishTime :: String -> Maybe POSIXTime 	readishTime s = utcTimeToPOSIXSeconds <$>
Command/InitRemote.hs view
@@ -44,7 +44,7 @@  perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform perform t name c = do-	(c', u) <- R.setup t Nothing c+	(c', u) <- R.setup t Nothing Nothing c 	next $ cleanup u name c'  cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup
Command/Log.hs view
@@ -140,7 +140,7 @@ 		[ Params "log -z --pretty=format:%ct --raw --abbrev=40" 		, Param "--remove-empty" 		] ++ os ++-		[ Param $ show Annex.Branch.fullname+		[ Param $ Git.fromRef Annex.Branch.fullname 		, Param "--" 		, Param logfile 		]
+ Command/MetaData.hs view
@@ -0,0 +1,68 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.MetaData where++import Common.Annex+import qualified Annex+import Command+import Logs.MetaData+import Types.MetaData++import qualified Data.Set as S+import Data.Time.Clock.POSIX++def :: [Command]+def = [withOptions [setOption, tagOption, untagOption] $+	command "metadata" paramPaths seek+	SectionMetaData "sets metadata of a file"]++storeModMeta :: ModMeta -> Annex ()+storeModMeta modmeta = Annex.changeState $+	\s -> s { Annex.modmeta = modmeta:Annex.modmeta s }++setOption :: Option+setOption = Option ['s'] ["set"] (ReqArg mkmod "FIELD[+-]=VALUE") "set metadata"+  where+	mkmod = either error storeModMeta . parseModMeta++tagOption :: Option+tagOption = Option ['t'] ["tag"] (ReqArg mkmod "TAG") "set a tag"+  where+	mkmod = storeModMeta . AddMeta tagMetaField . toMetaValue++untagOption :: Option+untagOption = Option ['u'] ["untag"] (ReqArg mkmod "TAG") "remove a tag"+  where+	mkmod = storeModMeta . AddMeta tagMetaField . mkMetaValue (CurrentlySet False)++seek :: CommandSeek+seek ps = do+	modmeta <- Annex.getState Annex.modmeta+	now <- liftIO getPOSIXTime+	withFilesInGit (whenAnnexed $ start now modmeta) ps++start :: POSIXTime -> [ModMeta] -> FilePath -> (Key, Backend) -> CommandStart+start now ms file (k, _) = do+	showStart "metadata" file+	next $ perform now ms k++perform :: POSIXTime -> [ModMeta] -> Key -> CommandPerform+perform _ [] k = next $ cleanup k+perform now ms k = do+	oldm <- getCurrentMetaData k+	let m = foldl' unionMetaData newMetaData $ map (modMeta oldm) ms+	addMetaData' k m now+	next $ cleanup k+	+cleanup :: Key -> CommandCleanup+cleanup k = do+	m <- getCurrentMetaData k+	showLongNote $ unlines $ concatMap showmeta $ fromMetaData $ currentMetaData m+	return True+  where+	showmeta (f, vs) = map (\v -> fromMetaField f ++ "=" ++ fromMetaValue v) $ S.toList vs
Command/PreCommit.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010, 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -13,7 +13,14 @@ import qualified Command.Add import qualified Command.Fix import Annex.Direct+import Annex.View+import Logs.View+import Logs.MetaData+import Types.View+import Types.MetaData +import qualified Data.Set as S+ def :: [Command] def = [command "pre-commit" paramPaths seek SectionPlumbing 	"run by git pre-commit hook"]@@ -27,13 +34,45 @@ 		withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps 		-- inject unlocked files into the annex 		withFilesUnlockedToBeCommitted startIndirect ps+		-- committing changes to a view updates metadata+		mv <- currentView+		case mv of+			Nothing -> noop+			Just v -> withViewChanges+				(addViewMetaData v)+				(removeViewMetaData v) 	)  startIndirect :: FilePath -> CommandStart-startIndirect file = next $ do-	unlessM (callCommandAction $ Command.Add.start file) $-		error $ "failed to add " ++ file ++ "; canceling commit"+startIndirect f = next $ do+	unlessM (callCommandAction $ Command.Add.start f) $+		error $ "failed to add " ++ f ++ "; canceling commit" 	next $ return True  startDirect :: [String] -> CommandStart startDirect _ = next $ next $ preCommitDirect++addViewMetaData :: View -> FileView -> Key -> CommandStart+addViewMetaData v f k = do+	showStart "metadata" f+	next $ next $ changeMetaData k $ fromView v f++removeViewMetaData :: View -> FileView -> Key -> CommandStart+removeViewMetaData v f k = do+	showStart "metadata" f+	next $ next $ changeMetaData k $ unsetMetaData $ fromView v f++changeMetaData :: Key -> MetaData -> CommandCleanup+changeMetaData k metadata = do+	showMetaDataChange metadata+	addMetaData k metadata+	return True++showMetaDataChange :: MetaData -> Annex ()+showMetaDataChange = showLongNote . unlines . concatMap showmeta . fromMetaData+  where+	showmeta (f, vs) = map (showmetavalue f) $ S.toList vs+	showmetavalue f v = fromMetaField f ++ showset v ++ "=" ++ fromMetaValue v+	showset v+		| isSet v = "+"+		| otherwise = "-"
Command/Repair.hs view
@@ -81,4 +81,4 @@ trackingOrSyncBranch b = Git.Repair.isTrackingBranch b || isAnnexSyncBranch b  isAnnexSyncBranch :: Ref -> Bool-isAnnexSyncBranch b = "refs/synced/" `isPrefixOf` show b+isAnnexSyncBranch b = "refs/synced/" `isPrefixOf` fromRef b
Command/Semitrust.hs view
@@ -7,26 +7,13 @@  module Command.Semitrust where -import Common.Annex import Command-import qualified Remote-import Logs.Trust+import Types.TrustLevel+import Command.Trust (trustCommand)  def :: [Command] def = [command "semitrust" (paramRepeating paramRemote) seek 	SectionSetup "return repository to default trust level"]  seek :: CommandSeek-seek = withWords start--start :: [String] -> CommandStart-start ws = do-	let name = unwords ws-	showStart "semitrust" name-	u <- Remote.nameToUUID name-	next $ perform u--perform :: UUID -> CommandPerform-perform uuid = do-	trustSet uuid SemiTrusted-	next $ return True+seek = trustCommand "semitrust" SemiTrusted
Command/Sync.hs view
@@ -86,7 +86,7 @@ 		,  [ mergeAnnex ] 		] 	whenM (Annex.getFlag $ optionName contentOption) $-		whenM (seekSyncContent dataremotes) $ do+		whenM (seekSyncContent dataremotes) $ 			-- Transferring content can take a while, 			-- and other changes can be pushed to the git-annex 			-- branch on the remotes in the meantime, so pull@@ -192,12 +192,12 @@  updateBranch :: Git.Ref -> Git.Repo -> IO () updateBranch syncbranch g = -	unlessM go $ error $ "failed to update " ++ show syncbranch+	unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch   where 	go = Git.Command.runBool 		[ Param "branch" 		, Param "-f"-		, Param $ show $ Git.Ref.base syncbranch+		, Param $ Git.fromRef $ Git.Ref.base syncbranch 		] g  pullRemote :: Remote -> Maybe Git.Ref -> CommandStart@@ -224,7 +224,7 @@ 	Just _ -> and <$> (mapM merge =<< tomerge (branchlist b))   where 	merge = mergeFrom . remoteBranch remote-	tomerge branches = filterM (changed remote) branches+	tomerge = filterM (changed remote) 	branchlist Nothing = [] 	branchlist (Just branch) = [branch, syncBranch branch] @@ -283,15 +283,15 @@ 		, refspec branch 		] 	directpush = Git.Command.runQuiet $ pushparams-		[show $ Git.Ref.base $ fromDirectBranch branch]+		[Git.fromRef $ Git.Ref.base $ fromDirectBranch branch] 	pushparams branches = 		[ Param "push" 		, Param $ Remote.name remote 		] ++ map Param branches 	refspec b = concat -		[ show $ Git.Ref.base b+		[ Git.fromRef $ Git.Ref.base b 		,  ":"-		, show $ Git.Ref.base $ syncBranch b+		, Git.fromRef $ Git.Ref.base $ syncBranch b 		]  commitAnnex :: CommandStart@@ -452,7 +452,7 @@ 			Just target -> do 				unlessM (coreSymlinks <$> Annex.getGitConfig) $ 					addAnnexLink target f-				maybe noop (flip toDirect f) +				maybe noop (`toDirect` f)  					(fileKey (takeFileName target))  {- git-merge moves conflicting files away to files@@ -535,7 +535,7 @@  -} seekSyncContent :: [Remote] -> Annex Bool seekSyncContent rs = do-	mvar <- liftIO $ newEmptyMVar+	mvar <- liftIO newEmptyMVar 	mapM_ (go mvar) =<< seekHelper LsFiles.inRepo [] 	liftIO $ not <$> isEmptyMVar mvar   where@@ -552,7 +552,7 @@ 	putrs <- catMaybes . snd . unzip <$> (sequence =<< handleput lack)  	u <- getUUID-	let locs' = concat [if got then [u] else [], putrs, locs]+	let locs' = concat [[u | got], putrs, locs]  	-- Using callCommandAction rather than commandAction for drops, 	-- because a failure to drop does not mean the sync failed.@@ -576,7 +576,7 @@ 		| Remote.readonly r || remoteAnnexReadOnly (Types.Remote.gitconfig r) = return False 		| otherwise = wantSend True (Just k) (Just f) (Remote.uuid r) 	handleput lack = ifM (inAnnex k)-		( map put <$> (filterM wantput lack)+		( map put <$> filterM wantput lack 		, return [] 		) 	put dest = do
Command/Trust.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010 Joey Hess <joey@kitenet.net>+ - Copyright 2010, 2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -10,23 +10,32 @@ import Common.Annex import Command import qualified Remote+import Types.TrustLevel import Logs.Trust+import Logs.Group +import qualified Data.Set as S+ def :: [Command] def = [command "trust" (paramRepeating paramRemote) seek 	SectionSetup "trust a repository"]  seek :: CommandSeek-seek = withWords start--start :: [String] -> CommandStart-start ws = do-	let name = unwords ws-	showStart "trust" name-	u <- Remote.nameToUUID name-	next $ perform u+seek = trustCommand "trust" Trusted -perform :: UUID -> CommandPerform-perform uuid = do-	trustSet uuid Trusted-	next $ return True+trustCommand :: String -> TrustLevel -> CommandSeek+trustCommand cmd level = withWords start+  where+	start ws = do+		let name = unwords ws+		showStart cmd name+		u <- Remote.nameToUUID name+		next $ perform u+	perform uuid = do+		trustSet uuid level+		when (level == DeadTrusted) $+			groupSet uuid S.empty+		l <- lookupTrust uuid+		when (l /= level) $+			warning $ "This remote's trust level is locally overridden to " ++ showTrustLevel l ++ " via git config."+		next $ return True
Command/Uninit.hs view
@@ -24,7 +24,7 @@ check = do 	b <- current_branch 	when (b == Annex.Branch.name) $ error $-		"cannot uninit when the " ++ show b ++ " branch is checked out"+		"cannot uninit when the " ++ Git.fromRef b ++ " branch is checked out" 	top <- fromRepo Git.repoPath 	cwd <- liftIO getCurrentDirectory 	whenM ((/=) <$> liftIO (absPath top) <*> liftIO (absPath cwd)) $@@ -77,7 +77,7 @@ 	-- avoid normal shutdown 	saveState False 	inRepo $ Git.Command.run-		[Param "branch", Param "-D", Param $ show Annex.Branch.name]+		[Param "branch", Param "-D", Param $ Git.fromRef Annex.Branch.name] 	liftIO exitSuccess  {- Keys that were moved out of the annex have a hard link still in the
Command/Untrust.hs view
@@ -7,26 +7,13 @@  module Command.Untrust where -import Common.Annex import Command-import qualified Remote-import Logs.Trust+import Types.TrustLevel+import Command.Trust (trustCommand)  def :: [Command] def = [command "untrust" (paramRepeating paramRemote) seek 	SectionSetup "do not trust a repository"]  seek :: CommandSeek-seek = withWords start--start :: [String] -> CommandStart-start ws = do-	let name = unwords ws-	showStart "untrust" name-	u <- Remote.nameToUUID name-	next $ perform u--perform :: UUID -> CommandPerform-perform uuid = do-	trustSet uuid UnTrusted-	next $ return True+seek = trustCommand "untrust" UnTrusted
Command/Unused.hs view
@@ -266,7 +266,7 @@ 		map (separate (== ' ')) . 		lines 	nubRefs = map (Git.Ref . snd) . nubBy (\(x, _) (y, _) -> x == y)-	ourbranchend = '/' : show Annex.Branch.name+	ourbranchend = '/' : Git.fromRef Annex.Branch.name 	ourbranches (_, b) = not (ourbranchend `isSuffixOf` b) 		&& not ("refs/synced/" `isPrefixOf` b) 	addHead headRef refs = case headRef of
+ Command/VAdd.hs view
@@ -0,0 +1,36 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.VAdd where++import Common.Annex+import Command+import Annex.View+import Command.View (paramView, parseViewParam, checkoutViewBranch)++def :: [Command]+def = [notBareRepo $ notDirect $+	command "vadd" paramView seek SectionMetaData "add subdirs to current view"]++seek :: CommandSeek+seek = withWords start++start :: [String] -> CommandStart+start params = do+	showStart "vadd" ""+	withCurrentView $ \view -> do+		let (view', change) = refineView view $+			map parseViewParam $ reverse params+		case change of+			Unchanged -> do+				showNote "unchanged"+				next $ next $ return True+			Narrowing -> next $ next $ do+				if visibleViewSize view' == visibleViewSize view+					then error "That would not add an additional level of directory structure to the view. To filter the view, use vfilter instead of vadd."+					else checkoutViewBranch view' narrowView+			Widening -> error "Widening view to match more files is not currently supported."
+ Command/VCycle.hs view
@@ -0,0 +1,41 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.VCycle where++import Common.Annex+import Command+import Annex.View+import Types.View+import Logs.View+import Command.View (checkoutViewBranch)++def :: [Command]+def = [notBareRepo $ notDirect $+	command "vcycle" paramNothing seek SectionUtility+	"switch view to next layout"]++seek :: CommandSeek+seek = withNothing start++start ::CommandStart+start = go =<< currentView+  where+	go Nothing = error "Not in a view."+	go (Just v) = do+		showStart "vcycle" ""+		let v' = v { viewComponents = vcycle [] (viewComponents v) }+		if v == v'+			then do+				showNote "unchanged"+				next $ next $ return True+			else next $ next $ checkoutViewBranch v' narrowView++	vcycle rest (c:cs)+		| multiValue (viewFilter c) = rest ++ cs ++ [c]+		| otherwise = vcycle (c:rest) cs+	vcycle rest c = rest ++ c
+ Command/VFilter.hs view
@@ -0,0 +1,30 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.VFilter where++import Common.Annex+import Command+import Annex.View+import Command.View (paramView, parseViewParam, checkoutViewBranch)++def :: [Command]+def = [notBareRepo $ notDirect $+	command "vfilter" paramView seek SectionMetaData "filter current view"]++seek :: CommandSeek+seek = withWords start++start :: [String] -> CommandStart+start params = do+	showStart "vfilter" ""+	withCurrentView $ \view -> do+		let view' = filterView view $+			map parseViewParam $ reverse params+		next $ next $ if visibleViewSize view' > visibleViewSize view+			then error "That would add an additional level of directory structure to the view, rather than filtering it. If you want to do that, use vadd instead of vfilter."+			else checkoutViewBranch view' narrowView
+ Command/VPop.hs view
@@ -0,0 +1,50 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.VPop where++import Common.Annex+import Command+import qualified Git+import qualified Git.Command+import qualified Git.Ref+import Types.View+import Logs.View+import Command.View (checkoutViewBranch)++def :: [Command]+def = [notBareRepo $ notDirect $+	command "vpop" (paramOptional paramNumber) seek SectionMetaData+	"switch back to previous view"]++seek :: CommandSeek+seek = withWords start++start :: [String] -> CommandStart+start ps = go =<< currentView+  where+	go Nothing = error "Not in a view."+	go (Just v) = do+		showStart "vpop" (show num)+		removeView v+		(oldvs, vs) <- splitAt (num - 1) . filter (sameparentbranch v)+			<$> recentViews+		mapM_ removeView oldvs+		case vs of+			(oldv:_) -> next $ next $ do+				showOutput+				checkoutViewBranch oldv (return . branchView)+			_ -> next $ next $ do+				showOutput+				inRepo $ Git.Command.runBool+					[ Param "checkout"+					, Param $ Git.fromRef $ Git.Ref.base $+						viewParentBranch v+					]+	sameparentbranch a b = viewParentBranch a == viewParentBranch b++	num = fromMaybe 1 $ readish =<< headMaybe ps
+ Command/View.hs view
@@ -0,0 +1,90 @@+{- git-annex command+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Command.View where++import Common.Annex+import Command+import qualified Git+import qualified Git.Command+import qualified Git.Ref+import qualified Git.Branch+import Types.MetaData+import Types.View+import Annex.View+import Logs.View++def :: [Command]+def = [notBareRepo $ notDirect $+	command "view" paramView seek SectionMetaData "enter a view branch"]++seek :: CommandSeek+seek = withWords start++start :: [String] -> CommandStart+start [] = error "Specify metadata to include in view"+start params = do+	showStart "view" ""+	view <- mkView params+	go view  =<< currentView+  where+	go view Nothing = next $ perform view+	go view (Just v)+		| v == view = stop+		| otherwise = error "Already in a view. Use 'git annex vadd' to further refine this view."++perform :: View -> CommandPerform+perform view = do+	showSideAction "searching"+	next $ checkoutViewBranch view applyView++paramView :: String+paramView = paramPair (paramRepeating "FIELD=VALUE") (paramRepeating "TAG")++parseViewParam :: String -> (MetaField, String)+parseViewParam s = case separate (== '=') s of+	(tag, []) -> (tagMetaField, tag)+	(field, wanted) -> either error (\f -> (f, wanted)) (mkMetaField field)++mkView :: [String] -> Annex View+mkView params = do+	v <- View <$> viewbranch <*> pure []+	return $ fst $ refineView v $+		map parseViewParam $ reverse params+  where+	viewbranch = fromMaybe (error "not on any branch!")+		<$> inRepo Git.Branch.current++checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup+checkoutViewBranch view mkbranch = do+	oldcwd <- liftIO getCurrentDirectory++	{- Change to top of repository before creating view branch. -}+	liftIO . setCurrentDirectory =<< fromRepo Git.repoPath+	branch <- mkbranch view+	+	showOutput+	ok <- inRepo $ Git.Command.runBool+		[ Param "checkout"+		, Param (Git.fromRef $ Git.Ref.base branch)+		]+	when ok $ do+		setView view+		{- A git repo can easily have empty directories in it,+		 - and this pollutes the view, so remove them. -}+		liftIO $ removeemptydirs "."+		unlessM (liftIO $ doesDirectoryExist oldcwd) $ do+			top <- fromRepo Git.repoPath+			showLongNote (cwdmissing top)+	return ok+  where+	removeemptydirs top = mapM_ (tryIO . removeDirectory)+		=<< dirTreeRecursiveSkipping (".git" `isSuffixOf`) top+	cwdmissing top = unlines+		[ "This view does not include the subdirectory you are currently in."+		, "Perhaps you should:  cd " ++ top+		]
Creds.hs view
@@ -1,29 +1,34 @@ {- Credentials storage  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -} -{-# LANGUAGE CPP #-}--module Creds where+module Creds (+	module Types.Creds,+	CredPairStorage(..),+	setRemoteCredPair,+	getRemoteCredPairFor,+	getRemoteCredPair,+	getEnvCredPair,+	writeCacheCreds,+	readCacheCreds,+) where  import Common.Annex+import Types.Creds import Annex.Perms import Utility.FileMode import Crypto import Types.Remote (RemoteConfig, RemoteConfigKey) import Remote.Helper.Encryptable (remoteCipher, embedCreds)-import Utility.Env (setEnv, getEnv)+import Utility.Env (getEnv)  import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import Utility.Base64 -type Creds = String -- can be any data-type CredPair = (String, String) -- login, password- {- A CredPair can be stored in a file, or in the environment, or perhaps  - in a remote's configuration. -} data CredPairStorage = CredPairStorage@@ -33,14 +38,13 @@ 	}  {- Stores creds in a remote's configuration, if the remote allows- - that. Otherwise, caches them locally. -}-setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Annex RemoteConfig-setRemoteCredPair c storage = -	maybe (return c) (setRemoteCredPair' c storage)+ - that. Otherwise, caches them locally.+ - The creds are found in storage if not provided. -}+setRemoteCredPair :: RemoteConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig+setRemoteCredPair c storage Nothing = +	maybe (return c) (setRemoteCredPair c storage . Just) 		=<< getRemoteCredPair c storage--setRemoteCredPair' :: RemoteConfig -> CredPairStorage -> CredPair -> Annex RemoteConfig-setRemoteCredPair' c storage creds+setRemoteCredPair c storage (Just creds) 	| embedCreds c = case credPairRemoteKey storage of 		Nothing -> localcache 		Just key -> storeconfig key =<< remoteCipher c@@ -104,19 +108,6 @@ 	<*> getEnv penv   where 	(uenv, penv) = credPairEnvironment storage--{- Stores a CredPair in the environment. -}-setEnvCredPair :: CredPair -> CredPairStorage -> IO ()-#ifndef mingw32_HOST_OS-setEnvCredPair (l, p) storage = do-	set uenv l-	set penv p-  where-	(uenv, penv) = credPairEnvironment storage-	set var val = void $ setEnv var val True-#else-setEnvCredPair _ _ = error "setEnvCredPair TODO"-#endif  writeCacheCredPair :: CredPair -> CredPairStorage -> Annex () writeCacheCredPair credpair storage =
Git.hs view
@@ -13,6 +13,7 @@ module Git ( 	Repo(..), 	Ref(..),+	fromRef, 	Branch, 	Sha, 	Tag,
Git/Branch.hs view
@@ -28,7 +28,7 @@ 	case v of 		Nothing -> return Nothing 		Just branch -> -			ifM (null <$> pipeReadStrict [Param "show-ref", Param $ show branch] r)+			ifM (null <$> pipeReadStrict [Param "show-ref", Param $ fromRef branch] r) 				( return Nothing 				, return v 				)@@ -36,7 +36,7 @@ {- The current branch, which may not really exist yet. -} currentUnsafe :: Repo -> IO (Maybe Git.Ref) currentUnsafe r = parse . firstLine-	<$> pipeReadStrict [Param "symbolic-ref", Param $ show Git.Ref.headRef] r+	<$> pipeReadStrict [Param "symbolic-ref", Param $ fromRef Git.Ref.headRef] r   where 	parse l 		| null l = Nothing@@ -51,7 +51,7 @@   where 	diffs = pipeReadStrict 		[ Param "log"-		, Param (show origbranch ++ ".." ++ show newbranch)+		, Param (fromRef origbranch ++ ".." ++ fromRef newbranch) 		, Params "--oneline -n1" 		] repo @@ -74,7 +74,7 @@   where 	no_ff = return False 	do_ff to = do-		run [Param "update-ref", Param $ show branch, Param $ show to] repo+		run [Param "update-ref", Param $ fromRef branch, Param $ fromRef to] repo 		return True 	findbest c [] = return $ Just c 	findbest c (r:rs)@@ -104,14 +104,14 @@ 	ifM (cancommit tree) 		( do 			sha <- getSha "commit-tree" $ pipeWriteRead-				(map Param $ ["commit-tree", show tree] ++ ps)+				(map Param $ ["commit-tree", fromRef tree] ++ ps) 				(Just $ flip hPutStr message) repo 			update branch sha repo 			return $ Just sha 		, return Nothing 		)   where-	ps = concatMap (\r -> ["-p", show r]) parentrefs+	ps = concatMap (\r -> ["-p", fromRef r]) parentrefs 	cancommit tree 		| allowempty = return True 		| otherwise = case parentrefs of@@ -130,8 +130,8 @@ update :: Branch -> Sha -> Repo -> IO () update branch sha = run  	[ Param "update-ref"-	, Param $ show branch-	, Param $ show sha+	, Param $ fromRef branch+	, Param $ fromRef sha 	]  {- Checks out a branch, creating it if necessary. -}@@ -140,7 +140,7 @@ 	[ Param "checkout" 	, Param "-q" 	, Param "-B"-	, Param $ show $ Git.Ref.base branch+	, Param $ fromRef $ Git.Ref.base branch 	]  {- Removes a branch. -}@@ -149,5 +149,5 @@ 	[ Param "branch" 	, Param "-q" 	, Param "-D"-	, Param $ show $ Git.Ref.base branch+	, Param $ fromRef $ Git.Ref.base branch 	]
Git/CatFile.hs view
@@ -50,7 +50,7 @@ {- Reads a file from a specified branch. -} catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString catFile h branch file = catObject h $ Ref $-	show branch ++ ":" ++ toInternalGitPath file+	fromRef branch ++ ":" ++ toInternalGitPath file  {- Uses a running git cat-file read the content of an object.  - Objects that do not exist will have "" returned. -}@@ -60,7 +60,7 @@ catObjectDetails :: CatFileHandle -> Ref -> IO (Maybe (L.ByteString, Sha, ObjectType)) catObjectDetails (CatFileHandle hdl _) object = CoProcess.query hdl send receive   where-	query = show object+	query = fromRef object 	send to = hPutStrLn to query 	receive from = do 		header <- hGetLine from@@ -72,8 +72,8 @@ 						_ -> dne 				| otherwise -> dne 			_-				| header == show object ++ " missing" -> dne-				| otherwise -> error $ "unknown response from git cat-file " ++ show (header, object)+				| header == fromRef object ++ " missing" -> dne+				| otherwise -> error $ "unknown response from git cat-file " ++ show (header, query) 	readcontent objtype bytes from sha = do 		content <- S.hGet from bytes 		eatchar '\n' from
Git/Command.hs view
@@ -25,18 +25,10 @@ gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) = 	setdir : settree ++ gitGlobalOpts r ++ params   where-	setdir = Param $ "--git-dir=" ++ gitpath (gitdir l)+	setdir = Param $ "--git-dir=" ++ gitdir l 	settree = case worktree l of 		Nothing -> []-		Just t -> [Param $ "--work-tree=" ++ gitpath t]-#ifdef mingw32_HOST_OS-	-- despite running on windows, msysgit wants a unix-formatted path-	gitpath s-		| absoluteGitPath s = "/" ++ dropDrive (toInternalGitPath s)-		| otherwise = s-#else-	gitpath = id-#endif+		Just t -> [Param $ "--work-tree=" ++ t] gitCommandLine _ repo = assertLocal repo $ error "internal"  {- Runs git in the specified repo. -}
Git/DiffTree.hs view
@@ -36,12 +36,12 @@ {- Diffs two tree Refs. -} diffTree :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool) diffTree src dst = getdiff (Param "diff-tree")-	[Param (show src), Param (show dst)]+	[Param (fromRef src), Param (fromRef dst)]  {- Diffs two tree Refs, recursing into sub-trees -} diffTreeRecursive :: Ref -> Ref -> Repo -> IO ([DiffTreeItem], IO Bool) diffTreeRecursive src dst = getdiff (Param "diff-tree")-	[Param "-r", Param (show src), Param (show dst)]+	[Param "-r", Param (fromRef src), Param (fromRef dst)]  {- Diffs between a tree and the index. Does nothing if there is not yet a  - commit in the repository. -}@@ -61,7 +61,7 @@ diffIndex' ref params repo = 	ifM (Git.Ref.headExists repo) 		( getdiff (Param "diff-index")-			( params ++ [Param $ show ref] )+			( params ++ [Param $ fromRef ref] ) 			repo 		, return ([], return True) 		)
Git/Fsck.hs view
@@ -74,7 +74,7 @@   where 	dump = runQuiet 		[ Param "show"-		, Param (show s)+		, Param (fromRef s) 		] r  findShas :: Bool -> String -> [Sha]
Git/HashObject.hs view
@@ -1,6 +1,6 @@ {- git hash-object interface  -- - Copyright 2011-2012 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -13,6 +13,7 @@ import Git.Command import Git.Types import qualified Utility.CoProcess as CoProcess+import Utility.Tmp  type HashObjectHandle = CoProcess.CoProcessHandle @@ -34,7 +35,18 @@ 	send to = hPutStrLn to file 	receive from = getSha "hash-object" $ hGetLine from -{- Injects some content into git, returning its Sha. -}+{- Injects a blob into git. Unfortunately, the current git-hash-object+ - interface does not allow batch hashing without using temp files. -}+hashBlob :: HashObjectHandle -> String -> IO Sha+hashBlob h s = withTmpFile "hash" $ \tmp tmph -> do+	hPutStr tmph s+	hClose tmph+	hashFile h tmp++{- Injects some content into git, returning its Sha.+ - + - Avoids using a tmp file, but runs a new hash-object command each+ - time called. -} hashObject :: ObjectType -> String -> Repo -> IO Sha hashObject objtype content = hashObject' objtype (flip hPutStr content)
Git/LsTree.hs view
@@ -38,13 +38,13 @@ 	<$> pipeNullSplitZombie (lsTreeParams t) repo  lsTreeParams :: Ref -> [CommandParam]-lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ show t ]+lsTreeParams t = [ Params "ls-tree --full-tree -z -r --", File $ fromRef t ]  {- Lists specified files in a tree. -} lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem] lsTreeFiles t fs repo = map parseLsTree <$> pipeNullSplitStrict ps repo   where-  	ps = [Params "ls-tree --full-tree -z --", File $ show t] ++ map File fs+  	ps = [Params "ls-tree --full-tree -z --", File $ fromRef t] ++ map File fs  {- Parses a line of ls-tree output.  - (The --long format is not currently supported.) -}
Git/Merge.hs view
@@ -15,7 +15,7 @@ {- Avoids recent git's interactive merge. -} mergeNonInteractive :: Ref -> Repo -> IO Bool mergeNonInteractive branch-	| older "1.7.7.6" = merge [Param $ show branch]-	| otherwise = merge [Param "--no-edit", Param $ show branch]+	| older "1.7.7.6" = merge [Param $ fromRef branch]+	| otherwise = merge [Param "--no-edit", Param $ fromRef branch]   where 	merge ps = runBool $ Param "merge" : ps
Git/Objects.hs view
@@ -32,4 +32,4 @@ looseObjectFile :: Repo -> Sha -> FilePath looseObjectFile r sha = objectsDir r </> prefix </> rest   where-	(prefix, rest) = splitAt 2 (show sha)+	(prefix, rest) = splitAt 2 (fromRef sha)
Git/Ref.hs view
@@ -20,12 +20,12 @@  {- Converts a fully qualified git ref into a user-visible string. -} describe :: Ref -> String-describe = show . base+describe = fromRef . base  {- Often git refs are fully qualified (eg: refs/heads/master).  - Converts such a fully qualified ref into a base ref (eg: master). -} base :: Ref -> Ref-base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show+base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef   where 	remove prefix s 		| prefix `isPrefixOf` s = drop (length prefix) s@@ -35,13 +35,13 @@  - it under the directory. -} under :: String -> Ref -> Ref under dir r = Ref $ dir ++ "/" ++-	(reverse $ takeWhile (/= '/') $ reverse $ show r)+	(reverse $ takeWhile (/= '/') $ reverse $ fromRef r)  {- Given a directory such as "refs/remotes/origin", and a ref such as  - refs/heads/master, yields a version of that ref under the directory,  - such as refs/remotes/origin/master. -} underBase :: String -> Ref -> Ref-underBase dir r = Ref $ dir ++ "/" ++ show (base r)+underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r)  {- A Ref that can be used to refer to a file in the repository, as staged  - in the index.@@ -64,12 +64,12 @@ {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool-	[Param "show-ref", Param "--verify", Param "-q", Param $ show ref]+	[Param "show-ref", Param "--verify", Param "-q", Param $ fromRef ref]  {- The file used to record a ref. (Git also stores some refs in a  - packed-refs file.) -} file :: Ref -> Repo -> FilePath-file ref repo = localGitDir repo </> show ref+file ref repo = localGitDir repo </> fromRef ref  {- Checks if HEAD exists. It generally will, except for in a repository  - that was just created. -}@@ -84,17 +84,17 @@   where 	showref = pipeReadStrict [Param "show-ref", 		Param "--hash", -- get the hash-		Param $ show branch]+		Param $ fromRef branch] 	process [] = Nothing 	process s = Just $ Ref $ firstLine s  {- List of (shas, branches) matching a given ref or refs. -} matching :: [Ref] -> Repo -> IO [(Sha, Branch)]-matching refs repo =  matching' (map show refs) repo+matching refs repo =  matching' (map fromRef refs) repo  {- Includes HEAD in the output, if asked for it. -} matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]-matchingWithHEAD refs repo = matching' ("--head" : map show refs) repo+matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo  {- List of (shas, branches) matching a given ref or refs. -} matching' :: [String] -> Repo -> IO [(Sha, Branch)]@@ -114,7 +114,7 @@ {- Gets the sha of the tree a ref uses. -} tree :: Ref -> Repo -> IO (Maybe Sha) tree ref = extractSha <$$> pipeReadStrict-	[ Param "rev-parse", Param (show ref ++ ":") ]+	[ Param "rev-parse", Param (fromRef ref ++ ":") ]  {- Checks if a String is a legal git ref name.  -
Git/RefLog.hs view
@@ -18,5 +18,5 @@ 	[ Param "log" 	, Param "-g" 	, Param "--format=%H"-	, Param (show b)+	, Param (fromRef b) 	]
Git/Repair.hs view
@@ -168,7 +168,7 @@ resetLocalBranches missing goodcommits r = 	go [] [] goodcommits =<< filter islocalbranch <$> getAllRefs r   where-	islocalbranch b = "refs/heads/" `isPrefixOf` show b+	islocalbranch b = "refs/heads/" `isPrefixOf` fromRef b 	go changed deleted gcs [] = return (changed, deleted, gcs) 	go changed deleted gcs (b:bs) = do 		(mc, gcs') <- findUncorruptedCommit missing gcs b r@@ -185,12 +185,12 @@ 		nukeBranchRef b	r 		void $ runBool 			[ Param "branch"-			, Param (show $ Ref.base b)-			, Param (show c)+			, Param (fromRef $ Ref.base b)+			, Param (fromRef c) 			] r  isTrackingBranch :: Ref -> Bool-isTrackingBranch b = "refs/remotes/" `isPrefixOf` show b+isTrackingBranch b = "refs/remotes/" `isPrefixOf` fromRef b  {- To deal with missing objects that cannot be recovered, removes  - any branches (filtered by a predicate) that reference them@@ -231,10 +231,10 @@ 		nukeFile f   where 	makeref (sha, ref) = do-		let dest = localGitDir r </> show ref+		let dest = localGitDir r </> fromRef ref 		createDirectoryIfMissing True (parentDir dest) 		unlessM (doesFileExist dest) $-			writeFile dest (show sha)+			writeFile dest (fromRef sha)  packedRefsFile :: Repo -> FilePath packedRefsFile r = localGitDir r </> "packed-refs"@@ -249,7 +249,7 @@ {- git-branch -d cannot be used to remove a branch that is directly  - pointing to a corrupt commit. -} nukeBranchRef :: Branch -> Repo -> IO ()-nukeBranchRef b r = nukeFile $ localGitDir r </> show b+nukeBranchRef b r = nukeFile $ localGitDir r </> fromRef b  {- Finds the most recent commit to a branch that does not need any  - of the missing objects. If the input branch is good as-is, returns it.@@ -268,7 +268,7 @@ 				[ Param "log" 				, Param "-z" 				, Param "--format=%H"-				, Param (show branch)+				, Param (fromRef branch) 				] r 			let branchshas = catMaybes $ map extractSha ls 			reflogshas <- RefLog.get branch r@@ -297,7 +297,7 @@ 			[ Param "log" 			, Param "-z" 			, Param "--format=%H %T"-			, Param (show commit)+			, Param (fromRef commit) 			] r 		let committrees = map parse ls 		if any isNothing committrees || null committrees@@ -501,9 +501,9 @@ 				, "remote tracking branches that referred to missing objects." 				] 		(resetbranches, deletedbranches, _) <- resetLocalBranches stillmissing goodcommits g-		displayList (map show resetbranches)+		displayList (map fromRef resetbranches) 			"Reset these local branches to old versions before the missing objects were committed:"-		displayList (map show deletedbranches)+		displayList (map fromRef deletedbranches) 			"Deleted these local branches, which could not be recovered due to missing objects:" 		deindexedfiles <- rewriteIndex g 		displayList deindexedfiles@@ -519,7 +519,7 @@ 						Just curr -> when (any (== curr) modifiedbranches) $ do 							putStrLn $ unwords 								[ "You currently have"-								, show curr+								, fromRef curr 								, "checked out. You may have staged changes in the index that can be committed to recover the lost state of this branch!" 								] 				putStrLn "Successfully recovered repository!"
Git/Sha.hs view
@@ -37,3 +37,7 @@  nullSha :: Ref		 nullSha = Ref $ replicate shaSize '0'++{- Git's magic empty tree. -}+emptyTree :: Ref+emptyTree = Ref "4b825dc642cb6eb9a060e54bf8d69288fbee4904"
Git/Types.hs view
@@ -47,10 +47,10 @@  {- A git ref. Can be a sha1, or a branch or tag name. -} newtype Ref = Ref String-	deriving (Eq, Ord)+	deriving (Eq, Ord, Read, Show) -instance Show Ref where-	show (Ref v) = v+fromRef :: Ref -> String+fromRef (Ref s) = s  {- Aliases for Ref. -} type Branch = Ref
Git/UpdateIndex.hs view
@@ -11,6 +11,9 @@ 	Streamer, 	pureStreamer, 	streamUpdateIndex,+	streamUpdateIndex',+	startUpdateIndex,+	stopUpdateIndex, 	lsTree, 	updateIndexLine, 	stageFile,@@ -25,6 +28,9 @@ import Git.FilePath import Git.Sha +import Control.Exception (bracket)+import System.Process (std_in)+ {- Streamers are passed a callback and should feed it lines in the form  - read by update-index, and generated by ls-tree. -} type Streamer = (String -> IO ()) -> IO ()@@ -35,17 +41,30 @@  {- Streams content into update-index from a list of Streamers. -} streamUpdateIndex :: Repo -> [Streamer] -> IO ()-streamUpdateIndex repo as = pipeWrite params repo $ \h -> do+streamUpdateIndex repo as = bracket (startUpdateIndex repo) stopUpdateIndex $+	(\h -> forM_ as $ streamUpdateIndex' h)++data UpdateIndexHandle = UpdateIndexHandle ProcessHandle Handle++streamUpdateIndex' :: UpdateIndexHandle -> Streamer -> IO ()+streamUpdateIndex' (UpdateIndexHandle _ h) a = a $ \s -> do+	hPutStr h s+	hPutStr h "\0"++startUpdateIndex :: Repo -> IO UpdateIndexHandle+startUpdateIndex repo = do+	(Just h, _, _, p) <- createProcess (gitCreateProcess params repo)+		{ std_in = CreatePipe } 	fileEncoding h-	forM_ as (stream h)-	hClose h+	return $ UpdateIndexHandle p h   where 	params = map Param ["update-index", "-z", "--index-info"]-	stream h a = a (streamer h)-	streamer h s = do-		hPutStr h s-		hPutStr h "\0" +stopUpdateIndex :: UpdateIndexHandle -> IO Bool+stopUpdateIndex (UpdateIndexHandle p h) = do+	hClose h+	checkSuccessProcess p+ {- A streamer that adds the current tree for a ref. Useful for eg, copying  - and modifying branches. -} lsTree :: Ref -> Repo -> Streamer@@ -60,7 +79,7 @@  - a given file with a given sha. -} updateIndexLine :: Sha -> BlobType -> TopFilePath -> String updateIndexLine sha filetype file =-	show filetype ++ " blob " ++ show sha ++ "\t" ++ indexPath file+	show filetype ++ " blob " ++ fromRef sha ++ "\t" ++ indexPath file  stageFile :: Sha -> BlobType -> FilePath -> Repo -> IO Streamer stageFile sha filetype file repo = do@@ -71,7 +90,7 @@ unstageFile :: FilePath -> Repo -> IO Streamer unstageFile file repo = do 	p <- toTopFilePath file repo-	return $ pureStreamer $ "0 " ++ show nullSha ++ "\t" ++ indexPath p+	return $ pureStreamer $ "0 " ++ fromRef nullSha ++ "\t" ++ indexPath p  {- A streamer that adds a symlink to the index. -} stageSymlink :: FilePath -> Sha -> Repo -> IO Streamer
Limit.hs view
@@ -9,11 +9,6 @@  module Limit where -import Data.Time.Clock.POSIX-import qualified Data.Set as S-import qualified Data.Map as M-import System.Path.WildMatch- import Common.Annex import qualified Annex import qualified Utility.Matcher@@ -28,6 +23,8 @@ import Types.Group import Types.FileMatcher import Types.Limit+import Types.MetaData+import Logs.MetaData import Logs.Group import Logs.Unused import Logs.Location@@ -35,15 +32,15 @@ import Utility.HumanTime import Utility.DataUnits +import Data.Time.Clock.POSIX+import qualified Data.Set as S+import qualified Data.Map as M+import System.Path.WildMatch+ #ifdef WITH_TDFA import Text.Regex.TDFA import Text.Regex.TDFA.String-#else-#ifndef mingw32_HOST_OS-import System.Path.WildMatch-import Types.FileMatcher #endif-#endif  {- Checks if there are user-specified limits. -} limited :: Annex Bool@@ -156,7 +153,7 @@ limitInDir :: FilePath -> MkLimit limitInDir dir = const $ Right $ const go   where-	go (MatchingFile fi) = return $ any (== dir) $ splitPath $ takeDirectory $ matchFile fi+	go (MatchingFile fi) = return $ elem dir $ splitPath $ takeDirectory $ matchFile fi 	go (MatchingKey _) = return False  {- Adds a limit to skip files not believed to have the specified number@@ -266,6 +263,16 @@ 			fromIntegral . fileSize 				<$> getFileStatus (relFile fi) 		return $ filesize `vs` Just sz++addMetaData :: String -> Annex ()+addMetaData = addLimit . limitMetaData++limitMetaData :: MkLimit+limitMetaData s = case parseMetaData s of+	Left e -> Left e+	Right (f, v) -> Right $ const $ checkKey (check f v)+  where+  	check f v k = S.member v . metaDataValues f <$> getCurrentMetaData k  addTimeLimit :: String -> Annex () addTimeLimit s = do
Locations.hs view
@@ -40,6 +40,8 @@ 	gitAnnexJournalLock, 	gitAnnexIndex, 	gitAnnexIndexStatus,+	gitAnnexViewIndex,+	gitAnnexViewLog, 	gitAnnexIgnoredRefs, 	gitAnnexPidFile, 	gitAnnexDaemonStatusFile,@@ -252,6 +254,14 @@ gitAnnexIndexStatus :: Git.Repo -> FilePath gitAnnexIndexStatus r = gitAnnexDir r </> "index.lck" +{- The index file used to generate a filtered branch view._-}+gitAnnexViewIndex :: Git.Repo -> FilePath+gitAnnexViewIndex r = gitAnnexDir r </> "viewindex"++{- File containing a log of recently accessed views. -}+gitAnnexViewLog :: Git.Repo -> FilePath+gitAnnexViewLog r = gitAnnexDir r </> "viewlog"+ {- List of refs that should not be merged into the git-annex branch. -} gitAnnexIgnoredRefs :: Git.Repo -> FilePath gitAnnexIgnoredRefs r = gitAnnexDir r </> "ignoredrefs"@@ -330,7 +340,7 @@ 		-- other characters. By itself, it is escaped to  		-- doubled form. 		| c == ',' = ",,"-		| otherwise = ',' : show(ord(c))+		| otherwise = ',' : show (ord c)  {- Converts a key into a filename fragment without any directory.  -
Logs.hs view
@@ -1,6 +1,6 @@ {- git-annex log file names  -- - Copyright 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -15,7 +15,7 @@ 	= UUIDBasedLog 	| NewUUIDBasedLog 	| PresenceLog Key-	| SingleValueLog+	| OtherLog 	deriving (Show)  {- Converts a path from the git-annex branch into one of the varieties@@ -24,7 +24,7 @@ getLogVariety f 	| f `elem` topLevelUUIDBasedLogs = Just UUIDBasedLog 	| isRemoteStateLog f = Just NewUUIDBasedLog-	| f == numcopiesLog = Just SingleValueLog+	| isMetaDataLog f || f == numcopiesLog = Just OtherLog 	| otherwise = PresenceLog <$> firstJust (presenceLogs f)  {- All the uuid-based logs stored in the top of the git-annex branch. -}@@ -119,14 +119,25 @@ isRemoteStateLog :: FilePath -> Bool isRemoteStateLog path = remoteStateLogExt `isSuffixOf` path +{- The filename of the metadata log for a given key. -}+metaDataLogFile :: Key -> FilePath+metaDataLogFile key = hashDirLower key </> keyFile key ++ metaDataLogExt++metaDataLogExt :: String+metaDataLogExt = ".log.met"++isMetaDataLog :: FilePath -> Bool+isMetaDataLog path = metaDataLogExt `isSuffixOf` path+ prop_logs_sane :: Key -> Bool-prop_logs_sane dummykey = all id+prop_logs_sane dummykey = and 	[ isNothing (getLogVariety "unknown") 	, expect isUUIDBasedLog (getLogVariety uuidLog) 	, expect isPresenceLog (getLogVariety $ locationLogFile dummykey) 	, expect isPresenceLog (getLogVariety $ urlLogFile dummykey) 	, expect isNewUUIDBasedLog (getLogVariety $ remoteStateLogFile dummykey)-	, expect isSingleValueLog (getLogVariety $ numcopiesLog)+	, expect isOtherLog (getLogVariety $ metaDataLogFile dummykey)+	, expect isOtherLog (getLogVariety $ numcopiesLog) 	]   where   	expect = maybe False@@ -136,5 +147,5 @@ 	isNewUUIDBasedLog _ = False 	isPresenceLog (PresenceLog k) = k == dummykey 	isPresenceLog _ = False-	isSingleValueLog SingleValueLog = True-	isSingleValueLog _ = False+	isOtherLog OtherLog = True+	isOtherLog _ = False
Logs/FsckResults.hs view
@@ -31,7 +31,7 @@   	store s logfile = do  		createDirectoryIfMissing True (parentDir logfile) 		liftIO $ viaTmp writeFile logfile $ serialize s-	serialize = unlines . map show . S.toList+	serialize = unlines . map fromRef . S.toList  readFsckResults :: UUID -> Annex FsckResults readFsckResults u = do
+ Logs/MetaData.hs view
@@ -0,0 +1,137 @@+{- git-annex general metadata storage log+ -+ - A line of the log will look like "timestamp field [+-]value [...]"+ -+ - Note that unset values are preserved. Consider this case:+ -+ - We have:+ -+ - 100 foo +x+ - 200 foo -x+ -+ - An unmerged remote has:+ -+ - 150 foo +x+ - + - After union merge, because the foo -x was preserved, we know that+ - after the other remote redundantly set foo +x, it was unset,+ - and so foo currently has no value.+ -+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-}++module Logs.MetaData (+	getCurrentMetaData,+	getMetaData,+	addMetaData,+	addMetaData',+	currentMetaData,+) where++import Common.Annex+import Types.MetaData+import qualified Annex.Branch+import Logs+import Logs.SingleValue++import qualified Data.Set as S+import Data.Time.Clock.POSIX++instance SingleValueSerializable MetaData where+	serialize = Types.MetaData.serialize+	deserialize = Types.MetaData.deserialize++getMetaData :: Key -> Annex (Log MetaData)+getMetaData = readLog . metaDataLogFile++{- Go through the log from oldest to newest, and combine it all+ - into a single MetaData representing the current state. -}+getCurrentMetaData :: Key -> Annex MetaData+getCurrentMetaData = currentMetaData . collect <$$> getMetaData+  where+	collect = foldl' unionMetaData newMetaData . map value . S.toAscList++{- Adds in some metadata, which can override existing values, or unset+ - them, but otherwise leaves any existing metadata as-is. -}+addMetaData :: Key -> MetaData -> Annex ()+addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime++{- Reusing the same timestamp when making changes to the metadata+ - of multiple keys is a nice optimisation. The same metadata lines+ - will tend to be generated across the different log files, and so+ - git will be able to pack the data more efficiently. -}+addMetaData' :: Key -> MetaData -> POSIXTime -> Annex ()+addMetaData' k metadata now = Annex.Branch.change (metaDataLogFile k) $+	showLog . simplifyLog +		. S.insert (LogEntry now metadata) +		. parseLog++{- Simplify a log, removing historical values that are no longer+ - needed. + -+ - This is not as simple as just making a single log line with the newest+ - state of all metadata. Consider this case:+ -+ - We have:+ -+ - 100 foo +x bar +y+ - 200 foo -x+ -+ - An unmerged remote has:+ -+ - 150 bar -y baz +w+ -+ - If what we have were simplified to "200 foo -x bar +y" then when the line+ - from the remote became available, it would be older than the simplified+ - line, and its change to bar would not take effect. That is wrong.+ -+ - Instead, simplify it to:+ -+ - 100 bar +y+ - 200 foo -x+ -+ - (Note that this ends up with the same number of lines as the+ - unsimplified version, so there's really no point in updating+ - the log to this version. Doing so would only add data to git,+ - with little benefit.)+ -+ - Now merging with the remote yields:+ -+ - 100 bar +y+ - 150 bar -y baz +w+ - 200 foo -x+ -+ - Simplifying again:+ -+ - 150 bar +z baz +w+ - 200 foo -x+ -}+simplifyLog :: Log MetaData -> Log MetaData+simplifyLog s = case sl of+	(newest:rest) -> +		let sl' = go [newest] (value newest) rest+		in if length sl' < length sl+			then S.fromList sl'+			else s+	_ -> s+  where+#if MIN_VERSION_containers(0,5,0)+	sl = S.toDescList s+#else+	sl = reverse (S.toAscList s)+#endif++	go c _ [] = c+	go c newer (l:ls)+		| unique == newMetaData = go c newer ls+		| otherwise = go (l { value = unique } : c)+			(unionMetaData unique newer) ls+	  where+		older = value l+		unique = older `differenceMetaData` newer
Logs/Transfer.hs view
@@ -17,6 +17,10 @@ import Utility.Metered import Utility.Percentage import Utility.QuickCheck+import Utility.PID+#ifdef mingw32_HOST_OS+import Utility.WinLock+#endif  import Data.Time.Clock import Data.Time.Clock.POSIX@@ -24,20 +28,6 @@ import System.Locale import Control.Concurrent -#ifndef mingw32_HOST_OS-import System.Posix.Types (ProcessID)-#else-import System.Win32.Process (ProcessId)-import System.Win32.Process.Current (getCurrentProcessId)-import Utility.WinLock-#endif--#ifndef mingw32_HOST_OS-type PID = ProcessID-#else-type PID = ProcessId-#endif- {- Enough information to uniquely identify a transfer, used as the filename  - of the transfer information file. -} data Transfer = Transfer@@ -231,7 +221,7 @@ #ifndef mingw32_HOST_OS 	<*> pure Nothing -- pid not stored in file, so omitted for speed #else-	<*> (Just <$> getCurrentProcessId)+	<*> (Just <$> getPID) #endif 	<*> pure Nothing -- tid ditto 	<*> pure Nothing -- not 0; transfer may be resuming
+ Logs/View.hs view
@@ -0,0 +1,89 @@+{- git-annex recent views log+ -+ - The most recently accessed view comes first.+ -+ - This file is stored locally in .git/annex/, not in the git-annex branch.+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Logs.View (+	currentView,+	setView,+	removeView,+	recentViews,+	branchView,+	prop_branchView_legal,+) where++import Common.Annex+import Types.View+import Types.MetaData+import qualified Git+import qualified Git.Branch+import qualified Git.Ref+import Git.Types+import Utility.Tmp++import qualified Data.Set as S+import Data.Char++setView :: View -> Annex ()+setView v = do+	old <- take 99 . filter (/= v) <$> recentViews+	writeViews (v : old)++writeViews :: [View] -> Annex ()+writeViews l = do+	f <- fromRepo gitAnnexViewLog+	liftIO $ viaTmp writeFile f $ unlines $ map show l++removeView :: View -> Annex ()+removeView v = writeViews =<< filter (/= v) <$> recentViews++recentViews :: Annex [View]+recentViews = do+	f <- fromRepo gitAnnexViewLog+	liftIO $ mapMaybe readish . lines <$> catchDefaultIO [] (readFile f)++{- Gets the currently checked out view, if there is one. -}+currentView :: Annex (Maybe View)+currentView = go =<< inRepo Git.Branch.current+  where+	go (Just b) | branchViewPrefix `isPrefixOf` fromRef b =+		headMaybe . filter (\v -> branchView v == b) <$> recentViews+	go _ = return Nothing++branchViewPrefix :: String+branchViewPrefix = "refs/heads/views"++{- Generates a git branch name for a View.+ - + - There is no guarantee that each view gets a unique branch name,+ - but the branch name is used to express the view as well as possible.+ -}+branchView :: View -> Git.Branch+branchView view+	| null name = Git.Ref branchViewPrefix+	| otherwise = Git.Ref $ branchViewPrefix ++ "/" ++ name+  where+	name = intercalate ";" $ map branchcomp (viewComponents view)+	branchcomp c+		| viewVisible c = branchcomp' c+		| otherwise = "(" ++ branchcomp' c ++ ")"+	branchcomp' (ViewComponent metafield viewfilter _) =concat+		[ forcelegal (fromMetaField metafield)+		, "="+		, branchvals viewfilter+		]+	branchvals (FilterValues set) = intercalate "," $+		map (forcelegal . fromMetaValue) $ S.toList set+	branchvals (FilterGlob glob) = forcelegal glob+	forcelegal s+		| Git.Ref.legal True s = s+		| otherwise = map (\c -> if isAlphaNum c then c else '_') s++prop_branchView_legal :: View -> Bool+prop_branchView_legal = Git.Ref.legal False . fromRef . branchView
Makefile view
@@ -252,6 +252,7 @@  distributionupdate: 	git pull+	cabal configure 	ghc --make Build/DistributionUpdate 	./Build/DistributionUpdate
Remote.hs view
@@ -189,8 +189,7 @@ remoteFromUUID :: UUID -> Annex (Maybe Remote) remoteFromUUID u = ifM ((==) u <$> getUUID) 	( return Nothing-	, do-		maybe tryharder (return . Just) =<< findinmap+	, maybe tryharder (return . Just) =<< findinmap 	)   where 	findinmap = M.lookup u <$> remoteMap id
Remote/Bup.hs view
@@ -15,6 +15,7 @@ import Common.Annex import Types.Remote import Types.Key+import Types.Creds import qualified Git import qualified Git.Command import qualified Git.Config@@ -82,8 +83,8 @@   where 	buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc -bupSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-bupSetup mu c = do+bupSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+bupSetup mu _ c = do 	u <- maybe (liftIO genUUID) return mu  	-- verify configuration is sane
Remote/Directory.hs view
@@ -16,6 +16,7 @@  import Common.Annex import Types.Remote+import Types.Creds import qualified Git import Config.Cost import Config@@ -67,8 +68,8 @@   where 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc -directorySetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-directorySetup mu c = do+directorySetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+directorySetup mu _ c = do 	u <- maybe (liftIO genUUID) return mu 	-- verify configuration is sane 	let dir = fromMaybe (error "Specify directory=") $
Remote/External.hs view
@@ -73,8 +73,8 @@   where 	externaltype = fromMaybe (error "missing externaltype") (remoteAnnexExternalType gc) -externalSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-externalSetup mu c = do+externalSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+externalSetup mu _ c = do 	u <- maybe (liftIO genUUID) return mu 	let externaltype = fromMaybe (error "Specify externaltype=") $ 		M.lookup "externaltype" c@@ -92,16 +92,18 @@  store :: External -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store external k _f p = sendAnnex k rollback $ \f ->-	storeHelper external k f p+	metered (Just p) k $+		storeHelper external k f   where 	rollback = void $ remove external k  storeEncrypted :: External -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool storeEncrypted external gpgOpts (cipher, enck) k p = withTmp enck $ \tmp -> 	sendAnnex k rollback $ \src -> do-		liftIO $ encrypt gpgOpts cipher (feedFile src) $-			readBytes $ L.writeFile tmp-		storeHelper external enck tmp p+		metered (Just p) k $ \meterupdate -> do+			liftIO $ encrypt gpgOpts cipher (feedFile src) $+				readBytes $ L.writeFile tmp+			storeHelper external enck tmp meterupdate   where 	rollback = void $ remove external enck @@ -118,17 +120,19 @@ 			_ -> Nothing  retrieve :: External -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool-retrieve external k _f d p = retrieveHelper external k d p+retrieve external k _f d p = metered (Just p) k $+	retrieveHelper external k d  retrieveEncrypted :: External -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool-retrieveEncrypted external (cipher, enck) _ f p = withTmp enck $ \tmp ->-	ifM (retrieveHelper external enck tmp p)-		( liftIO $ catchBoolIO $ do-			decrypt cipher (feedFile tmp) $-				readBytes $ L.writeFile f-			return True-		, return False-		)+retrieveEncrypted external (cipher, enck) k f p = withTmp enck $ \tmp ->+	metered (Just p) k $ \meterupdate -> +		ifM (retrieveHelper external enck tmp meterupdate)+			( liftIO $ catchBoolIO $ do+				decrypt cipher (feedFile tmp) $+					readBytes $ L.writeFile f+				return True+			, return False+			)  retrieveHelper :: External -> Key -> FilePath -> MeterUpdate -> Annex Bool retrieveHelper external k d p = safely $@@ -221,8 +225,8 @@ 		send $ VALUE value 	handleRemoteRequest (SETCREDS setting login password) = do 		c <- liftIO $ atomically $ readTMVar $ externalConfig external-		c' <- setRemoteCredPair' c (credstorage setting)-			(login, password)+		c' <- setRemoteCredPair c (credstorage setting) $+			Just (login, password) 		void $ liftIO $ atomically $ swapTMVar (externalConfig external) c' 	handleRemoteRequest (GETCREDS setting) = do 		c <- liftIO $ atomically $ readTMVar $ externalConfig external
Remote/GCrypt.hs view
@@ -21,6 +21,7 @@ import Types.Remote import Types.GitConfig import Types.Crypto+import Types.Creds import qualified Git import qualified Git.Command import qualified Git.Config@@ -149,8 +150,8 @@ unsupportedUrl :: Annex a unsupportedUrl = error "using non-ssh remote repo url with gcrypt is not supported" -gCryptSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-gCryptSetup mu c = go $ M.lookup "gitrepo" c+gCryptSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+gCryptSetup mu _ c = go $ M.lookup "gitrepo" c   where 	remotename = fromJust (M.lookup "name" c)   	go Nothing = error "Specify gitrepo="@@ -176,7 +177,7 @@ 		void $ inRepo $ Git.Command.runBool 			[ Param "push" 			, Param remotename-			, Param $ show Annex.Branch.fullname+			, Param $ Git.fromRef Annex.Branch.fullname 			] 		g <- inRepo Git.Config.reRead 		case Git.GCrypt.remoteRepoId g (Just remotename) of
Remote/Glacier.hs view
@@ -70,17 +70,18 @@ 			remotetype = remote 		} -glacierSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-glacierSetup mu c = do+glacierSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+glacierSetup mu mcreds c = do 	u <- maybe (liftIO genUUID) return mu-	glacierSetup' u c-glacierSetup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-glacierSetup' u c = do+	glacierSetup' (isJust mu) u mcreds c+glacierSetup' :: Bool -> UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+glacierSetup' enabling u mcreds c = do 	c' <- encryptionSetup c 	let fullconfig = c' `M.union` defaults-	genVault fullconfig u+	unless enabling $+		genVault fullconfig u 	gitConfigSpecialRemote u fullconfig "glacier" "true"-	c'' <- setRemoteCredPair fullconfig (AWS.creds u)+	c'' <- setRemoteCredPair fullconfig (AWS.creds u) mcreds 	return (c'', u)   where 	remotename = fromJust (M.lookup "name" c)@@ -245,7 +246,6 @@   where 	fileprefix = M.findWithDefault "" "fileprefix" $ config r --- glacier vault create will succeed even if the vault already exists. genVault :: RemoteConfig -> UUID -> Annex () genVault c u = unlessM (runGlacier c u params) $ 	error "Failed creating glacier vault."
Remote/Helper/AWS.hs view
@@ -22,9 +22,6 @@ 	, credPairRemoteKey = Just "s3creds" 	} -setCredsEnv :: CredPair -> IO ()-setCredsEnv p = setEnvCredPair p $ creds undefined- data Service = S3 | Glacier 	deriving (Eq)
Remote/Hook.hs view
@@ -13,6 +13,7 @@ import Common.Annex import Types.Remote import Types.Key+import Types.Creds import qualified Git import Config import Config.Cost@@ -65,8 +66,8 @@   where 	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc -hookSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-hookSetup mu c = do+hookSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+hookSetup mu _ c = do 	u <- maybe (liftIO genUUID) return mu 	let hooktype = fromMaybe (error "Specify hooktype=") $ 		M.lookup "hooktype" c
Remote/Rsync.hs view
@@ -18,14 +18,6 @@ 	RsyncOpts ) where -import qualified Data.ByteString.Lazy as L-import qualified Data.Map as M-#ifndef mingw32_HOST_OS-import System.Posix.Process (getProcessID)-#else-import System.Win32.Process.Current (getCurrentProcessId)-#endif- import Common.Annex import Types.Remote import qualified Git@@ -40,9 +32,14 @@ import Utility.Rsync import Utility.CopyFile import Utility.Metered+import Utility.PID import Annex.Perms import Logs.Transfer+import Types.Creds +import qualified Data.ByteString.Lazy as L+import qualified Data.Map as M+ type RsyncUrl = String  data RsyncOpts = RsyncOpts@@ -138,8 +135,8 @@ 	loginopt = maybe [] (\l -> ["-l",l]) login 	fromNull as xs = if null xs then as else xs -rsyncSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-rsyncSetup mu c = do+rsyncSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+rsyncSetup mu _ c = do 	u <- maybe (liftIO genUUID) return mu 	-- verify configuration is sane 	let url = fromMaybe (error "Specify rsyncurl=") $@@ -249,14 +246,10 @@  - up trees for rsync. -} withRsyncScratchDir :: (FilePath -> Annex a) -> Annex a withRsyncScratchDir a = do-#ifndef mingw32_HOST_OS-	v <- liftIO getProcessID-#else-	v <- liftIO getCurrentProcessId-#endif+	p <- liftIO getPID 	t <- fromRepo gitAnnexTmpDir 	createAnnexDirectory t-	let tmp = t </> "rsynctmp" </> show v+	let tmp = t </> "rsynctmp" </> show p 	nuke tmp 	liftIO $ createDirectoryIfMissing True tmp 	nuke tmp `after` a tmp
Remote/S3.hs view
@@ -73,12 +73,12 @@ 			remotetype = remote 		} -s3Setup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-s3Setup mu c = do+s3Setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+s3Setup mu mcreds c = do 	u <- maybe (liftIO genUUID) return mu-	s3Setup' u c-s3Setup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-s3Setup' u c = if isIA c then archiveorg else defaulthost+	s3Setup' u mcreds c+s3Setup' :: UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+s3Setup' u mcreds c = if isIA c then archiveorg else defaulthost   where 	remotename = fromJust (M.lookup "name" c) 	defbucket = remotename ++ "-" ++ fromUUID u@@ -92,7 +92,7 @@ 		 	use fullconfig = do 		gitConfigSpecialRemote u fullconfig "s3" "true"-		c' <- setRemoteCredPair fullconfig (AWS.creds u)+		c' <- setRemoteCredPair fullconfig (AWS.creds u) mcreds 		return (c', u)  	defaulthost = do
Remote/Tahoe.hs view
@@ -29,6 +29,7 @@  import Common.Annex import Types.Remote+import Types.Creds import qualified Git import Config import Config.Cost@@ -85,8 +86,8 @@ 		remotetype = remote 	} -tahoeSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-tahoeSetup mu c = do+tahoeSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+tahoeSetup mu _ c = do 	furl <- fromMaybe (fromMaybe missingfurl $ M.lookup furlk c) 		<$> liftIO (getEnv "TAHOE_FURL") 	u <- maybe (liftIO genUUID) return mu
Remote/WebDAV.hs view
@@ -1,13 +1,13 @@ {- WebDAV remotes.  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  {-# LANGUAGE ScopedTypeVariables, CPP #-} -module Remote.WebDAV (remote, davCreds, setCredsEnv, configUrl) where+module Remote.WebDAV (remote, davCreds, configUrl) where  import Network.Protocol.HTTP.DAV import qualified Data.Map as M@@ -76,8 +76,8 @@ 			remotetype = remote 		} -webdavSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)-webdavSetup mu c = do+webdavSetup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> Annex (RemoteConfig, UUID)+webdavSetup mu mcreds c = do 	u <- maybe (liftIO genUUID) return mu 	let url = fromMaybe (error "Specify url=") $ 		M.lookup "url" c@@ -85,7 +85,7 @@ 	creds <- getCreds c' u 	testDav url creds 	gitConfigSpecialRemote u c' "webdav" "true"-	c'' <- setRemoteCredPair c' (davCreds u)+	c'' <- setRemoteCredPair c' (davCreds u) mcreds 	return (c'', u)  store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool@@ -354,6 +354,3 @@ 	, credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD") 	, credPairRemoteKey = Just "davcreds" 	}--setCredsEnv :: (String, String) -> IO ()-setCredsEnv creds = setEnvCredPair creds $ davCreds undefined
Test.hs view
@@ -45,6 +45,7 @@ import qualified Logs.Unused import qualified Logs.Transfer import qualified Logs.Presence+import qualified Types.MetaData import qualified Remote import qualified Types.Key import qualified Types.Messages@@ -53,6 +54,8 @@ import qualified Crypto import qualified Annex.Init import qualified Annex.CatFile+import qualified Annex.View+import qualified Logs.View import qualified Utility.Path import qualified Utility.FileMode import qualified Build.SysConfig@@ -144,12 +147,16 @@ 	, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable 	, testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips 	, testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips+	, testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane+	, testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize+	, testProperty "prop_branchView_legal" Logs.View.prop_branchView_legal+	, testProperty "prop_view_roundtrips" Annex.View.prop_view_roundtrips 	]  {- These tests set up the test environment, but also test some basic parts  - of git-annex. They are always run before the unitTests. -} initTests :: TestEnv -> TestTree-initTests env = testGroup ("Init Tests")+initTests env = testGroup "Init Tests" 	[ check "init" test_init 	, check "add" test_add 	]@@ -230,7 +237,7 @@ 		( do 			writeFile ingitfile $ content ingitfile 			not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode"-			boolSystem "rm" [Params "-f", File ingitfile] @? "rm failed"+			nukeFile ingitfile 			git_annex env "sync" [] @? "sync failed" 		, do 			writeFile ingitfile $ content ingitfile@@ -258,7 +265,7 @@ test_reinject env = intmpclonerepoInDirect env $ do 	git_annex env "drop" ["--force", sha1annexedfile] @? "drop failed" 	writeFile tmp $ content sha1annexedfile-	r <- annexeval $ Types.Backend.getKey backendSHA1 $+	r <- annexeval $ Types.Backend.getKey backendSHA1 		Types.KeySource.KeySource { Types.KeySource.keyFilename = tmp, Types.KeySource.contentLocation = tmp, Types.KeySource.inodeCache = Nothing } 	let key = Types.Key.key2file $ fromJust r 	git_annex env "reinject" [tmp, sha1annexedfile] @? "reinject failed"@@ -542,7 +549,7 @@ 		git_annex env "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f  test_fsck_bare :: TestEnv -> Assertion-test_fsck_bare env = intmpbareclonerepo env $ do+test_fsck_bare env = intmpbareclonerepo env $ 	git_annex env "fsck" [] @? "fsck failed"  test_fsck_localuntrusted :: TestEnv -> Assertion@@ -585,7 +592,7 @@ 	annexed_present sha1annexedfile 	if usegitattributes 		then do-			writeFile ".gitattributes" $ "* annex.backend=SHA1"+			writeFile ".gitattributes" "* annex.backend=SHA1" 			git_annex env "migrate" [sha1annexedfile] 				@? "migrate sha1annexedfile failed" 			git_annex env "migrate" [annexedfile]@@ -601,7 +608,7 @@ 	checkbackend sha1annexedfile backendSHA1  	-- check that reversing a migration works-	writeFile ".gitattributes" $ "* annex.backend=SHA256"+	writeFile ".gitattributes" "* annex.backend=SHA256" 	git_annex env "migrate" [sha1annexedfile] 		@? "migrate sha1annexedfile failed" 	git_annex env "migrate" [annexedfile]@@ -712,7 +719,7 @@ 	git_annex_expectoutput env "find" ["--exclude", "*"] []  test_merge :: TestEnv -> Assertion-test_merge env = intmpclonerepo env $ do+test_merge env = intmpclonerepo env $ 	git_annex env "merge" [] @? "merge failed"  test_info :: TestEnv -> Assertion@@ -723,7 +730,7 @@ 		Text.JSON.Error e -> assertFailure e  test_version :: TestEnv -> Assertion-test_version env = intmpclonerepo env $ do+test_version env = intmpclonerepo env $ 	git_annex env "version" [] @? "version failed"  test_sync :: TestEnv -> Assertion@@ -739,8 +746,8 @@ test_union_merge_regression :: TestEnv -> Assertion test_union_merge_regression env = 	{- We need 3 repos to see this bug. -}-	withtmpclonerepo env False $ \r1 -> do-		withtmpclonerepo env False $ \r2 -> do+	withtmpclonerepo env False $ \r1 ->+		withtmpclonerepo env False $ \r2 -> 			withtmpclonerepo env False $ \r3 -> do 				forM_ [r1, r2, r3] $ \r -> indir env r $ do 					when (r /= r1) $@@ -766,7 +773,7 @@ {- Regression test for the automatic conflict resolution bug fixed  - in f4ba19f2b8a76a1676da7bb5850baa40d9c388e2. -} test_conflict_resolution_movein_bug :: TestEnv -> Assertion-test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 -> do+test_conflict_resolution_movein_bug env = withtmpclonerepo env False $ \r1 ->  	withtmpclonerepo env False $ \r2 -> do 		let rname r = if r == r1 then "r1" else "r2" 		forM_ [r1, r2] $ \r -> indir env r $ do@@ -785,7 +792,7 @@ 				) 		{- Sync twice in r1 so it gets the conflict resolution 		 - update from r2 -}-		forM_ [r1, r2, r1] $ \r -> indir env r $ do+		forM_ [r1, r2, r1] $ \r -> indir env r $ 			git_annex env "sync" ["--force"] @? "sync failed in " ++ rname r 		{- After the sync, it should be possible to get all 		 - files. This includes both sides of the conflict,@@ -935,7 +942,7 @@ test_directory_remote :: TestEnv -> Assertion test_directory_remote env = intmpclonerepo env $ do 	createDirectory "dir"-	git_annex env "initremote" (words $ "foo type=directory encryption=none directory=dir") @? "initremote failed"+	git_annex env "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed" 	git_annex env "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile 	git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed"@@ -951,7 +958,7 @@ test_rsync_remote env = intmpclonerepo env $ do #ifndef mingw32_HOST_OS 	createDirectory "dir"-	git_annex env "initremote" (words $ "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"+	git_annex env "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed" 	git_annex env "get" [annexedfile] @? "get of file failed" 	annexed_present annexedfile 	git_annex env "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed"@@ -1085,7 +1092,7 @@ 		Utility.Env.setEnv var val True  	-- catch all errors, including normally fatal errors-	r <- try (run)::IO (Either SomeException ())+	r <- try run::IO (Either SomeException ()) 	case r of 		Right _ -> return True 		Left _ -> return False@@ -1126,7 +1133,7 @@ innewrepo env a = withgitrepo env $ \r -> indir env r a  inmainrepo :: TestEnv -> Assertion -> Assertion-inmainrepo env a = indir env mainrepodir a+inmainrepo env = indir env mainrepodir  intmpclonerepo :: TestEnv -> Assertion -> Assertion intmpclonerepo env a = withtmpclonerepo env False $ \r -> indir env r a@@ -1163,7 +1170,7 @@ 	-- any type of error and change back to cwd before 	-- rethrowing. 	r <- bracket_ (changeToTmpDir env dir) (setCurrentDirectory cwd)-		(try (a)::IO (Either SomeException ()))+		(try a::IO (Either SomeException ())) 	case r of 		Right () -> return () 		Left e -> throw e@@ -1186,7 +1193,7 @@ 	indir env new $ 		git_annex env "init" ["-q", new] @? "git annex init failed" 	configrepo env new-	when (not bare) $+	unless bare $ 		indir env new $ 			handleforcedirect env 	return new@@ -1218,12 +1225,12 @@ 		mapM_ (void . tryIO . Utility.FileMode.allowWrite) 	-- This sometimes fails on Windows, due to some files 	-- being still opened by a subprocess.-	catchIO (removeDirectoryRecursive dir) $ \e -> do+	catchIO (removeDirectoryRecursive dir) $ \e -> 		when final $ do 			print e 			putStrLn "sleeping 10 seconds and will retry directory cleanup" 			Utility.ThreadScheduler.threadDelaySeconds (Utility.ThreadScheduler.Seconds 10)-			whenM (doesDirectoryExist dir) $ do+			whenM (doesDirectoryExist dir) $ 				removeDirectoryRecursive dir 	 checklink :: FilePath -> Assertion@@ -1252,9 +1259,8 @@ 	-- modified despite permissions. 	s <- getFileStatus f 	let mode = fileMode s-	if (mode == mode `unionFileModes` ownerWriteMode)-		then assertFailure $ "able to modify annexed file's " ++ f ++ " content"-		else return ()+	when (mode == mode `unionFileModes` ownerWriteMode) $+		assertFailure $ "able to modify annexed file's " ++ f ++ " content"  checkwritable :: FilePath -> Assertion checkwritable f = do@@ -1280,7 +1286,7 @@ 	case r of 		Just (k, _) -> do 			uuids <- annexeval $ Remote.keyLocations k-			assertEqual ("bad content in location log for " ++ f ++ " key " ++ (Types.Key.key2file k) ++ " uuid " ++ show thisuuid)+			assertEqual ("bad content in location log for " ++ f ++ " key " ++ Types.Key.key2file k ++ " uuid " ++ show thisuuid) 				expected (thisuuid `elem` uuids) 		_ -> assertFailure $ f ++ " failed to look up key" @@ -1326,8 +1332,7 @@ 	release = releaseTestEnv  releaseTestEnv :: TestEnv -> IO ()-releaseTestEnv _env = do-	cleanup' True tmpdir+releaseTestEnv _env = cleanup' True tmpdir  prepareTestEnv :: Bool -> IO TestEnv prepareTestEnv forcedirect = do@@ -1404,7 +1409,7 @@ changecontent f = writeFile f $ changedcontent f  changedcontent :: FilePath -> String-changedcontent f = (content f) ++ " (modified)"+changedcontent f = content f ++ " (modified)"  backendSHA1 :: Types.Backend backendSHA1 = backend_ "SHA1"@@ -1416,4 +1421,4 @@ backendWORM = backend_ "WORM"  backend_ :: String -> Types.Backend-backend_ name = Backend.lookupBackendName name+backend_ = Backend.lookupBackendName
Types/Command.hs view
@@ -66,6 +66,7 @@ 	| SectionSetup 	| SectionMaintenance 	| SectionQuery+	| SectionMetaData 	| SectionUtility 	| SectionPlumbing 	deriving (Eq, Ord, Enum, Bounded)@@ -75,5 +76,6 @@ descSection SectionSetup = "Repository setup commands" descSection SectionMaintenance = "Repository maintenance commands" descSection SectionQuery = "Query commands"+descSection SectionMetaData = "Metadata commands" descSection SectionUtility = "Utility commands" descSection SectionPlumbing = "Plumbing commands"
+ Types/Creds.hs view
@@ -0,0 +1,12 @@+{- credentials+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Types.Creds where++type Creds = String -- can be any data that contains credentials++type CredPair = (String, String) -- login, password
+ Types/MetaData.hs view
@@ -0,0 +1,269 @@+{- git-annex general metadata+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Types.MetaData (+	MetaData(..),+	MetaField(..),+	MetaValue(..),+	CurrentlySet(..),+	serialize,+	deserialize,+	MetaSerializable,+	toMetaField,+	mkMetaField,+	tagMetaField,+	fromMetaField,+	toMetaValue,+	mkMetaValue,+	unsetMetaValue,+	unsetMetaData,+	fromMetaValue,+	fromMetaData,+	newMetaData,+	updateMetaData,+	unionMetaData,+	differenceMetaData,+	isSet,+	currentMetaData,+	currentMetaDataValues,+	metaDataValues,+	ModMeta(..),+	modMeta,+	parseModMeta,+	parseMetaData,+	prop_metadata_sane,+	prop_metadata_serialize+) where++import Common+import Utility.Base64+import Utility.QuickCheck++import qualified Data.Set as S+import qualified Data.Map as M+import Data.Char++newtype MetaData = MetaData (M.Map MetaField (S.Set MetaValue))+	deriving (Show, Eq, Ord)++{- A metadata value can be currently be set (True), or may have been+ - set before and we're remembering it no longer is (False). -}+newtype CurrentlySet = CurrentlySet Bool+	deriving (Read, Show, Eq, Ord, Arbitrary)++newtype MetaField = MetaField String+	deriving (Read, Show, Eq, Ord)++data MetaValue = MetaValue CurrentlySet String+	deriving (Read, Show)++{- Metadata values compare and order the same whether currently set or not. -}+instance Eq MetaValue where+	MetaValue _ a == MetaValue _ b = a == b+instance Ord MetaValue where+	compare (MetaValue _ x) (MetaValue _ y) = compare x y++{- MetaData is serialized to a format like:+ -+ - field1 +val1 +val2 -val3 field2 +val4 +val5+ -}+class MetaSerializable v where+	serialize :: v -> String+	deserialize :: String -> Maybe v++instance MetaSerializable MetaData where+	serialize (MetaData m) = unwords $ concatMap go $ M.toList m+	  where+		go (f, vs) = serialize f : map serialize (S.toList vs)+	deserialize = Just . getfield newMetaData . words+	  where+		getfield m [] = m+		getfield m (w:ws) = maybe m (getvalues m ws) (deserialize w)+		getvalues m [] _ = m+		getvalues m l@(w:ws) f = case deserialize w of+			Just v -> getvalues (updateMetaData f v m) ws f+			Nothing -> getfield m l++instance MetaSerializable MetaField where+	serialize (MetaField f) = f+	deserialize = Just . MetaField++{- Base64 problimatic values. -}+instance MetaSerializable MetaValue where+	serialize (MetaValue isset v) =+		serialize isset +++		if any isSpace v || "!" `isPrefixOf` v+			then '!' : toB64 v+			else v+	deserialize (isset:'!':v) = MetaValue+		<$> deserialize [isset]+		<*> fromB64Maybe v+	deserialize (isset:v) = MetaValue +		<$> deserialize [isset]+		<*> pure v+	deserialize [] = Nothing++instance MetaSerializable CurrentlySet where+	serialize (CurrentlySet True) = "+"+	serialize (CurrentlySet False) = "-"+	deserialize "+" = Just (CurrentlySet True)+	deserialize "-" = Just (CurrentlySet False)+	deserialize _ = Nothing++{- Fields cannot be empty, contain whitespace, or start with "+-" as+ - that would break the serialization. -}+toMetaField :: String -> Maybe MetaField+toMetaField f+	| legalField f = Just $ MetaField f+	| otherwise = Nothing++legalField :: String -> Bool+legalField f+	| null f = False+	| any isSpace f = False+	| any (`isPrefixOf` f) ["+", "-"] = False+	| otherwise = True++toMetaValue :: String -> MetaValue+toMetaValue = MetaValue (CurrentlySet True)++mkMetaValue :: CurrentlySet -> String -> MetaValue+mkMetaValue = MetaValue++unsetMetaValue :: MetaValue -> MetaValue+unsetMetaValue (MetaValue _ s) = MetaValue (CurrentlySet False) s++{- Marks all MetaValues as no longer currently set. -}+unsetMetaData :: MetaData -> MetaData+unsetMetaData (MetaData m) = MetaData $ M.map (S.map unsetMetaValue) m++fromMetaField :: MetaField -> String+fromMetaField (MetaField f) = f++fromMetaValue :: MetaValue -> String+fromMetaValue (MetaValue _ f) = f++fromMetaData :: MetaData -> [(MetaField, S.Set MetaValue)]+fromMetaData (MetaData m) = M.toList m++newMetaData :: MetaData+newMetaData = MetaData M.empty++{- Can be used to set a value, or to unset it, depending on whether+ - the MetaValue has CurrentlySet or not. -}+updateMetaData :: MetaField -> MetaValue -> MetaData -> MetaData+updateMetaData f v (MetaData m) = MetaData $+	M.insertWith' S.union f (S.singleton v) m++{- New metadata overrides old._-}+unionMetaData :: MetaData -> MetaData -> MetaData+unionMetaData (MetaData old) (MetaData new) = MetaData $+	M.unionWith S.union new old++differenceMetaData :: MetaData -> MetaData -> MetaData+differenceMetaData (MetaData m) (MetaData excludem) = MetaData $+	M.differenceWith diff m excludem+  where+	diff sl sr =+		let s = S.difference sl sr+		in if S.null s then Nothing else Just s++isSet :: MetaValue -> Bool+isSet (MetaValue (CurrentlySet isset) _) = isset++{- Gets only currently set values -}+currentMetaDataValues :: MetaField -> MetaData -> S.Set MetaValue+currentMetaDataValues f m = S.filter isSet (metaDataValues f m)++currentMetaData :: MetaData -> MetaData+currentMetaData (MetaData m) = removeEmptyFields $ MetaData $+	M.map (S.filter isSet) m++removeEmptyFields :: MetaData -> MetaData+removeEmptyFields (MetaData m) = MetaData $ M.filter (not . S.null) m++{- Gets currently set values, but also values that have been unset. -}+metaDataValues :: MetaField -> MetaData -> S.Set MetaValue+metaDataValues f (MetaData m) = fromMaybe S.empty (M.lookup f m)++{- Ways that existing metadata can be modified -}+data ModMeta+	= AddMeta MetaField MetaValue+	| DelMeta MetaField MetaValue+	| SetMeta MetaField MetaValue -- removes any existing values++{- Applies a ModMeta, generating the new MetaData.+ - Note that the new MetaData does not include all the + - values set in the input metadata. It only contains changed values. -}+modMeta :: MetaData -> ModMeta -> MetaData+modMeta _ (AddMeta f v) = updateMetaData f v newMetaData+modMeta _ (DelMeta f oldv) = updateMetaData f (unsetMetaValue oldv) newMetaData+modMeta m (SetMeta f v) = updateMetaData f v $+	foldr (updateMetaData f) newMetaData $+		map unsetMetaValue $ S.toList $ currentMetaDataValues f m++{- Parses field=value, field+=value, field-=value -}+parseModMeta :: String -> Either String ModMeta+parseModMeta p = case lastMaybe f of+	Just '+' -> AddMeta <$> mkMetaField f' <*> v+	Just '-' -> DelMeta <$> mkMetaField f' <*> v+	_ -> SetMeta <$> mkMetaField f <*> v+  where+	(f, sv) = separate (== '=') p+	f' = beginning f+	v = pure (toMetaValue sv)++{- Parses field=value -}+parseMetaData :: String -> Either String (MetaField, MetaValue)+parseMetaData p = (,)+	<$> mkMetaField f+	<*> pure (toMetaValue v)+  where+	(f, v) = separate (== '=') p++mkMetaField :: String -> Either String MetaField+mkMetaField f = maybe (Left $ badField f) Right (toMetaField f)++badField :: String -> String+badField f = "Illegal metadata field name, \"" ++ f ++ "\""++tagMetaField :: MetaField+tagMetaField = MetaField "tag"++{- Avoid putting too many fields in the map; extremely large maps make+ - the seriaization test slow due to the sheer amount of data.+ - It's unlikely that more than 100 fields of metadata will be used. -}+instance Arbitrary MetaData where+	arbitrary = do+		size <- arbitrarySizedBoundedIntegral `suchThat` (< 500)+		MetaData . M.fromList <$> vector size++instance Arbitrary MetaValue where+	arbitrary = MetaValue <$> arbitrary <*> arbitrary++instance Arbitrary MetaField where+	arbitrary = MetaField <$> arbitrary `suchThat` legalField ++prop_metadata_sane :: MetaData -> MetaField -> MetaValue -> Bool+prop_metadata_sane m f v = and+	[ S.member v $ metaDataValues f m'+	, not (isSet v) || S.member v (currentMetaDataValues f m')+	, differenceMetaData m' newMetaData == m'+	]+  where+	m' = updateMetaData f v m++prop_metadata_serialize :: MetaField -> MetaValue -> MetaData -> Bool+prop_metadata_serialize f v m = and+	[ deserialize (serialize f) == Just f+	, deserialize (serialize v) == Just v+	, deserialize (serialize m') == Just m'+	]+  where+  	m' = removeEmptyFields m
Types/Remote.hs view
@@ -24,6 +24,7 @@ import Types.UUID import Types.GitConfig import Types.Availability+import Types.Creds import Config.Cost import Utility.Metered import Git.Types@@ -41,7 +42,7 @@ 	-- generates a remote of this type 	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)), 	-- initializes or changes a remote-	setup :: Maybe UUID -> RemoteConfig -> a (RemoteConfig, UUID)+	setup :: Maybe UUID -> Maybe CredPair -> RemoteConfig -> a (RemoteConfig, UUID) }  instance Eq (RemoteTypeA a) where
+ Types/View.hs view
@@ -0,0 +1,55 @@+{- types for metadata based branch views+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Types.View where++import Common.Annex+import Types.MetaData+import Utility.QuickCheck+import qualified Git++import qualified Data.Set as S++{- A view is a list of fields with filters on their allowed values,+ - which are applied to files in a parent git branch. -}+data View = View+	{ viewParentBranch :: Git.Branch+	, viewComponents :: [ViewComponent]+	}+	deriving (Eq, Read, Show)++instance Arbitrary View where+	arbitrary = View <$> pure (Git.Ref "master") <*> arbitrary++data ViewComponent = ViewComponent+	{ viewField :: MetaField+	, viewFilter :: ViewFilter+	, viewVisible :: Bool+	}+	deriving (Eq, Read, Show)++instance Arbitrary ViewComponent where+	arbitrary = ViewComponent <$> arbitrary <*> arbitrary <*> arbitrary++{- Only files with metadata matching the view are displayed. -}+type FileView = FilePath+type MkFileView = FilePath -> FileView++data ViewFilter+	= FilterValues (S.Set MetaValue)+	| FilterGlob String+	deriving (Eq, Read, Show)++instance Arbitrary ViewFilter where+	arbitrary = do+		size <- arbitrarySizedBoundedIntegral `suchThat` (< 100)+		FilterValues . S.fromList <$> vector size++{- Can a ViewFilter match multiple different MetaValues? -}+multiValue :: ViewFilter -> Bool+multiValue (FilterValues s) = S.size s > 1+multiValue (FilterGlob _) = True
Upgrade/V2.hs view
@@ -106,7 +106,10 @@ 			showAction "pushing new git-annex branch to origin" 			showOutput 			inRepo $ Git.Command.run-				[Param "push", Param "origin", Param $ show Annex.Branch.name]+				[ Param "push"+				, Param "origin"+				, Param $ Git.fromRef Annex.Branch.name+				] 		_ -> do 			-- no origin exists, so just let the user 			-- know about the new branch
+ Utility/.Base64.hs.swp view

binary file changed (absent → 12288 bytes)

Utility/Daemon.hs view
@@ -1,6 +1,6 @@ {- daemon support  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -10,17 +10,20 @@ module Utility.Daemon where  import Common+import Utility.PID #ifndef mingw32_HOST_OS import Utility.LogFile+#else+import Utility.WinProcess+import Utility.WinLock #endif  #ifndef mingw32_HOST_OS import System.Posix import Control.Concurrent.Async-#else-import System.PosixCompat.Types #endif +#ifndef mingw32_HOST_OS {- Run an action as a daemon, with all output sent to a file descriptor.  -  - Can write its pid to a file, to guard against multiple instances@@ -28,7 +31,6 @@  -  - When successful, does not return. -} daemonize :: Fd -> Maybe FilePath -> Bool -> IO () -> IO ()-#ifndef mingw32_HOST_OS daemonize logfd pidfile changedirectory a = do 	maybe noop checkalreadyrunning pidfile 	_ <- forkProcess child1@@ -52,18 +54,18 @@ 		wait =<< asyncWithUnmask (\unmask -> unmask a) 		out 	out = exitImmediately ExitSuccess-#else-daemonize = error "daemonize is not implemented on Windows" -- TODO #endif -{- Locks the pid file, with an exclusive, non-blocking lock.+{- Locks the pid file, with an exclusive, non-blocking lock,+ - and leaves it locked on return.+ -  - Writes the pid to the file, fully atomically.  - Fails if the pid file is already locked by another process. -} lockPidFile :: FilePath -> IO ()-lockPidFile file = do-	createDirectoryIfMissing True (parentDir file)+lockPidFile pidfile = do+	createDirectoryIfMissing True (parentDir pidfile) #ifndef mingw32_HOST_OS-	fd <- openFd file ReadWrite (Just stdFileMode) defaultFileFlags+	fd <- openFd pidfile ReadWrite (Just stdFileMode) defaultFileFlags 	locked <- catchMaybeIO $ setLock fd (WriteLock, AbsoluteSeek, 0, 0) 	fd' <- openFd newfile ReadWrite (Just stdFileMode) defaultFileFlags 		{ trunc = True }@@ -72,14 +74,21 @@ 		(Nothing, _) -> alreadyRunning 		(_, Nothing) -> alreadyRunning 		_ -> do-			_ <- fdWrite fd' =<< show <$> getProcessID+			_ <- fdWrite fd' =<< show <$> getPID 			closeFd fd+	rename newfile pidfile+  where+	newfile = pidfile ++ ".new" #else-	writeFile newfile "-1"+	{- Not atomic on Windows, oh well. -}+	unlessM (isNothing <$> checkDaemon pidfile)+		alreadyRunning+	pid <- getPID+	writeFile pidfile (show pid)+	lckfile <- winLockFile pid pidfile+	writeFile lckfile ""+	void $ lockExclusive lckfile #endif-	rename newfile file-  where-	newfile = file ++ ".new"  alreadyRunning :: IO () alreadyRunning = error "Daemon is already running."@@ -88,7 +97,7 @@  - is locked by the same process that is listed in the pid file.  -  - If it's running, returns its pid. -}-checkDaemon :: FilePath -> IO (Maybe ProcessID)+checkDaemon :: FilePath -> IO (Maybe PID) #ifndef mingw32_HOST_OS checkDaemon pidfile = do 	v <- catchMaybeIO $@@ -109,16 +118,44 @@ 			" (got " ++ show pid' ++  			"; expected " ++ show pid ++ " )" #else-checkDaemon pidfile = maybe Nothing readish <$> catchMaybeIO (readFile pidfile)+checkDaemon pidfile = maybe (return Nothing) (check . readish)+	=<< catchMaybeIO (readFile pidfile)+  where+	check Nothing = return Nothing+	check (Just pid) = do+		v <- lockShared =<< winLockFile pid pidfile+		case v of+			Just h -> do+				dropLock h+				return Nothing+			Nothing -> return (Just pid) #endif  {- Stops the daemon, safely. -} stopDaemon :: FilePath -> IO ()-#ifndef mingw32_HOST_OS stopDaemon pidfile = go =<< checkDaemon pidfile   where 	go Nothing = noop-	go (Just pid) = signalProcess sigTERM pid+	go (Just pid) =+#ifndef mingw32_HOST_OS+		signalProcess sigTERM pid #else-stopDaemon = error "stopDaemon is not implemented on Windows" -- TODO+		terminatePID pid+#endif++{- Windows locks a lock file that corresponds with the pid of the process.+ - This allows changing the process in the pid file and taking a new lock+ - when eg, restarting the daemon.+ -}+#ifdef mingw32_HOST_OS+winLockFile :: PID -> FilePath -> IO FilePath+winLockFile pid pidfile = do+	cleanstale+	return $ prefix ++ show pid ++ suffix+  where+  	prefix = pidfile ++ "."+	suffix = ".lck"+	cleanstale = mapM_ (void . tryIO . removeFile) =<<+		(filter iswinlockfile <$> dirContents (parentDir pidfile))+	iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f #endif
Utility/Directory.hs view
@@ -1,6 +1,6 @@ {- directory manipulation  -- - Copyright 2011 Joey Hess <joey@kitenet.net>+ - Copyright 2011-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -23,6 +23,7 @@ import Utility.Tmp import Utility.Exception import Utility.Monad+import Utility.Applicative  dirCruft :: FilePath -> Bool dirCruft "." = True@@ -72,6 +73,21 @@ 							, skip 							) 				_ -> skip++{- Gets the directory tree from a point, recursively and lazily,+ - with leaf directories **first**, skipping any whose basenames+ - match the skipdir. Does not follow symlinks. -}+dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]+dirTreeRecursiveSkipping skipdir topdir = go [] [topdir]+  where+  	go c [] = return c+	go c (dir:dirs)+		| skipdir (takeFileName dir) = go c dirs+		| otherwise = unsafeInterleaveIO $ do+			subdirs <- go c+				=<< filterM (isDirectory <$$> getSymbolicLinkStatus)+				=<< catchDefaultIO [] (dirContents dir)+			go (subdirs++[dir]) dirs  {- Moves one filename to another.  - First tries a rename, but falls back to moving across devices if needed. -}
Utility/LogFile.hs view
@@ -13,14 +13,12 @@  import System.Posix.Types -openLog :: FilePath -> IO Fd #ifndef mingw32_HOST_OS+openLog :: FilePath -> IO Fd openLog logfile = do 	rotateLog logfile 	openFd logfile WriteOnly (Just stdFileMode) 		defaultFileFlags { append = True }-#else-openLog = error "openLog TODO" #endif  rotateLog :: FilePath -> IO ()@@ -49,20 +47,14 @@ maxLogs :: Int maxLogs = 9 -redirLog :: Fd -> IO () #ifndef mingw32_HOST_OS+redirLog :: Fd -> IO () redirLog logfd = do 	mapM_ (redir logfd) [stdOutput, stdError] 	closeFd logfd-#else-redirLog _ = error "redirLog TODO"-#endif  redir :: Fd -> Fd -> IO ()-#ifndef mingw32_HOST_OS redir newh h = do 	closeFd h 	void $ dupTo newh h-#else-redir _ _ = error "redir TODO" #endif
+ Utility/PID.hs view
@@ -0,0 +1,31 @@+{- process ids+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Utility.PID where++#ifndef mingw32_HOST_OS+import System.Posix.Types (ProcessID)+import System.Posix.Process (getProcessID)+#else+import System.Win32.Process (ProcessId)+import System.Win32.Process.Current (getCurrentProcessId)+#endif++#ifndef mingw32_HOST_OS+type PID = ProcessID+#else+type PID = ProcessId+#endif++getPID :: IO PID+#ifndef mingw32_HOST_OS+getPID = getProcessID+#else+getPID = getCurrentProcessId+#endif
Utility/Path.hs view
@@ -277,3 +277,18 @@ 		| c == '.' = c 		| isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_' 		| otherwise = c++{- Similar to splitExtensions, but knows that some things in FilePaths+ - after a dot are too long to be extensions. -}+splitShortExtensions :: FilePath -> (FilePath, [String])+splitShortExtensions = splitShortExtensions' 5 -- enough for ".jpeg"+splitShortExtensions' :: Int -> FilePath -> (FilePath, [String])+splitShortExtensions' maxextension = go []+  where+	go c f+		| len > 0 && len <= maxextension && not (null base) = +			go (ext:c) base+		| otherwise = (f, c)+	  where+		(base, ext) = splitExtension f+		len = length ext
Utility/QuickCheck.hs view
@@ -1,6 +1,6 @@ {- QuickCheck with additional instances  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -17,10 +17,14 @@ import Data.Time.Clock.POSIX import System.Posix.Types import qualified Data.Map as M+import qualified Data.Set as S import Control.Applicative  instance (Arbitrary k, Arbitrary v, Eq k, Ord k) => Arbitrary (M.Map k v) where 	arbitrary = M.fromList <$> arbitrary++instance (Arbitrary v, Eq v, Ord v) => Arbitrary (S.Set v) where+	arbitrary = S.fromList <$> arbitrary  {- Times before the epoch are excluded. -} instance Arbitrary POSIXTime where
+ Utility/WinProcess.hs view
@@ -0,0 +1,19 @@+{- Windows processes+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++{-# LANGUAGE ForeignFunctionInterface #-}++module Utility.WinProcess where++import Utility.PID++import System.Win32.Process+import Foreign.C+import Control.Exception++foreign import ccall unsafe "terminatepid"+	terminatePID :: PID -> IO ()
+ Utility/winprocess.c view
@@ -0,0 +1,10 @@+#include <windows.h>++void terminatepid (DWORD pid) {+	HANDLE h;+	h = OpenProcess(PROCESS_TERMINATE, 0, pid);+	if (h != NULL) {+		TerminateProcess(h, 1);+	}+	CloseHandle(h);+}
debian/changelog view
@@ -1,3 +1,34 @@+git-annex (5.20140221) unstable; urgency=medium++  * metadata: New command that can attach metadata to files.+  * --metadata can be used to limit commands to acting on files+    that have particular metadata.+  * Preferred content expressions can use metadata=field=value+    to limit them to acting on files that have particular metadata.+  * view: New command that creates and checks out a branch that provides+    a structured view of selected metadata.+  * vfilter, vadd, vpop, vcycle: New commands for operating within views.+  * pre-commit: Update metadata when committing changes to locations+    of annexed files within a view.+  * Add progress display for transfers to/from external special remotes.+  * unused: Fix to actually detect unused keys when in direct mode.+  * fsck: When run with --all or --unused, while .gitattributes+    annex.numcopies cannot be honored since it's operating on keys+    instead of files, make it honor the global numcopies setting,+    and the annex.numcopies git config setting.+  * trust, untrust, semitrust, dead: Warn when the trust level is+    overridden in .git/config.+  * glacier: Do not try to run glacier value create when an existing glacier+    remote is enabled.+  * fsck: Refuse to do anything if more than one of --incremental, --more,+    and --incremental-schedule are given, since it's not clear which option+    should win.+  * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes+  * Windows webapp: Can create repos on removable drives.+  * Windows: Ensure HOME is set, as needed by bundled cygwin utilities.++ -- Joey Hess <joeyh@debian.org>  Fri, 21 Feb 2014 11:23:59 -0400+ git-annex (5.20140210) unstable; urgency=medium    * --in can now refer to files that were located in a repository at
doc/assistant/release_notes.mdwn view
@@ -1,3 +1,10 @@+## version 5.20140221++The Windows port of the assistant and webapp is now considered to be beta+quality. There are important missing features (notably Jabber), documented+on [[todo/windows_support]], but the webapp is broadly usable on Windows+now.+ ## version 5.20131221  There is now a arm [[install/linux_standalone]] build of git-annex,
+ doc/bugs/Mac_OS_git_version_still_too_old_for_.gitignore__63__.mdwn view
@@ -0,0 +1,28 @@+### Please describe the problem.++Joey, it looks like the git version wasn't updated with the latest release as is still too old to respect .gitignore files.  I'm hoping that I haven't just made a silly mistake but I don't think I have...++See http://git-annex.branchable.com/bugs/Mac_OS_git_version_too_old_to_honour_.gitignore/ for bug that was closed.++### What steps will reproduce the problem?++Install git-annex 5.20140209-g3a61dbe and try to use .gitignore file to exclude items from git annex.++### What version of git-annex are you using? On what operating system?++5.20140209-g3a61dbe on Mac OS 10.9.1.++### Please provide any additional information below.++[/Applications/git-annex.app/Contents/MacOS]# ./git annex version++git-annex version: 5.20140209-g3a61dbe+build flags: Assistant Webapp Pairing S3 WebDAV FsEvents XMPP DNS Feeds Quvi TDFA CryptoHash+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL+remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier hook external++[/Applications/git-annex.app/Contents/MacOS]# ./git --version++git version 1.8.3.4 (Apple Git-47)++> Really [[fixed|done]] now. --[[Joey]]
+ doc/bugs/Matching_oddity_in_SafeCommand.hs.mdwn view
@@ -0,0 +1,28 @@+In SafeCommand.hs, the code to unwrap a File looks like:++[[!format haskell """+toCommand :: [CommandParam] -> [String]+toCommand = concatMap unwrap+  where+        [...]+        -- Files that start with a non-alphanumeric that is not a path+        -- separator are modified to avoid the command interpreting them as+        -- options or other special constructs.+        unwrap (File s@(h:_))+                | isAlphaNum h || h `elem` pathseps = [s]+                | otherwise = ["./" ++ s]+        unwrap (File s) = [s]+        [...]+"""]]++I am not sure I understand which case would be caught in the last clause "unwrap (File s)". Is that the empty file? Because all non-empty file names seem to have been caught earlier, at least in the "otherwise" if they do not match the condition. In this case, wouldn't it be an error to use an empty file name and wouldn't it be better to throw an exception instead of returning [[]]?++I would use:++[[!format haskell """+        unwrap (File []) = throw "Empty file name in SafeCommand.toCommand"+"""]]++or something similar instead.++> [[done]]
+ doc/bugs/Numcopies_not_checked_when_running_with_--all.mdwn view
@@ -0,0 +1,40 @@+### Please describe the problem.+There are a lot of differences in the behaviour of usual commands and commans using --all.+The specific problem I found was that "git annex fsck --all" will only checksum it seems and not report back numcopies failures.+Checking if objects/old versions have propagated is not possible without it or do I miss something.++(As additional note not sure if related. It seems that git annex fsck --all is running much faster in my tests 1/3 faster. Any reason for that? Bug related?)+++### What steps will reproduce the problem?+compare "git annex fsck" vs "git annex fsck" (no numcopies check)++### What version of git-annex are you using? On what operating system?+git-annex version: 5.20140210-gd99db49+Linux (Ubuntu 13.10)++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+++# End of transcript or log.+"""]]++> It's expected that --all (and --unused) make .gitattributes+> annex.numcopies settings be ignored, because with these options git-annex+> is operating on keys, it does not know or care what filename they're+> associated with, and so cannot look them up in .gitattributes. I have+> improved the documentation of .gitattributes files to mention this+> limitation.+> +> I also notice that fsck --all is not checking .git/config's+> annex.numcopies or the new global numcopies setting. It certianly makes+> sense for those numcopies settings to be paid attention to.+> [[fixed|done]] --[[Joey]]+> +> (--all is faster because it can quickly scan through .git/annex/objects+> to find everything, rather than looking at the symlink target of every+> file in the work tree.)
doc/bugs/Resolve_.local_adresses_using_avahi_or_bonjour.mdwn view
@@ -13,4 +13,4 @@  ### Please provide any additional information below. -+> [[closing|done]] --[[Joey]]
doc/bugs/assistant_unable_to_auth___40__windows__41__.mdwn view
@@ -81,3 +81,5 @@   -q       --quiet         avoid verbose output etc """]]++> [[fixed|done]]; both for regular remote ssh servers, and for rsync.net --[[Joey]]
doc/bugs/assistant_using_the_incorrect_path_on_windows__63__.mdwn view
@@ -40,3 +40,6 @@  ### What version of git-annex are you using? On what operating system? Windows 7, git-annex version 5.20131230-g192d991++> [[fixed|done]]; git-annex now ensures HOME is set when running cygwin+> commands that require it. --[[Joey]]
+ doc/bugs/can__39__t_drop_unused_files_that_never_were_added.mdwn view
@@ -0,0 +1,86 @@+### Please describe the problem.++When adding files to the annex and then deciding against it in an "unusual" way, git-annex gets confused and the file left behind can't be removed from the annex...++### What steps will reproduce the problem?++1. Add file with "git annex add"+2. Decide you don't need the file add all+3. "git rm -f newfile"+4. "git annex unused"+5. "git annex dropunused all"++### What version of git-annex are you using? On what operating system?++git-annex version: 5.20140210 on Debian unstable++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+$ git init+Initialized empty Git repository in /tmp/foo/.git/+$ ls -l+total 0+$ cp ~/download/hub-ctrl.c .+$ git add hub-ctrl.c+$ git commit+[master (root-commit) ed7eb68] A file.+ 1 file changed, 412 insertions(+)+ create mode 100644 hub-ctrl.c+$ cp ~/download/hub-ctrl .+$ ls -l+total 28+-rwxr-xr-x 1 tobias tobias 14130 Feb 19 00:49 hub-ctrl+-rw-r--r-- 1 tobias tobias  9270 Feb 19 00:48 hub-ctrl.c+$ git annex init+init  ok+(Recording state in git...)+$ git annex add+add hub-ctrl ok+(Recording state in git...)+$ git status+On branch master+Changes to be committed:+  (use "git reset HEAD <file>..." to unstage)++	new file:   hub-ctrl++$ git rm hub-ctrl+error: the following file has changes staged in the index:+    hub-ctrl+(use --cached to keep the file, or -f to force removal)+$ git rm -f hub-ctrl+rm 'hub-ctrl'+$ git status+On branch master+nothing to commit, working directory clean+$ git annex unused+unused . (checking for unused data...) (checking HEAD...) +  Some annexed data is no longer used by any files:+    NUMBER  KEY+    1       SHA256E-s14130--d4e777ba2b99ed0a520fbabe7b93cf2165373b4945afe8dcb626231d9051f19d+  (To see where data was previously used, try: git log --stat -S'KEY')+  +  To remove unwanted data: git-annex dropunused NUMBER+  +ok+$ git annex dropunused all+dropunused 1 (unsafe) +  Could only verify the existence of 0 out of 1 necessary copies++  Rather than dropping this file, try using: git annex move++  (Use --force to override this check, or adjust numcopies.)+failed+git-annex: dropunused: 1 failed+$++# End of transcript or log.+"""]]++> It seems to me that if you run `git annex dropunused --force`, it will+> remove the file. This needing --force is a recent change; git-annex+> tries to never posibly lose data unless forced. Dropping the last+> copy of a file certianly qualifies. [[done]] --[[Joey]]
+ doc/bugs/copy_unused_and_unused_not_agreeing.mdwn view
@@ -0,0 +1,48 @@+[[!format sh """+greg@x200s:~/Documents$ git-annex unused+unused . (checking for unused data...) (checking annex/direct/master...) (checking synced/annex/direct/master...) (checking synology/master...) +  Some annexed data is no longer used by any files:+    NUMBER  KEY+    1       SHA256E-s16367--0b00ef0154c42a0bf94e5be8d92d8af27455d59794f26c33dfc39c09178521c9.pdf+    2       SHA256E-s84--b08e1c831863bb43c02158bd5e8f3f5416c3a5203d89fa94a22149460142c273.odt+    3       SHA256E-s84--ec4caae451180a29721f2b6667eec8ec80eaa724f0727cf99d2bb21bf9218e9d.odt+    ...+    88      SHA256E-s84--710d69bef61674b04974ac550d713e5928563b2a12b902b64fe451705b967452.doc+    89      SHA256E-s3830--1348d6248e35625da3e22f73d2a0017185bb5e1aa37f65bbca5dfcb3c7f53034+    90      SHA256E-s119822--7c1b53ab6402b8835473f0b5c326f3cc300ac9372be79694942c1efa4bcdc621.pdf+    91      SHA256E-s84--63b6188696795885ff6570a76a3a74799396787f7058cbcfd4a2c40b22982420.odt+  (To see where data was previously used, try: git log --stat -S'KEY')+  +  To remove unwanted data: git-annex dropunused NUMBER+  +ok+greg@x200s:~/Documents$ git-annex copy --unused --to synology+"""]]++Is that correct behavior? I would assume the last command would at least run through the 91 files and check my synology remote that they are there. Like this repo did:++[[!format sh """+$ git-annex unused+unused . (checking for unused data...) (checking master...) (checking 60justin/master...)+  Some annexed data is no longer used by any files:+    NUMBER  KEY+    1       SHA256E-s9390266--7ed16c9423b331dbe63bb3b4278b8c94a6754a07177c53fceb3b24e9610e8054.NEF+    2       SHA256E-s10435713--49cbfe8466eada2c3787c9a7e158a7dfb9845a0aa8ef862ed2578b59c889dc4d.NEF+    3       SHA256E-s9442044--85c314e318f643237df5e3adf7559e9bf268ee28f1f92d4102161865323ddeb6.NEF+    4       SHA256E-s290672--c5822c3ef16bd62b5752b2dace81182ce00d64bd4d2d994ba93e3cb94e645708.JPG+    5       SHA256E-s293288--30f1367fc326f7b053012818863151206f9e3ddeab3c3fc5b5c1c573d120d50a.JPG+    6       SHA256E-s3672986--be960f6dc247df2496f634f7d788bd4a180fe556230e2dafc23ebc8fc1f10af3.JPG+  (To see where data was previously used, try: git log --stat -S'KEY')++  To remove unwanted data: git-annex dropunused NUMBER++ok+$ git-annex copy --unused --to synology+copy SHA256E-s9390266--7ed16c9423b331dbe63bb3b4278b8c94a6754a07177c53fceb3b24e9610e8054.NEF (checking synology...) ok+copy SHA256E-s10435713--49cbfe8466eada2c3787c9a7e158a7dfb9845a0aa8ef862ed2578b59c889dc4d.NEF (checking synology...) ok+copy SHA256E-s9442044--85c314e318f643237df5e3adf7559e9bf268ee28f1f92d4102161865323ddeb6.NEF (checking synology...) ok+copy SHA256E-s290672--c5822c3ef16bd62b5752b2dace81182ce00d64bd4d2d994ba93e3cb94e645708.JPG (checking synology...) ok+copy SHA256E-s293288--30f1367fc326f7b053012818863151206f9e3ddeab3c3fc5b5c1c573d120d50a.JPG (checking synology...) ok+copy SHA256E-s3672986--be960f6dc247df2496f634f7d788bd4a180fe556230e2dafc23ebc8fc1f10af3.JPG (checking synology...) ok+$+"""]]
+ doc/bugs/fsck_giving_false_checking_information.mdwn view
@@ -0,0 +1,29 @@+### Please describe the problem.+When a repository has no object of a given file and git annex fsck is run it still shows "fsck file ok", which is missleading in the sense, that it gives the impression that it checked the file is alright/checksummed.++As a result of this it seems that incremental fscks are not incremental with non checkable objects. On each run (after the first one) with "git annex fsck --incremental --more --schedule-limit 1d" all files without objects are checked even so it should wait another day till it checks again.++Probably best to say checksum couldn't be checked on x files (only give that as quiet output, not every check)++Another thing, which came up as a problem was, that checksum fsck would not be wanted to run as often as numcopie checks.+When the incremental fsck is used to check for bad files "git annex fsck --incremental --more --limit 1m" after a fast numcopies check "git annex fsck --incremental --more --limit 1m fast" it messes up the actual bad files check.+As both are currently using the same incremental "lock"-file they are colliding.++### What steps will reproduce the problem?+-++### What version of git-annex are you using? On what operating system?+git-annex version: 5.20140210-gd99db49+Linux (Ubuntu 13.10)++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+++# End of transcript or log.+"""]]++> [[fixed|done]] --[[Joey]]
+ doc/bugs/git_annex_sync_--content_not_syncing_all_objects.mdwn view
@@ -0,0 +1,31 @@+### Please describe the problem.+When "git annex sync --content" is used only objects currently in the working tree are synced. It doesn't honor full archives, which should get all objects.+So only objects similar to "git annex find --want-get" are synced and not every available object "git annex get --all"+++### What steps will reproduce the problem?+# mein repo:+git annex add file+git annex sync+git annex rm file+git annex sync++# other repo:+git annex wanted here "not copies=backup:3"+git annex find --want-get # will be empty+git annex sync --content # nothing is synced even so all files should be backed up+git annex get --all # will sync the object from file++### What version of git-annex are you using? On what operating system?+git-annex version: 5.20140210-gd99db49+Linux (Ubuntu 13.10)++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+++# End of transcript or log.+"""]]
+ doc/bugs/git_repo_fails_to_checkout.mdwn view
@@ -0,0 +1,39 @@+### Please describe the problem.++Attempting to clone the git repository produces++    (master) cayley:git-annex% git checkout -f HEAD+    error: unable to create file doc/bugs/fatal:_unable_to_access___39__..__47__..__47__..__47__..__47__C:__92__Users__92____91__...__93____92__annex__92__.git__47__config__39__:_Invalid_argument___40__Windows__41__.mdwn (File name too long)+    fatal: cannot create directory at 'doc/bugs/fatal:_unable_to_access___39__..__47__..__47__..__47__..__47__C:__92__Users__92____91__...__93____92__annex__92__.git__47__config__39__:_Invalid_argument___40__Windows__41__': File name too long++### What steps will reproduce the problem?++I get the above with either++    git clone https://github.com/joeyh/git-annex++or (after this fails) retrying with++    cd git-annex+    git checkout -f HEAD++### What version of git-annex are you using? On what operating system?++I am running git 1.9.0 from git (5f95c9f850b19b368c43ae399cc831b17a26a5ac in the git git repo) on Ubuntu 13.04.++> More encfs brain-damange.++	One such limitation is filename length.  If your underlying+	filesystem limits you to N characters in a filename, then+	EncFS will limit you to approximately 3*(N-2)/4.+ +> It's really astounding that Ubuntu inflicts that POS on users.+> However, I can't see that as justification for limiting the+> git-annex repository to filenames shorter than `PATH_MAX` -- just+> as DOS's problems with both filename length and also `:` in filenames+> is not a good reason to mangle the repository.+> +> In either case, it's up to the user to find a way to make it work. +> In the DOS case, that involves using Cygwin's git. In the encfs case,+> it presumably means checking it out into a real filesystem.+> [[done]] --[[Joey]]
+ doc/bugs/numcopies_deprecated__44___but_still_in_walkthrough.mdwn view
@@ -0,0 +1,21 @@+### Please describe the problem.+Within the walkthrough the deprecated annex.numcopies are still used. At least it should be added that "git annex numcopies x" can be used to define it globally without the need for a .gitattribute file. And use .gitattribute only for per directory and fine grained control.+http://git-annex.branchable.com/walkthrough/backups/++### What steps will reproduce the problem?+++### What version of git-annex are you using? On what operating system?+++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+++# End of transcript or log.+"""]]++> [[fixed|done]] --[[Joey]]
+ doc/bugs/problems_with_android_and_gpg.mdwn view
@@ -0,0 +1,73 @@+### Please describe the problem.+When my android phone tries to decode files downloaded from a ssh remote using shared encryption, gpg errors occur.++### What steps will reproduce the problem?+Setup is very similar to my other bug report in <https://git-annex.branchable.com/bugs/problems_with_android_and_xmpp/>.+Only difference is the location of the annex on the android side.+I have put it on the /data mount which uses ext4 to avoid the /sdcard fuse mount, which does not handle symlinks.++1) setup git annex via webapp on laptop:++* local annex++* remote annex via ssh with shared encryption (tried two different servers, one with and one without git-annex installed)++* share with my devices using jabber.me account++2) setup git annex via webapp on android:++* local annex in /data/data/ga.androidterm/annex (ext filesystem)++* share with my devices using jabber.me account++* ssh remote is automatically added via XMPP++3) add file to annex on linux, which gets uploaded to the ssh remote++4) symlink for file is created on phone and data downloaded, but never decrypted (see logs below)++### What version of git-annex are you using? On what operating system?+Ubunut Linux 12.04 with git-annex version:++* 5.20140127.1 (from PPA)++Android 4.2 (rooted) with git-annex version:++* 5.20140211-g556cfeb (from autobuilds)++### Please provide any additional information below.+full logs:++* linux: <http://pastebin.ca/2639929>++* android: <http://pastebin.ca/2639945>++most interesting parts:+[[!format sh """+#+# android:+#+gpg: can't open `/usr/local/share/gnupg/options.skel': No such file or directory+gpg: DBG: locking for `/sdcard/git-annex.home/.gnupg/secring.gpg.lock' done via O_EXCL+gpg: DBG: locking for `/sdcard/git-annex.home/.gnupg/pubring.gpg.lock' done via O_EXCL+gpg: decryption failed: bad key++# followed by just the last line for all further attemps+gpg: decryption failed: bad key++# gpg it self seems to be fine+root@android:/data/data/ga.androidterm # ./bin/gpg --version -v                +gpg (GnuPG) 1.4.15+Copyright (C) 2013 Free Software Foundation, Inc.+License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>+This is free software: you are free to change and redistribute it.+There is NO WARRANTY, to the extent permitted by law.++Home: ~/.gnupg+Supported algorithms:+Pubkey: RSA, RSA-E, RSA-S, ELG-E, DSA+Cipher: IDEA, 3DES, CAST5, BLOWFISH, AES, AES192, AES256, TWOFISH,+        CAMELLIA128, CAMELLIA192, CAMELLIA256+Hash: MD5, SHA1, RIPEMD160, SHA256, SHA384, SHA512, SHA224+Compression: Uncompressed, ZIP, ZLIB+"""]]
+ doc/bugs/problems_with_android_and_xmpp.mdwn view
@@ -0,0 +1,82 @@+### Please describe the problem.+When trying to sync my android phone with my linux laptop using the git annex assistant and XMPP no files are transferred.++### What steps will reproduce the problem?+1) setup git annex via webapp on laptop:++* local annex++* remote annex via ssh with shared encryption (tried two different servers, one with and one without git-annex installed)++* share with my devices using jabber.me account++2) setup git annex via webapp on android:++* local annex in /sdcard/annex (fuse filesystem without symlink support)++* share with my devices using jabber.me account++* ssh remote is automatically added via XMPP++3) add files to annex on linux, they get uploaded to the ssh remote++4) wait forever for any files from linux to download to phone++5) add files to annex on phone, they get uploaded to the ssh remote++4) wait forever for any files from phone to download to linux++### What version of git-annex are you using? On what operating system?+Ubunut Linux 12.04 with git-annex version:++* 5.20140127.1 (from PPA)++Android 4.2 (rooted) tried with git-annex versions:++* 5.20140209 (from http://downloads.kitenet.net/git-annex/android/current/4.0/)++* 5.20140211-g556cfeb (from autobuilds)++### Please provide any additional information below.+full logs:++(these do not show the uploads to the ssh remote, because I restarted to get clean and short logs, but the files are on the server and can be dropped and restored on the linux side manually) ++* linux: <http://pastebin.ca/2639948>++* android: <http://pastebin.ca/2639952>++most interesting parts:+[[!format sh """+#+# linux:+#++[2014-02-13 13:11:27 CET] XMPPClient: Pairing with dorian in progress+[2014-02-13 13:11:28 CET] XMPPSendPack: Syncing with dorian +To xmpp::dorian@jabber.me+ * [new branch]      git-annex -> refs/synced/4ce7576f-6f02-4657-bab5-2f4c4a564ee7/ZG9yaWFuQGphYmJlci5tZQ==/git-annex+ * [new branch]      annex/direct/master -> refs/synced/4ce7576f-6f02-4657-bab5-2f4c4a564ee7/ZG9yaWFuQGphYmJlci5tZQ==/annex/direct/master+[2014-02-13 13:11:29 CET] XMPPSendPack: Syncing with dorian +Everything up-to-date+[2014-02-13 13:12:21 CET] XMPPSendPack: Syncing with dorian +Everything up-to-date+[2014-02-13 13:12:21 CET] XMPPSendPack: Syncing with dorian +fatal: Could not read from remote repository.++Please make sure you have the correct access rights+and the repository exists.++#+# android:+#+[2014-02-13 13:16:25 CET] XMPPClient: sending: Pushing "d29" (ReceivePackOutput 2 "<elided>")+[2014-02-13 13:16:25 CET] XMPPClient: to client: d6/tigase-14134+[2014-02-13 13:18:22 CET] XMPPClient: received: ["Unknown message"]+[2014-02-13 13:18:25 CET] XMPPReceivePack: timeout waiting for git send-pack output via XMPP+fatal: The remote end hung up unexpectedly+[2014-02-13 13:18:25 CET] XMPPReceivePack: finished running push Pushing "d29" (StartingPush (UUID "4ce7576f-6f02-4657-bab5-2f4c4a564ee7")) True+[2014-02-13 13:18:25 CET] XMPPClient: sending: Pushing "d29" (ReceivePackDone (ExitFailure 128))+[2014-02-13 13:18:25 CET] XMPPClient: to client: d6/tigase-14134++"""]]
+ doc/bugs/rsync_transport:_username_not_respected.mdwn view
@@ -0,0 +1,38 @@+### Please describe the problem.++I created an encrypted rsync remote with a username (user@host). The rsync command issued by git-annex doesn't contain the username. I solved the problem using .ssh/config.++### What steps will reproduce the problem?+++[[!format sh """+# Add remote like that+git-annex initremote encrsync type=rsync rsyncurl=user@xxx.rsync.net:rsync/X keyid=0xXXX+# Sync it+git-annex sync --content+++# You'll see+$> ps ax | grep rsync+30652 pts/3    S+     0:00 /home/ganwell/bin/git-annex.linux//lib64/ld-linux-x86-64.so.2 --library-path /home/ganwell/bin/git-annex.linux//etc/ld.so.conf.d:/home/ganwell/bin/git-annex.linux//usr/lib/x86_64-linux-gnu/gconv:/home/ganwell/bin/git-annex.linux//usr/lib/x86_64-linux-gnu/libc:/home/ganwell/bin/git-annex.linux//usr/lib:/home/ganwell/bin/git-annex.linux//usr/lib/x86_64-linux-gnu:/home/ganwell/bin/git-annex.linux//lib64:/home/ganwell/bin/git-annex.linux//lib/x86_64-linux-gnu: /home/ganwell/bin/git-annex.linux/shimmed/rsync/rsync xxx.rsync.net:rsync/X/9fa/634/'GPGHMACSHA1--X/GPGHMACSHA1--X+"""]]++++### What version of git-annex are you using? On what operating system?++OS: Linux++Ver: git-annex version: 5.20140210-g1e0a3ad++Type: prebuilt++### Please provide any additional information below.++[[!format sh """+# If you can, paste a complete transcript of the problem occurring here.+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log+++# End of transcript or log.+"""]]
+ doc/bugs/trust_command_and_gitconfig_contradiction_causing_confusion.mdwn view
@@ -0,0 +1,35 @@+### Please describe the problem.+'trust', 'dead', etc commands completing with 'ok' but fail to acknowledge contradiction in .git/config, causing confusion.++[[!format sh """+greg@x200s:~/Photos$ git-annex untrust home  # yes, bad remote name+untrust home ok+(Recording state in git...) +greg@x200s:~/Photos$ git-annex status  # /me is old-school and forgets+greg@x200s:~/Photos$ git-annex info+repository mode: indirect+trusted repositories: 2+	c0e4106e-2631-11e2-9749-1bfa37a61069 -- rose+ 	c69d6fcc-18d1-11e2-9487-2fe6dbf0516b -- home (photos on eeepc)++....++greg@x200s:~/Photos$ git-annex dead home+dead home ok+(Recording state in git...)+greg@x200s:~/Photos$ git-annex info+repository mode: indirect+trusted repositories: 2+	c0e4106e-2631-11e2-9749-1bfa37a61069 -- rose+ 	c69d6fcc-18d1-11e2-9487-2fe6dbf0516b -- home (photos on eeepc)+"""]]++The home remote has "annex-trustlevel=trusted" in .git/config+++Maybe have those commands instead say "Hey, this is different than what you said explicitly in .git/config, ya sure? (y/n)" If y, overwrite config, if n, abort.++### What version of git-annex are you using? On what operating system?+5.20140127 on Debian++> [[Fixed|done]], it will now warn about this situation. --[[Joey]]
doc/design.mdwn view
@@ -1,8 +1,6 @@ git-annex's high-level design is mostly inherent in the data that it stores in git, and alongside git. See [[internals]] for details. -See [[encryption]] for design of encryption elements.--See [[roadmap]] for planning and scheduling of new stuff.+Here's the other design documents we have: -See [[assistant]] for the design site for the git-annex [[/assistant]].+[[!map pages="page(design/*) and !design/*/*"]]
doc/design/assistant/telehash.mdwn view
@@ -9,6 +9,8 @@   telehash v1 (even that seems incomplete). I have pinged its author   to see if he anticipates updating it. * Rapid development, situation may change in a month or 2.+* Is it secure? A security review should be done by competant people+  (not Joey). See <https://github.com/telehash/telehash.org/issues/23>  ## implementation basics
doc/design/external_special_remote_protocol.mdwn view
@@ -188,7 +188,7 @@   This is always the same for any given Key, so can be used for eg,   creating hash directory structures to store Keys in.     (git-annex replies with VALUE followed by the value.)-* `SETCONFIG Setting`  +* `SETCONFIG Setting Value`     Sets one of the special remote's configuration settings.     Normally this is sent during INITREMOTE, which allows these settings   to be stored in the git-annex branch, so will be available if the same
+ doc/design/metadata.mdwn view
@@ -0,0 +1,209 @@+[[!toc]]++# metadata++Attach an arbitrary set of metadata to a key. This consists of any number+of fields. Each field has an unordered set of values. The special field+"tag" has as its values any tags that are set for the key.++Store in git-annex branch, next to location log files.++Storage needs to support union merging, including removing an old value+of a field, and adding a new value of a field.++# filtered branches++See [[tips/metadata_driven_views]]++The reason to use specially named filtered branches is because it makes+self-documenting how the repository is currently filtered.++TODO: Files not matching the view should be able to be included.+For example, it could make a "unsorted" directory containing files+without a tag when viewing by tag. If also viewing by author, the unsorted+directories nest.++## operations while on filtered branch++* If files are removed and git commit called, git-annex should remove the+  relevant metadata from the files.  +  TODO: It's not clear that+  removing a file should nuke all the metadata used to filter it into the+  branch (especially if it's derived metadata like the year).+  Currently, only metadata used for visible subdirs is added and removed+  this way.+  Also, this is not usable in direct mode because deleting the+  file.. actually deletes it.+* If a file is moved into a new subdirectory while in a view branch,+  a tag is added with the subdir name. This allows on the fly tagging.+  **done**+* `git annex sync` should avoid pushing out the view branch, but+  it should check if there are changes to the metadata pulled in, and update+  the branch to reflect them.+* TODO: If `git annex add` adds a file, it gets all the metadata of the filter+  branch it's added to. If it's in a relevent directory (like fosdem-2014),+  it gets that metadata automatically recorded as well.++## automatically added metadata++TODO git annex add should automatically attach the current mtime of a file+when adding it.++Could also automatically attach permissions.++TODO A git hook could be run by git annex add to gather more metadata.+For example, by examining MP3 metadata.++Also auto add metadata when adding files to view branches. See below.++## derived metadata++This is probably not stored anywhere. It's computed on demand by a pure+function from the other metadata. +(Should be a general mechanism for this. (It probably generalizes to+sql queries if we want to go that far.))++### data metadata++TODO From the ctime, some additional +metadata is derived, at least year=yyyy and probably also month, etc.++### directory hierarchy metadata++TODO From the original filename used in the master branch, when+constructing a view, generate fields. For example foo/bar/baz.mp3+would get /=foo, foo/=bar, foo/bar/=baz, and .=mp3.++Note that dir/=subdir allows a view to use `dir/=*` and only+match one level of subdirs with the glob. So is better than dir=foo/bar+as the metadata. (Alternatively, could do special glob matching.)++This allows using whatever directory hierarchy exists to inform the view,+without locking the view into using it. ++Complication: When refining a view, it only looks at the filenames in+the view, so it would need to map from+those filenames to derive the same metadata, unless there is persistent+storage. Luckily, the filenames used in the views currently include the+subdirs (although not quite in a parseable format, would need some small+changes).++# other uses for metadata++Uses are not limited to view branches.++`git annex checkoutmeta year=2014 talk` in a subdir of master could create the+same tree of files filter would. The user can then commit that if desired.+Or, they could run additional commands like `git annex fadd` to refine the+tree of files in the subdir.++Metadata can be used for configuring numcopies. One way would be a+numcopies=n value attached to a file. But perhaps better would be to make+the numcopies.log allow configuring numcopies based on which files have+other metadata.++Other programs could query git-annex for the metadata of files in the work+tree, and do whatever it wants with it.++# filenames++The hard part of this is actually getting a useful filename to put in the+view branch, since git-annex only has a key which the user will not+want to see.++* Could use filename metadata for the key, recorded by git-annex add (which+  may not correspond to filenames being used in regular git branches like+  master for the key).+* Could use the .map files to get a filename, but this is somewhat+  arbitrary (.map can contain multiple filenames), and is only+  currently supported in direct mode.+* Current approach: Have a reference branch (eg master) and walk it to+  find filenames and+  keys. Fine as long as it can be done efficiently. Also allows including+  the subdirectory a file is in, potentially. cwebber points out that this+  is essentially a form of tracking branch. Which implies it will need to+  be updatable when the reference branch changes. Should be doable via+  diff-tree.++Note that we have to take care to avoid generating conflicting filenames.+The current approach is to embed the full directory structure inside the+filename in the view branch.++## union merge properties++While the storage could just list all the current values of a field on a+line with a timestamp, that's not good enough. Two disconnected+repositories can make changes to the values of a field (setting and+unsetting tags for example) and when this is union merged back together,+the changes need to be able to be replayed in order to determine which+values we end up with. ++To make that work, we log not only when a field is set to a value, +but when a value is unset as well.++For example, here two different remotes added tags, and then later+a tag was removed:++	1287290776.765152s tag +foo +bar+	1287290991.152124s tag +baz+	1291237510.141453s tag -bar++# efficient metadata lookup++Looking up metadata for view generation so far requires traversing all keys+in the git-annex branch. This is slow. A fast cache is needed.++TODO++# direct mode issues++TODO (direct mode is currently not supported with view branches)++Checking out a view branch can result in any number of copies of a file+appearing in different directories. No problem in indirect mode, but+in direct mode these are real, expensive copies.++But, it's worth supporting direct mode!++So, possible approaches:++* Before checking out a view branch, calculate how much space will+  be used by duplicates and refuse if not enough is free.+* Only check out one file, and omit the copies. Keep track of which+  files were omitted, and make sure that when committing on the branch,+  that metadata is not removed. Has the downside that files can seem+  to randomly move around in the tree as their metadata changes.+* Disallow view branch checkouts that have duplicate files.+  This would cripple it some, but perhaps not too badly?++# gotchas++* Checking out a view branch can remove the current subdir. May be worth+  detecting when this happens and help the user.+  **done**++* Git has a complex set of rules for what is legal in a ref name.+  View branch names will need to filter out any illegal stuff. **done**++* Filesystems that are not case sensative (including case preserving OSX)+  will cause problems if view branches try to use different cases for +  2 directories representing the value of some metadata. But, users+  probably want at least case-preserving metadata values. +  +  Solution might be to compare metadata case-insensitively, and+  pick one representation consistently, so if, for example an author+  field uses mixed case, it will be used in the view branch.++  Alternatively, it could escape `A` to `_A` when such a filesystem+  is detected and avoid collisions that way (double `_` to escape it).+  This latter option is ugly, but so are non-posix filesystems.. and it+  also solves any similar issues with case-colliding filenames.++  TODO: Check current state of this.++* Assistant needs to know about views, so it can update metadata when+  files are moved around inside them. TODO++* What happens if git annex add or the assistant add a new file while on a+  view? If the file is not also added to the master branch, it will be lost+  when exiting the view. TODO
doc/design/roadmap.mdwn view
@@ -9,10 +9,10 @@ * Month 3 user-driven features and polishing [[todo/direct_mode_guard]] [[assistant/upgrading]] * Month 4 [[Windows_webapp|assistant/Windows]], Linux arm, [[todo/support_for_writing_external_special_remotes]] * Month 5 user-driven features and polishing-* **Month 6 get [[assistant/Android]] and Windows out of beta**+* **Month 6 get Windows out of beta, [[metadata and views|design/metadata]]** * Month 7 user-driven features and polishing * Month 8 [[!traillink assistant/telehash]] * Month 9 [[!traillink assistant/gpgkeys]] [[!traillink assistant/sshpassword]]-* Month 10 user-driven features and polishing+* Month 10 get [[assistant/Android]] out of beta * Month 11 [[!traillink assistant/chunks]] [[!traillink assistant/deltas]] * Month 12 user-driven features and polishing
+ doc/devblog/day_111__windows_beta_release.mdwn view
@@ -0,0 +1,6 @@+Pushed out the new release. This is the first one where I consider the+git-annex command line beta quality on Windows.++Did some testing of the webapp on Windows, trying out every part of the UI.+I now have eleven todo items involving the webapp listed in+[[todo/windows_support]]. Most of them don't look too bad to fix.
+ doc/devblog/day_112__metadata_design.mdwn view
@@ -0,0 +1,18 @@+There's a new design document for letting git-annex store arbitrary+metadata. The really neat thing about this is the user can check out only+files matching the tags or values they care about, and get an automatically+structuted file tree layout that can be dynamically filtered. It's going to+be awesome! [[design/metadata]]++In the meantime, spent most of today working on Windows. Very good+progress, possibly motivated by wanting to get it over with so I can spend+some time this month on the above. ;)++* webapp can make box.com and S3 remotes. This just involved fixing a hack+  where the webapp set environment variables to communicate creds to+  initremote. Can't change environment on Windows (or I don't know how to).+* webapp can make repos on removable drives.+* `git annex assistant --stop` works, although this is not likely to really+  be useful+* The source tree now has 0 `func = error "Windows TODO"` type stubbed out+  functions to trip over.
+ doc/devblog/day_113__metadata_groundwork.mdwn view
@@ -0,0 +1,9 @@+Built the core data types, and log for metadata storage. Making metadata+union merge well is tricky, but I have a design I'm happy with, that will+allow distributed changes to metadata.++Finished up the day with a `git annex metadata` command to get/set metadata+for a file.++This is all the goundwork needed to begin experimenting with generating+git branches that display different metadata-driven views of annexed files.
+ doc/devblog/day_114__windows_porting.mdwn view
@@ -0,0 +1,8 @@+Windows porting all day. Fixed a lot of issues with the webapp,+so quite productive. Except for the 2 hours wasted finding a way to kill a+process by PID from Haskell on Windows.++Last night, made `git annex metadata` able to set metadata on a whole+directory or list of files if desired. And added a `--metadata field=value`+switch (and corresponding preferred content terminal) which limits+git-annex to acting on files with the specified metadata.
+ doc/devblog/day_115__windows_porting.mdwn view
@@ -0,0 +1,17 @@+More Windows porting.. Seem to be getting near an end of the easy stuff,+and also the webapp is getting pretty usable on Windows now, the only+really important thing lacking is XMPP support.++Made git-annex on Windows set HOME when it's not already set. Several of+the bundled cygwin tools only look at HOME. This was made a lot harder and+uglier due to there not being any way to modify the environment of the+running process.. git-annex has to re-run itself with the fixed+environment.++Got rsync.net working in the webapp. Although with an extra rsync.net+password prompt on Windows, which I cannot find a way to avoid.++While testing that, I discovered that openssh 6.5p1 has broken support for+~/.ssh/config Host lines that contain upper case letters! I have filed a+bug about this and put a quick fix in git-annex, which sometimes generated+such lines.
+ doc/devblog/day_116__views.mdwn view
@@ -0,0 +1,54 @@+Working on building [[design/metadata]] filtered branches.++Spent most of the day on types and pure code. Finally at the end +I wrote down two actions that I still need to implement to make+it all work:++[[!format haskell """+applyView' :: MkFileView -> View -> Annex Git.Branch+updateView :: View -> Git.Ref -> Git.Ref -> Annex Git.Branch+"""]]++I know how to implement these, more or less. And in most cases+they will be pretty fast.++The more interesting part is already done. That was the issue of how to+generate filenames in the filter branches. That depends on the `View` being+used to filter and organize the branch, but also on the original filename used+in the reference branch. Each filter branch has a reference branch (such as+"master"), and displays a filtered and metadata-driven reorganized tree+of files from its reference branch.++[[!format haskell """+fileViews :: View -> (FilePath -> FileView) -> FilePath -> MetaData -> Maybe [FileView]+"""]]++So, a view that matches files tagged "haskell" or "git-annex"+and with an author of "J\*" will generate filenames like +"haskell/Joachim/interesting_theoretical_talk.ogg" and+"git-annex/Joey/mytalk.ogg".++It can also work backwards from these +filenames to derive the MetaData that is encoded in them.++[[!format haskell """+fromView :: View -> FileView -> MetaData+"""]]++So, copying a file to "haskell/Joey/mytalk.ogg" lets it know that+it's gained a "haskell" tag. I knew I was on the right track when+`fromView` turned out to be only 6 lines of code!++The trickiest part of all this, which I spent most of yesterday thinking+about, is what to do if the master branch has files in subdirectories. It+probably does not makes sense to retain that hierarchical directory+structure in the filtered branch, because we instead have a+non-hierarchical metadata structure to express. (And there would probably+be a lot of deep directory structures containing only one file.) But+throwing away the subdirectory information entirely means that two files+with the same basename and same metadata would have colliding names.++I eventually decided to embed the subdirectory information into the filenames+used on the filter branch. Currently that is done by converting+`dir/subdir/file.foo` to `file(dir)(subdir).foo`. We'll see how this works+out in practice..
+ doc/devblog/day_117__views_implemented.mdwn view
@@ -0,0 +1,76 @@+Today I built `git annex view`, and `git annex vadd` and a few related+commands. A quick demo:++<pre>+joey@darkstar:~/lib/talks>ls+Chaos_Communication_Congress/  FOSDEM/       Linux_Conference_Australia/+Debian/                        LibrePlanet/  README.md+joey@darkstar:~/lib/talks>git annex view tag=*+view  (searching...)+Switched to branch 'views/_'+ok+joey@darkstar:~/lib/talks#_>tree -d+.+|-- Debian+|-- android+|-- bigpicture+|-- debhelper+|-- git+|-- git-annex+`-- seen++7 directories+joey@darkstar:~/lib/talks#_>git annex vadd author=*+vadd  +Switched to branch 'views/author=_;_'+ok+joey@darkstar:~/lib/talks#author=_;_>tree -d+.+|-- Benjamin Mako Hill+|   `-- bigpicture+|-- Denis Carikli+|   `-- android+|-- Joey Hess+|   |-- Debian+|   |-- bigpicture+|   |-- debhelper+|   |-- git+|   `-- git-annex+|-- Richard Hartmann+|   |-- git+|   `-- git-annex+`-- Stefano Zacchiroli+    `-- Debian++15 directories+joey@darkstar:~/lib/talks#author=_;_>git annex vpop+vpop 1+Switched to branch 'views/_'+ok+joey@darkstar:~/lib/talks#_>git annex vadd tag=git-annex+vadd  +Switched to branch 'views/(git-annex)'+ok+joey@darkstar:~/lib/talks#(git-annex)>ls+1025_gitify_your_life_{Debian;2013;DebConf13;high}.ogv@+git_annex___manage_files_with_git__without_checking_their_contents_into_git_{FOSDEM;2012;lightningtalks}.webm@+mirror.linux.org.au_linux.conf.au_2013_mp4_gitannex_{Linux_Conference_Australia;2013}.mp4@+joey@darkstar:~/lib/talks#_>git annex vpop 2+vpop 2+Switched to branch 'master'+ok+</pre>++Not 100% happy with the speed -- the generation of the view branch is close+to optimal, and fast enough (unless the branch has very many matching+files). And `vadd` can be quite fast if the view has already limited the+total number of files to a smallish amount. But `view` has to look at every+file's metadata, and this can take a while in a large repository. Needs indexes.++It also needs integration with `git annex sync`, so the view branches+update when files are added to the master branch, and moving files around+inside a view and committing them does not yet update their metadata.++---++Today's work was sponsored by Daniel Atlas.
+ doc/devblog/day_118__views_refined.mdwn view
@@ -0,0 +1,7 @@+Still working on views. The most important addition today is that+`git annex precommit` notices when files have been moved/copied/deleted+in a view, and updates the metadata to reflect the changes.++Also wrote some walkthrough documentation: [[tips/metadata_driven_views]].  +And, recorded a screencast demoing views, which I will upload next time+I have bandwidth.
+ doc/devblog/day_119__catching_up.mdwn view
@@ -0,0 +1,15 @@+Spent the day catching up on the last week or so's traffic. Ended up+making numerous small big fixes and improvements. Message backlog stands at+44.++Here's the [[screencast demoing views|videos/git-annex_views_demo]]!++Added to the design today the idea of+automatically deriving metadata from the location of files in the master+branch's directory tree. Eg, `git annex view tag=* podcasts/=*` in a+repository that has a `podcasts/` directory would make a tree like+"$tag/$podcast". Seems promising. ++So much still to do with views.. I have belatedly added them to+the roadmap for this month; doing Windows and Android in the same month was+too much to expect.
doc/forum/alternativeto.net___34__Like__34__.mdwn view
@@ -1,3 +1,3 @@ When I went to alternativeto.net I noticed that SpiderOak is a featured application. I decided to search git-annex and see how "Like"-ed it is in comparison... there were 0 "Like"-s. -I suggest going to http://alternativeto.net/software/git-annex/ and "Like" git-annex.+I suggest going to <http://alternativeto.net/software/git-annex/> and "Like" git-annex.
+ doc/forum/not_finding_git-annex-shell_on_remote.mdwn view
@@ -0,0 +1,21 @@+I have set up an annex on a remote machine and I am connecting via ssh.  But, since it is a managed machine, I installed the git-annex binary in my own ~/bin.  Well, when I try +$git annex sync++I get:+  $git annex sync+(merging origin/git-annex into git-annex...)+(Recording state in git...)+bash: git-annex-shell: command not found++  Remote origin does not have git-annex installed; setting annex-ignore+commit  ok+pull origin ++merge: refs/remotes/origin/master - not something we can merge++merge: refs/remotes/origin/synced/master - not something we can merge+failed+git-annex: sync: 1 failed+++The git remote -v looks correct.  So, how do I tell git annex on my local machine where to use $HOME/bin in PATH on the remote machine when syncing  with remotes?
doc/git-annex.mdwn view
@@ -503,9 +503,10 @@   To avoid expensive checksum calculations (and expensive transfers when   fscking a remote), specify `--fast`. -  To start a new incremental fsck, specify `--incremental`. Then-  the next time you fsck, you can specify `--more` to skip over-  files that have already been checked, and continue where it left off.+  To start a new incremental fsck, use the `--incremental` option. Then+  the next time you fsck, you can instead use the `--more` option +  to skip over files that have already been checked, and continue+  where it left off.    The `--incremental-schedule` option makes a new incremental fsck be   started a configurable time after the last incremental fsck was started.@@ -693,6 +694,72 @@   Note that this subcommand can be used to graph any git repository; it   is not limited to git-annex repositories. +# METADATA COMMANDS++* `metadata [path ...] [-s field=value -s field+=value -s field-=value ...]`++  Each file can have any number of metadata fields attached to it,+  which each in turn have any number of values. This sets metadata+  for the specified file or files, or if run without any values, shows+  the current metadata.++  To set a field's value, removing any old value(s), use -s field=value.++  To add an additional value, use -s field+=value.++  To remove a value, use -s field-=value.++  To set a tag, use -t tag, and use -u tag to remove a tag.++  For example, to set some tags on a file and also its author:++        	git annex metadata annexscreencast.ogv -t video -t screencast -s author+=Alice++* `view [field=value ...] [tag ...]`++  Uses metadata to build a view branch of the files in the current branch,+  and checks out the view branch. Only files in the current branch whose+  metadata matches all the specified field values and tags will be+  shown in the view.+  +  Multiple values for a metadata field can be specified, either by using+  a glob (`field="*"`) or by listing each wanted value. The resulting view+  will put files in subdirectories according to the value of their fields.++  Once within a view, you can make additional directories, and+  copy or move files into them. When you commit, the metadata will+  be updated to correspond to your changes.++* `vpop [N]`++  Switches from the currently active view back to the previous view.+  Or, from the first view back to original branch.++  The optional number tells how many views to pop.++* `vfilter [field=value ...] [tag ...]`++  Filters the current view to only the files that have the+  specified values and tags.++* `vadd [field=glob ...]`++  Changes the current view, adding an additional level of directories+  to categorize the files.++  For example, when the view is by author/tag, `vadd year=*` will +  change it to year/author/tag. +  +  So will `vadd year=2014 year=2013`, but limiting the years in view+  to only those two.++* `vcycle`++  When a view involves nested subdirectories, this cycles the order.++  For example, when the view is by year/author/tag, `vcycle` will switch+  it to author/tag/year.+ # UTILITY COMMANDS  * `migrate [path ...]`@@ -753,7 +820,8 @@    Fixes up symlinks that are staged as part of a commit, to ensure they   point to annexed content. Also handles injecting changes to unlocked-  files into the annex.+  files into the annex. When in a view, updates metadata to reflect changes+  made to files in the view.  * `lookupkey [file ...]` @@ -1065,6 +1133,11 @@   The size can be specified with any commonly used units, for example,   "0.5 gb" or "100 KiloBytes" +* `--metadata field=value`++  Matches only files that have a metadata field attached with the specified+  value.+ * `--want-get`    Matches files that the preferred content settings for the repository@@ -1552,6 +1625,15 @@ 	*.flac annex.numcopies=3  Note that setting numcopies to 0 is very unsafe.++These settings are honored by git-annex whenever it's operating on a+matching file. However, when using --all, --unused, or --key to specify+keys to operate on, git-annex is operating on keys and not files, so will+not honor the settings from .gitattributes.++Also note that when using views, only the toplevel .gitattributes file is+preserved in the view, so other settings in other files won't have any+efffect.  # FILES
+ doc/install/OSX/comment_34_874ff01f27911baf6ef0f559d5d5f5a0._comment view
@@ -0,0 +1,27 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawn3rK4VDzxyhmrIc18z7F5OuXvEbUsgUac"+ nickname="Srinath"+ subject="build issue with brew technique on Darwin Kernel Version 13.0.0"+ date="2014-02-15T02:17:16Z"+ content="""+Following the Mac OS X brew instructions from the top of the board, I got the following error:++[5 of 5] Compiling Yesod            ( Yesod.hs, dist/build/Yesod.o )+In-place registering yesod-1.2.5...+Installing library in /Users/srinathv/.cabal/lib/yesod-1.2.5/ghc-7.6.3+Registering yesod-1.2.5...+Installed yesod-1.2.5+cabal: Error: some packages failed to install:+git-annex-5.20140210 depends on libxml-sax-0.7.4 which failed to install.+libxml-sax-0.7.4 failed during the configure step. The exception was:+ExitFailure 1+network-protocol-xmpp-0.4.5 depends on libxml-sax-0.7.4 which failed to+install.+++Then I perused the comments and did:+$brew link libmxl2 --force+$cabal install git-annex --bindir=$HOME/bin++with success.  +"""]]
doc/internals.mdwn view
@@ -146,6 +146,27 @@ 	1287290776.765152s e605dca6-446a-11e0-8b2a-002170d25c55 blah blah 	1287290767.478634s 26339d22-446b-11e0-9101-002170d25c55 foo=bar +## `aaa/bbb/*.log.met`++These log files are used to store arbitrary [[design/metadata]] about keys.+Each key can have any number of metadata fields. Each field has a set of+values.++Lines are timestamped, and record when values are added (`field +value`),+but also when values are removed (`field -value`). Removed values+are retained in the log so that when merging an old line that sets a value+that was later unset, the value is not accidentially added back.++For example:++	1287290776.765152s tag +foo +bar author +joey+	1291237510.141453s tag -bar +baz++The value can be completely arbitrary data, although it's typically+reasonably short. If the value contains any whitespace+(including \r or \r), it will be base64 encoded. Base64 encoded values+are indicated by prefixing them with "!" + ## `schedule.log`  Used to record scheduled events, such as periodic fscks.
− doc/news/version_5.20140116.mdwn 
@@ -1,21 +0,0 @@-git-annex 5.20140116 released with [[!toggle text="these changes"]]-[[!toggleable text="""-   * Added tahoe special remote.-   * external special remote protocol: Added GETGITDIR, and GETAVAILABILITY.-   * Refuse to build with git older than 1.7.1.1, which is needed for-     git checkout -B-   * map: Fix display of v5 direct mode repos.-   * repair: Support old git versions from before git fsck --no-dangling was-     implemented.-   * Fix a long-standing bug that could cause the wrong index file to be used-     when committing to the git-annex branch, if GIT\_INDEX\_FILE is set in the-     environment. This typically resulted in git-annex branch log files being-     committed to the master branch and later showing up in the work tree.-     (These log files can be safely removed.)-   * assistant: Detect if .git/annex/index is corrupt at startup, and-     recover.-   * repair: Fix bug in packed refs file exploding code that caused a .gitrefs-     directory to be created instead of .git/refs-   * Fix FTBFS on mipsel and sparc due to test suite not being available-     on those architectures.-   * Android: Avoid passing --clobber to busybox wget."""]]
+ doc/news/version_5.20140221.mdwn view
@@ -0,0 +1,28 @@+git-annex 5.20140221 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * metadata: New command that can attach metadata to files.+   * --metadata can be used to limit commands to acting on files+     that have particular metadata.+   * Preferred content expressions can use metadata=field=value+     to limit them to acting on files that have particular metadata.+   * view: New command that creates and checks out a branch that provides+     a structured view of selected metadata.+   * vfilter, vadd, vpop, vcycle: New commands for operating within views.+   * pre-commit: Update metadata when committing changes to locations+     of annexed files within a view.+   * Add progress display for transfers to/from external special remotes.+   * unused: Fix to actually detect unused keys when in direct mode.+   * fsck: When run with --all or --unused, while .gitattributes+     annex.numcopies cannot be honored since it's operating on keys+     instead of files, make it honor the global numcopies setting,+     and the annex.numcopies git config setting.+   * trust, untrust, semitrust, dead: Warn when the trust level is+     overridden in .git/config.+   * glacier: Do not try to run glacier value create when an existing glacier+     remote is enabled.+   * fsck: Refuse to do anything if more than one of --incremental, --more,+     and --incremental-schedule are given, since it's not clear which option+     should win.+   * Windows webapp: Can set up box.com, Amazon S3, and rsync.net remotes+   * Windows webapp: Can create repos on removable drives.+   * Windows: Ensure HOME is set, as needed by bundled cygwin utilities."""]]
doc/special_remotes.mdwn view
@@ -38,6 +38,7 @@ * [[IMAP|forum/special_remote_for_IMAP]] * [[Usenet|forum/nntp__47__usenet special remote]] * [chef-vault](https://github.com/3ofcoins/knife-annex/)+* [hubiC](https://github.com/Schnouki/git-annex-remote-hubic)  Want to add support for something else? [[Write your own!|external]]
+ doc/tips/metadata_driven_views.mdwn view
@@ -0,0 +1,121 @@+git-annex now has support for storing +[[arbitrary metadata|design/metadata]] about annexed files. For example, this can be+used to tag files, to record the author of a file, etc. The metadata is+synced around between repositories with the other information git-annex+keeps track of.++One nice way to use the metadata is through **views**. You can ask+git-annex to create a view of files in the currently checked out branch+that have certian metadata. Once you're in a view, you can move and copy+files to adjust their metadata further. Rather than the traditional+hierarchical directory structure, views are dynamic; you can easily+refine or reorder a view.++Let's get started by setting some tags on files. No views yet, just some+metadata:++	# git annex metadata --tag todo work/2014/*+	# git annex metadata --untag todo work/2014/done/*+	# git annex metadata --tag urgent work/2014/presentation_for_tomorrow.odt+	# git annex metadata --tag done work/2013/* work/2014/done/*+	# git annex metadata --tag work work+	# git annex metadata --tag video videos+	# git annex metadata --tag work videos/operating_heavy_machinery.mov+	# git annex metadata --tag done videos/old+	# git annex metadata --tag new videos/lotsofcats.ogv+	# git annex metadata --tag sound podcasts+	# git annex metadata --tag done podcasts/old+	# git annex metadata --tag new podcasts/recent++So, you had a bunch of different kinds of files sorted into a directory+structure. But that didn't really reflect how you approach the files.+Adding some tags lets you categorize the files in different ways.++Ok, metadata is in place, but how to use it? Time to change views!++	# git annex view tag=*+	view  (searching...)++	Switched to branch 'views/_'+	ok++This searched for all files with any tag, and created a new git branch+that sorts the files according to their tags.++	# tree -d+	work+	todo+	urgent+	done+	new+	video+	sound++Notice that a single file may appear in multiple directories+depending on its tags. For example, `lotsofcats.ogv` is in+both `new/` and `video/`.++Ah, but you're at work now, and don't want to be distracted by cat videos.+Time to filter the view:++	# git annex vfilter tag=work+	vfilter+	Switched to branch 'views/(work)/_'+	ok++Now only the work files are in the view, and they're otherwise categorized+according to their other tags. So you can check the `urgent/` directory+to see what's next, and look in `todo/` for other work related files.++Now that you're in a tag based view, you can move files around between the+directories, and when you commit your changes to git, their tags will be+updated.++	# git mv urgent/presentation_for_tomorrow_{work;2014}.odt ../done+	# git commit -m "a good day's work"+	metadata tag-=urgent+	metadata tag+=done++You can return to a previous view by running `git annex vpop`. If you pop+all the way out of all views, you'll be back on the regular git branch you+originally started from. You can also use `git checkout` to switch between+views and other branches.++Beyond simple tags, you can add whatever kinds of metadata you like, and+use that metadata in more elaborate views. For example, let's add a year+field.++	# git checkout master+	# git annex metadata --set year=2014 work/2014+	# git annex metadata --set year=2013 work/2013+	# git annex view year=* tag=*++Now you're in a view with two levels of directories, first by year and then+by tag.++	# tree -d+	2014+	  |-- work+          |-- todo+	  |-- urgent+          `-- done+	2013+	  |-- work+	  `-- done++Oh, did you want it the other way around? Easy!++	# git annex vcycle+	# tree -d+	work+	  |-- 2014+	  `-- 2013+	todo+	  `-- 2014+	urgent+	  `-- 2014+	done+	  |-- 2014+	  `-- 2013++This has probably only scratched the surface of what you can do with views.
doc/tips/using_Amazon_Glacier.mdwn view
@@ -24,7 +24,7 @@          # cd /media/usb/annex         # git pull laptop-        # git annex initremote glacier+        # git annex enableremote glacier         initremote glacier (gpg) ok  Now the remote can be used like any other remote.
+ doc/todo/Use_bitcoin-mining_ASICs_for_hashing__63__.mdwn view
@@ -0,0 +1,18 @@+This is just an idea, and I have no idea if it would work (that's why I'm asking):++**Would it be possible to use ASICs made for Bitcoin mining inside git-annex to offload the hashing of files?**++I got the idea, because I have two RaspberryPis here: ++- one runs my git-annex archive. It is really slow at hashing, so I resorted to using the WORM backend+- another one runs 2 old-ish ASIC miners. They are just barely "profitable" right now, so in a few months they will be obsolete++Both devices to some kind of `SHA256`. I have a feeling this is either extremely easy or extremely complicated to do… :)++> git-annex uses binaries such as `sha256sum` for hashing large files (large is+> currently hardcoded as bigger than 1MB). If you insert a binary with the same+> interface as `sha256sum` into your `$PATH`, git-annex will automatically use+> it. If you want to use ASIC hashing even for small files, you need to tweak+> `Backend/Hash.hs`. --[[HelmutGrohne]]++>> [[done]] --[[Joey]]
doc/todo/add_metadata_to_annexed_files.mdwn view
@@ -1,5 +1,14 @@-I would like to attach metadata to annexed files (objects) without cluttering the workdir with files containing this metadata. A common use case would be to add titles to my photo collection that could than end up in a generated photo album.+I would like to attach metadata to annexed files (objects) without+cluttering the workdir with files containing this metadata. A common use+case would be to add titles to my photo collection that could than end up+in a generated photo album.  Depending on the implementation it might also be possible to use the metadata facility for a threaded commenting system. -The first question is whether the metadata is attached to the objects and thus shared by all paths pointing to the same data object or to paths in the worktree. I've no preference here at this point.+The first question is whether the metadata is attached to the objects and+thus shared by all paths pointing to the same data object or to paths in+the worktree. I've no preference here at this point.++> This is [[done]]; see [[design/metadata]].+> The metadata is attached to objects, not to files.+> --[[Joey]]
+ doc/todo/openwrt_package/comment_2_2cb7dd4c0cc4413a4588b13cf7700de2._comment view
@@ -0,0 +1,9 @@+[[!comment format=mdwn+ username="https://www.google.com/accounts/o8/id?id=AItOawkNE-H4vEcbcGndxq5daT8qUb7yIf7r1OE"+ nickname="Łukasz"+ subject="comment 2"+ date="2014-02-11T21:05:00Z"+ content="""+if debian does not have working toolchain for mips then there is no way to port it into mips machines.+am i correct ?+"""]]
+ doc/todo/openwrt_package/comment_3_5ba8a325a683ff543d81a366c873070d._comment view
@@ -0,0 +1,8 @@+[[!comment format=mdwn+ username="http://joeyh.name/"+ ip="209.250.56.172"+ subject="comment 3"+ date="2014-02-11T21:39:34Z"+ content="""+Actually, debian stable does still have ghc building for mips/mipsel. It's just newer versions that have failed to build and nobody has fixed it yet.+"""]]
+ doc/todo/whislist:_allow_setting_annex-ignore_from_the_webapp.mdwn view
@@ -0,0 +1,2 @@+I would like to be able to set 'annex-ignore' for remote servers through the webapp.+Maybe a checkbox beneath "Syncing enabled" with something like "Also sync content" that it's checked by default?
doc/todo/windows_support.mdwn view
@@ -3,22 +3,11 @@  ## status -* Does not work with Cygwin's build of git (that git does not consistently-  support use of DOS style paths, which git-annex uses on Windows). -  Must use Msysgit.-* rsync special remotes with a rsyncurl of a local directory are known-			let r = if inr1 then r1 else r2-  buggy. (git-annex tells rsync C:foo and it thinks it means a remote host-  named C...)-* Ssh connection caching does not work on Windows, so `git annex get`-  has to connect twice to the remote system over ssh per file, which-  is much slower than on systems supporting connection caching.-* `git annex assistant` has not been tested, is probably quite incomplete-  and/or buggy. * Doesn't daemonize. Maybe use   <http://hackage.haskell.org/package/Win32-services>   or perhaps easier,   <http://hackage.haskell.org/package/Win32-services-wrapper>+ * XMPP library not yet built.      This should work to install the deps, using libs from cygwin@@ -34,3 +23,42 @@    Also needs gsasl, which is not in cygwin.    See <http://josefsson.org/gsasl4win/README.html>++* View debug log is empty in windows -- all logs go to console.+  This messes up a few parts of UI that direct user to the debug log.+  Should try to get rid of the console, but only once ssh passwords+  (and possibly gpg) are not prompted there anymore.++* Local pairing seems to fail, after acking on Linux box, it stalls.++* gcrypt is not ported to windows (and as a shell script, may need+  to be rewritten)++* Incremental fsck sets the sticky bit to record when a file is fscked,+  and this is not done on windows, so fsck doesn't behave incrementally+  there.++* Deleting a git repository from inside the webapp fails "RemoveDirectory+  permision denied ... file is being used by another process"++## minor problems++* Does not work with Cygwin's build of git (that git does not consistently+  support use of DOS style paths, which git-annex uses on Windows). +  Must use Msysgit.+* rsync special remotes with a rsyncurl of a local directory are known+  buggy. (git-annex tells rsync C:foo and it thinks it means a remote host+  named C...)+* webapp lets user choose to encrypt repo, and generate gpg key,+  before checking that gcrypt is not installed+* Ssh connection caching does not work on Windows, so `git annex get`+  has to connect twice to the remote system over ssh per file, which+  is much slower than on systems supporting connection caching.+* glacier-cli is not easily available (probably)++## stuff needing testing++* test S3 and box.com setup in webapp now that they should work..+* test that adding a repo on a removable drive works; that git is synced to+  it and files can be transferred to it and back+* Does stopping in progress transfers work in the webapp?
doc/todo/wishlist:_more_descriptive_commit_messages_in_git-annex_branch.mdwn view
@@ -37,3 +37,19 @@  >> Closing as this is literally impossible to do without making >> git-annex worse. [[done]] --[[Joey]] ++> I'm not sure that the requested feature is that far off. There are two+> aspects, that can be solved relatively easy:+>+>  * Recording the name of the remote the commit was issued on. This+>    information is simply constant per remote.+>+>  * While it is true that there is no 1 on 1 correspondence between commands+>    and git-annex commits, it would be entirely possible to add a "message+>    journal". Every command issued would start out with writing its+>    invocation to the message journal. At the time the journal ends up being+>    committed to the git-annex branch, the message journal is used as the+>    body of the commit message and truncated.+>+> It is true that these suggestions do not address every aspect of the+> original report, but they would solve about 90%. --[[HelmutGrohne]]
+ doc/videos/git-annex_views_demo.mdwn view
@@ -0,0 +1,11 @@+A quick screencast demoing an experimental new feature,+[[tips/metadata_driven_views]].++<video controls src="https://downloads.kitenet.net/videos/git-annex/git-annex_views_demo.ogg"></video>++[video](https://downloads.kitenet.net/videos/git-annex/git-annex_views_demo.ogg)++Credits: ++* RichiH for <https://github.com/RichiH/conference_proceedings>+* Michi for keyboard cat cameo
doc/walkthrough/backups.mdwn view
@@ -1,15 +1,17 @@ git-annex can be configured to require more than one copy of a file exists,-as a simple backup for your data. This is controlled by the "annex.numcopies"-setting, which defaults to 1 copy. Let's change that to require 2 copies,-and send a copy of every file to a USB drive.+as a simple backup for your data. This is controlled by the+numcopies setting, which defaults to 1 copy. Let's+change that to require 2 copies, and send a copy of every file+to a USB drive. -	# echo "* annex.numcopies=2" >> .gitattributes+	# git annex numcopies 2 	# git annex copy . --to usbdrive  Now when we try to `git annex drop` a file, it will verify that it knows of 2 other repositories that have a copy before removing its content from the current repository. +The numcopies setting used above is the global default. You can also vary the number of copies needed, depending on the file name. So, if you want 3 copies of all your flac files, but only 1 copy of oggs:
git-annex.1 view
@@ -463,9 +463,10 @@ To avoid expensive checksum calculations (and expensive transfers when fscking a remote), specify \fB\-\-fast\fP. .IP-To start a new incremental fsck, specify \fB\-\-incremental\fP. Then-the next time you fsck, you can specify \fB\-\-more\fP to skip over-files that have already been checked, and continue where it left off.+To start a new incremental fsck, use the \fB\-\-incremental\fP option. Then+the next time you fsck, you can instead use the \fB\-\-more\fP option +to skip over files that have already been checked, and continue+where it left off. .IP The \fB\-\-incremental\-schedule\fP option makes a new incremental fsck be started a configurable time after the last incremental fsck was started.@@ -639,6 +640,66 @@ Note that this subcommand can be used to graph any git repository; it is not limited to git\-annex repositories. .IP+.SH METADATA COMMANDS+.IP "\fBmetadata [path ...] [\-s field=value \-s field+=value \-s field\-=value ...]\fP"+.IP+Each file can have any number of metadata fields attached to it,+which each in turn have any number of values. This sets metadata+for the specified file or files, or if run without any values, shows+the current metadata.+.IP+To set a field's value, removing any old value(s), use \-s field=value.+.IP+To add an additional value, use \-s field+=value.+.IP+To remove a value, use \-s field\-=value.+.IP+To set a tag, use \-t tag, and use \-u tag to remove a tag.+.IP+For example, to set some tags on a file and also its author:+.IP+ git annex metadata annexscreencast.ogv \-t video \-t screencast \-s author+=Alice+.IP+.IP "\fBview [field=value ...] [tag ...]\fP"+Uses metadata to build a view branch of the files in the current branch,+and checks out the view branch. Only files in the current branch whose+metadata matches all the specified field values and tags will be+shown in the view.+.IP+Multiple values for a metadata field can be specified, either by using+a glob (\fBfield="*"\fP) or by listing each wanted value. The resulting view+will put files in subdirectories according to the value of their fields.+.IP+Once within a view, you can make additional directories, and+copy or move files into them. When you commit, the metadata will+be updated to correspond to your changes.+.IP+.IP "\fBvpop [N]\fP"+Switches from the currently active view back to the previous view.+Or, from the first view back to original branch.+.IP+The optional number tells how many views to pop.+.IP+.IP "\fBvfilter [field=value ...] [tag ...]\fP"+Filters the current view to only the files that have the+specified values and tags.+.IP+.IP "\fBvadd [field=glob ...]\fP"+Changes the current view, adding an additional level of directories+to categorize the files.+.IP+For example, when the view is by author/tag, \fBvadd year=*\fP will +change it to year/author/tag. +.IP+So will \fBvadd year=2014 year=2013\fP, but limiting the years in view+to only those two.+.IP+.IP "\fBvcycle\fP"+When a view involves nested subdirectories, this cycles the order.+.IP+For example, when the view is by year/author/tag, \fBvcycle\fP will switch+it to author/tag/year.+.IP .SH UTILITY COMMANDS .IP "\fBmigrate [path ...]\fP" .IP@@ -694,7 +755,8 @@ .IP Fixes up symlinks that are staged as part of a commit, to ensure they point to annexed content. Also handles injecting changes to unlocked-files into the annex.+files into the annex. When in a view, updates metadata to reflect changes+made to files in the view. .IP .IP "\fBlookupkey [file ...]\fP" This plumbing\-level command looks up the key used for a file in the@@ -963,6 +1025,10 @@ The size can be specified with any commonly used units, for example, "0.5 gb" or "100 KiloBytes" .IP+.IP "\fB\-\-metadata field=value\fP"+Matches only files that have a metadata field attached with the specified+value.+.IP .IP "\fB\-\-want\-get\fP" Matches files that the preferred content settings for the repository make it want to get. Note that this will match even files that are@@ -1385,6 +1451,15 @@  *.flac annex.numcopies=3 .PP Note that setting numcopies to 0 is very unsafe.+.PP+These settings are honored by git\-annex whenever it's operating on a+matching file. However, when using \-\-all, \-\-unused, or \-\-key to specify+keys to operate on, git\-annex is operating on keys and not files, so will+not honor the settings from .gitattributes.+.PP+Also note that when using views, only the toplevel .gitattributes file is+preserved in the view, so other settings in other files won't have any+efffect. .PP .SH FILES These files are used by git\-annex:
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20140210+Version: 5.20140221 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -105,6 +105,7 @@    if (os(windows))     Build-Depends: Win32, Win32-extras+    C-Sources: Utility/winprocess.c   else     Build-Depends: unix     -- Need to list these because they're generated from .hsc files.
git-annex.hs view
@@ -1,13 +1,13 @@-{- git-annex main program stub+{- git-annex main program dispatch  -- - Copyright 2010-2013 Joey Hess <joey@kitenet.net>+ - Copyright 2010-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}  {-# LANGUAGE CPP #-} -import System.Environment+import System.Environment (getArgs, getProgName) import System.FilePath  import qualified CmdLine.GitAnnex@@ -16,19 +16,61 @@ import qualified Test #endif +#ifdef mingw32_HOST_OS+import Utility.UserInfo+import Utility.Env+import Config.Files+import System.Process+import System.Exit+#endif+ main :: IO ()-main = run =<< getProgName+main = do+	ps <- getArgs+	run ps =<< getProgName   where-	run n-		| isshell n = go CmdLine.GitAnnexShell.run-		| otherwise = go CmdLine.GitAnnex.run-	isshell n = takeFileName n == "git-annex-shell"-	go a = do-		ps <- getArgs+	run ps n+		| isshell n = CmdLine.GitAnnexShell.run ps+		| otherwise =+#ifdef mingw32_HOST_OS+			winEnv gitannex ps+#else+			gitannex ps+#endif+	gitannex ps =  #ifdef WITH_TESTSUITE 		case ps of 			("test":ps') -> Test.main ps'-			_ -> a ps+			_ -> CmdLine.GitAnnex.run ps #else-		a ps+		CmdLine.GitAnnex.run ps+#endif+	isshell n = takeFileName n == "git-annex-shell"++#ifdef mingw32_HOST_OS+{- On Windows, if HOME is not set, probe it and set it, re-execing+ - git-annex with the new environment.+ - + - This is a workaround for some Cygwin commands needing HOME to be set,+ - and for there being no known way to set environment variables on+ - Windows, except by passing an environment in each call to a program.+ - While ugly, this workaround is easier than trying to ensure HOME is set+ - in all calls to the affected programs.+ -}+winEnv :: ([String] -> IO ()) -> [String] -> IO ()+winEnv a ps = go =<< getEnv "HOME"+  where+	go (Just _) = a ps+	go Nothing = do+		home <- myHomeDir+		putStrLn $ "** Windows hack; overrideing HOME to " ++ home+		e <- getEnvironment+		let eoverride =+			[ ("HOME", home)+			, ("CYGWIN", "nodosfilewarning")+			]+		cmd <- readProgramFile+		(_, _, _, pid) <- createProcess (proc cmd ps)+			{ env = Just $ e ++ eoverride }+		exitWith =<< waitForProcess pid #endif
standalone/android/install-haskell-packages view
@@ -72,7 +72,6 @@ 	patched zlib 	patched MissingH 	patched bloomfilter-	patched SafeSemaphore 	patched distributive 	patched comonad 	patched iproute@@ -86,6 +85,7 @@ 	patched skein 	patched lens 	patched certificate+	patched x509-system 	patched persistent-template 	patched system-filepath 	patched wai-app-static
templates/configurators/newrepository.hamlet view
@@ -7,6 +7,6 @@     <a .btn .btn-primary href="@{AddDriveR}">       Make a repository on a Removable Drive   <p>-    Where do you want to put this new repository?+    Repository location:     <form method="post" .form-inline enctype=#{enctype}>       ^{form}
templates/configurators/newrepository/combine.hamlet view
@@ -2,7 +2,7 @@   <h2>     Combine repositories?   <p>-    You have created a new repository at #{newrepo}.+    The repository at #{newrepo} is set up.     <br>     Do you want to combine it with your existing repository at #{mainrepo}?   <p>