packages feed

git-annex 5.20140227 → 5.20140306

raw patch · 92 files changed

+1772/−531 lines, 92 filesdep +warp-tls

Dependencies added: warp-tls

Files

Annex.hs view
@@ -44,6 +44,7 @@ import Git.CheckAttr import Git.CheckIgnore import Git.SharedRepository+import qualified Git.Hook import qualified Git.Queue import Types.Key import Types.Backend@@ -62,6 +63,7 @@ import qualified Utility.Matcher import qualified Data.Map as M import qualified Data.Set as S+import Utility.Quvi (QuviVersion)  {- git-annex's monad is a ReaderT around an AnnexState stored in a MVar.  - This allows modifying the state in an exception-safe fashion.@@ -116,6 +118,8 @@ 	, useragent :: Maybe String 	, errcounter :: Integer 	, unusedkeys :: Maybe (S.Set Key)+	, quviversion :: Maybe QuviVersion+	, existinghooks :: M.Map Git.Hook.Hook Bool 	}  newState :: GitConfig -> Git.Repo -> AnnexState@@ -154,6 +158,8 @@ 	, useragent = Nothing 	, errcounter = 0 	, unusedkeys = Nothing+	, quviversion = Nothing+	, existinghooks = M.empty 	}  {- Makes an Annex state object for the specified git repo.
+ Annex/AutoMerge.hs view
@@ -0,0 +1,179 @@+{- git-annex automatic merge conflict resolution+ -+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.AutoMerge (autoMergeFrom) where++import Common.Annex+import qualified Annex.Queue+import Annex.Direct+import Annex.CatFile+import Annex.Link+import qualified Git.Command+import qualified Git.LsFiles as LsFiles+import qualified Git.UpdateIndex as UpdateIndex+import qualified Git.Merge+import qualified Git.Ref+import qualified Git.Sha+import qualified Git+import Git.Types (BlobType(..))+import Config+import Annex.ReplaceFile+import Git.FileMode+import Annex.VariantFile++import qualified Data.Set as S++{- Merges from a branch into the current branch+ - (which may not exist yet),+ - with automatic merge conflict resolution. -}+autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Annex Bool+autoMergeFrom branch currbranch = do+	showOutput+	case currbranch of+		Nothing -> go Nothing+		Just b -> go =<< inRepo (Git.Ref.sha b)+  where+	go old = ifM isDirect+		( do+			d <- fromRepo gitAnnexMergeDir+			r <- inRepo (mergeDirect d branch)+				<||> resolveMerge old branch+			mergeDirectCleanup d (fromMaybe Git.Sha.emptyTree old) Git.Ref.headRef+			return r+		, inRepo (Git.Merge.mergeNonInteractive branch)+			<||> resolveMerge old branch+		)++{- Resolves a conflicted merge. It's important that any conflicts be+ - resolved in a way that itself avoids later merge conflicts, since+ - multiple repositories may be doing this concurrently.+ -+ - Only merge conflicts where at least one side is an annexed file+ - is resolved.+ -+ - This uses the Keys pointed to by the files to construct new+ - filenames. So when both sides modified annexed file foo, + - it will be deleted, and replaced with files foo.variant-A and+ - foo.variant-B.+ -+ - On the other hand, when one side deleted foo, and the other modified it,+ - it will be deleted, and the modified version stored as file+ - foo.variant-A (or B).+ -+ - It's also possible that one side has foo as an annexed file, and+ - the other as a directory or non-annexed file. The annexed file+ - is renamed to resolve the merge, and the other object is preserved as-is.+ -+ - In indirect mode, the merge is resolved in the work tree and files+ - staged, to clean up from a conflicted merge that was run in the work+ - tree. In direct mode, the work tree is not touched here; files are + - staged to the index, and written to the gitAnnexMergeDir, and later+ - mergeDirectCleanup handles updating the work tree.+ -}+resolveMerge :: Maybe Git.Ref -> Git.Ref -> Annex Bool+resolveMerge us them = do+	top <- fromRepo Git.repoPath+	(fs, cleanup) <- inRepo (LsFiles.unmerged [top])+	mergedfs <- catMaybes <$> mapM (resolveMerge' us them) fs+	let merged = not (null mergedfs)+	void $ liftIO cleanup++	unlessM isDirect $ do+		(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])+		unless (null deleted) $+			Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted+		void $ liftIO cleanup2++	when merged $ do+		unlessM isDirect $+			cleanConflictCruft mergedfs top+		Annex.Queue.flush+		whenM isDirect $+			void preCommitDirect+		void $ inRepo $ Git.Command.runBool+			[ Param "commit"+			, Param "--no-verify"+			, Param "-m"+			, Param "git-annex automatic merge conflict fix"+			]+		showLongNote "Merge conflict was automatically resolved; you may want to examine the result."+	return merged++resolveMerge' :: Maybe Git.Ref -> Git.Ref -> LsFiles.Unmerged -> Annex (Maybe FilePath)+resolveMerge' Nothing _ _ = return Nothing+resolveMerge' (Just us) them u = do+	kus <- getkey LsFiles.valUs LsFiles.valUs +	kthem <- getkey LsFiles.valThem LsFiles.valThem+	case (kus, kthem) of+		-- Both sides of conflict are annexed files+		(Just keyUs, Just keyThem)+			| keyUs /= keyThem -> resolveby $ do+				makelink keyUs+				makelink keyThem+			| otherwise -> resolveby $+				makelink keyUs+		-- Our side is annexed file, other side is not.+		(Just keyUs, Nothing) -> resolveby $ do+			graftin them file+			makelink keyUs+		-- Our side is not annexed file, other side is.+		(Nothing, Just keyThem) -> resolveby $ do+			graftin us file+			makelink keyThem+		-- Neither side is annexed file; cannot resolve.+		(Nothing, Nothing) -> return Nothing+  where+	file = LsFiles.unmergedFile u++	getkey select select'+		| select (LsFiles.unmergedBlobType u) == Just SymlinkBlob =+			case select' (LsFiles.unmergedSha u) of+				Nothing -> return Nothing+				Just sha -> catKey sha symLinkMode+		| otherwise = return Nothing+	+	makelink key = do+		let dest = variantFile file key+		l <- inRepo $ gitAnnexLink dest key+		ifM isDirect+			( do+				d <- fromRepo gitAnnexMergeDir+				replaceFile (d </> dest) $ makeAnnexLink l+			, replaceFile dest $ makeAnnexLink l+			)+		stageSymlink dest =<< hashSymlink l++	{- stage a graft of a directory or file from a branch -}+	graftin b item = Annex.Queue.addUpdateIndex+		=<< fromRepo (UpdateIndex.lsSubTree b item)+		+	resolveby a = do+		{- Remove conflicted file from index so merge can be resolved. -}+		Annex.Queue.addCommand "rm" [Params "--quiet -f --cached --"] [file]+		void a+		return (Just file)++{- git-merge moves conflicting files away to files+ - named something like f~HEAD or f~branch, but the+ - exact name chosen can vary. Once the conflict is resolved,+ - this cruft can be deleted. To avoid deleting legitimate+ - files that look like this, only delete files that are+ - A) not staged in git and B) look like git-annex symlinks.+ -}+cleanConflictCruft :: [FilePath] -> FilePath -> Annex ()+cleanConflictCruft resolvedfs top = do+	(fs, cleanup) <- inRepo $ LsFiles.notInRepo False [top]+	mapM_ clean fs+	void $ liftIO cleanup+  where+	clean f+		| matchesresolved f = whenM (isJust <$> isAnnexLink f) $+			liftIO $ nukeFile f+		| otherwise = noop+	s = S.fromList resolvedfs+	matchesresolved f = S.member (base f) s+	base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f
Annex/CatFile.hs view
@@ -7,6 +7,7 @@  module Annex.CatFile ( 	catFile,+	catFileDetails, 	catObject, 	catTree, 	catObjectDetails,@@ -33,6 +34,11 @@ catFile branch file = do 	h <- catFileHandle 	liftIO $ Git.CatFile.catFile h branch file++catFileDetails :: Git.Branch -> FilePath -> Annex (Maybe (L.ByteString, Sha, ObjectType))+catFileDetails branch file = do+	h <- catFileHandle+	liftIO $ Git.CatFile.catFileDetails h branch file  catObject :: Git.Ref -> Annex L.ByteString catObject ref = do
Annex/Direct.hs view
@@ -33,6 +33,7 @@ import Annex.Perms import Annex.ReplaceFile import Annex.Exception+import Annex.VariantFile  {- Uses git ls-files to find files that need to be committed, and stages  - them into the index. Returns True if some changes were staged. -}@@ -142,9 +143,6 @@ {- In direct mode, git merge would usually refuse to do anything, since it  - sees present direct mode files as type changed files. To avoid this,  - merge is run with the work tree set to a temp directory.- -- - This should only be used once any changes to the real working tree have- - already been committed, because it overwrites files in the working tree.  -} mergeDirect :: FilePath -> Git.Ref -> Git.Repo -> IO Bool mergeDirect d branch g = do@@ -172,39 +170,88 @@ 	makeabs <- flip fromTopFilePath <$> gitRepo 	let fsitems = zip (map (makeabs . DiffTree.file) items) items 	forM_ fsitems $-		go DiffTree.srcsha DiffTree.srcmode moveout moveout_raw+		go makeabs DiffTree.srcsha DiffTree.srcmode moveout moveout_raw 	forM_ fsitems $-		go DiffTree.dstsha DiffTree.dstmode movein movein_raw+		go makeabs DiffTree.dstsha DiffTree.dstmode movein movein_raw 	void $ liftIO cleanup 	liftIO $ removeDirectoryRecursive d   where-	go getsha getmode a araw (f, item)+	go makeabs getsha getmode a araw (f, item) 		| getsha item == nullSha = noop 		| otherwise = void $-			tryAnnex . maybe (araw f item) (\k -> void $ a k f)+			tryAnnex . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f) 				=<< catKey (getsha item) (getmode item) -	moveout = removeDirect+	moveout _ _ = removeDirect  	{- Files deleted by the merge are removed from the work tree. 	 - Empty work tree directories are removed, per git behavior. -}-	moveout_raw f _item = liftIO $ do+	moveout_raw _ _ f = liftIO $ do 		nukeFile f 		void $ tryIO $ removeDirectory $ parentDir f 	 	{- If the file is already present, with the right content for the-	 - key, it's left alone. Otherwise, create the symlink and then-	 - if possible, replace it with the content. -}-	movein k f = unlessM (goodContent k f) $ do+	 - key, it's left alone. +	 -+	 - If the file is already present, and does not exist in the+	 - oldsha branch, preserve this local file.+	 -+	 - Otherwise, create the symlink and then if possible, replace it+	 - with the content. -}+	movein item makeabs k f = unlessM (goodContent k f) $ do+		preserveUnannexed item makeabs f oldsha 		l <- inRepo $ gitAnnexLink f k 		replaceFile f $ makeAnnexLink l 		toDirect k f 	 	{- Any new, modified, or renamed files were written to the temp 	 - directory by the merge, and are moved to the real work tree. -}-	movein_raw f item = liftIO $ do-		createDirectoryIfMissing True $ parentDir f-		void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f+	movein_raw item makeabs f = do+		preserveUnannexed item makeabs f oldsha+		liftIO $ do+			createDirectoryIfMissing True $ parentDir f+			void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f++{- If the file that's being moved in is already present in the work+ - tree, but did not exist in the oldsha branch, preserve this+ - local, unannexed file (or directory), as "variant-local".+ -+ - It's also possible that the file that's being moved in+ - is in a directory that collides with an exsting, non-annexed+ - file (not a directory), which should be preserved.+ -}+preserveUnannexed :: DiffTree.DiffTreeItem -> (TopFilePath -> FilePath) -> FilePath -> Ref -> Annex ()+preserveUnannexed item makeabs absf oldsha = do+	whenM (liftIO (collidingitem absf) <&&> unannexed absf) $+		liftIO $ findnewname absf 0+	checkdirs (DiffTree.file item)+  where+	checkdirs from = do+		let p = parentDir (getTopFilePath from)+		let d = asTopFilePath p+		unless (null p) $ do+			let absd = makeabs d+			whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $+				liftIO $ findnewname absd 0+			checkdirs d+			+	collidingitem f = isJust+		<$> catchMaybeIO (getSymbolicLinkStatus f)+	colliding_nondir f = maybe False (not . isDirectory)+		<$> catchMaybeIO (getSymbolicLinkStatus f)++	unannexed f = (isNothing <$> isAnnexLink f)+		<&&> (isNothing <$> catFileDetails oldsha f)++	findnewname :: FilePath -> Int -> IO ()+	findnewname f n = do+		let localf = mkVariant f +			("local" ++ if n > 0 then show n else "")+		ifM (collidingitem localf)+			( findnewname f (n+1)+			, rename f localf+				`catchIO` const (findnewname f (n+1))+			)  {- If possible, converts a symlink in the working tree into a direct  - mode file. If the content is not available, leaves the symlink
Annex/Hook.hs view
@@ -1,9 +1,10 @@ {- git-annex git hooks  -- - Note that it's important that the scripts not change, otherwise- - removing old hooks using an old version of the script would fail.+ - Note that it's important that the scripts installed by git-annex+ - not change, otherwise removing old hooks using an old version of+ - the script would fail.  -- - Copyright 2013 Joey Hess <joey@kitenet.net>+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -12,12 +13,19 @@  import Common.Annex import qualified Git.Hook as Git-import Utility.Shell import Config+import qualified Annex+import Utility.Shell+import Utility.FileMode +import qualified Data.Map as M+ preCommitHook :: Git.Hook preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") +preCommitAnnexHook :: Git.Hook+preCommitAnnexHook = Git.Hook "pre-commit-annex" ""+ mkHookScript :: String -> String mkHookScript s = unlines 	[ shebang_local@@ -40,3 +48,24 @@ hookWarning h msg = do 	r <- gitRepo 	warning $ Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg++{- Runs a hook. To avoid checking if the hook exists every time,+ - the existing hooks are cached. -}+runAnnexHook :: Git.Hook -> Annex ()+runAnnexHook hook = do+	cmd <- fromRepo $ Git.hookFile hook+	m <- Annex.getState Annex.existinghooks+	case M.lookup hook m of+		Just True -> run cmd+		Just False -> noop+		Nothing -> do+			exists <- hookexists cmd+			Annex.changeState $ \s -> s+				{ Annex.existinghooks = M.insert hook exists m }+			when exists $+				run cmd+  where+	hookexists f = liftIO $ catchBoolIO $+		isExecutable . fileMode <$> getFileStatus f+	run cmd = unlessM (liftIO $ boolSystem cmd []) $+		warning $ cmd ++ " failed"
Annex/Quvi.hs view
@@ -14,7 +14,20 @@ import Utility.Quvi import Utility.Url -withQuviOptions :: forall a. Query a -> [CommandParam] -> URLString -> Annex a+withQuviOptions :: forall a. Query a -> [QuviParam] -> URLString -> Annex a withQuviOptions a ps url = do+	v <- quviVersion 	opts <- map Param . annexQuviOptions <$> Annex.getGitConfig-	liftIO $ a (ps++opts) url+	liftIO $ a v (map (\mkp -> mkp v) ps++opts) url++quviSupported :: URLString -> Annex Bool+quviSupported u = liftIO . flip supported u =<< quviVersion++quviVersion :: Annex QuviVersion+quviVersion = go =<< Annex.getState Annex.quviversion+  where+	go (Just v) = return v+	go Nothing = do+		v <- liftIO probeVersion+		Annex.changeState $ \s -> s { Annex.quviversion = Just v }+		return v
+ Annex/VariantFile.hs view
@@ -0,0 +1,45 @@+{- git-annex .variant files for automatic merge conflict resolution+ -+ - Copyright 2014 Joey Hess <joey@kitenet.net>+ -+ - Licensed under the GNU GPL version 3 or higher.+ -}++module Annex.VariantFile where++import Common.Annex+import Types.Key++import Data.Hash.MD5++variantMarker :: String+variantMarker = ".variant-"++mkVariant :: FilePath -> String -> FilePath+mkVariant file variant = takeDirectory file+	</> dropExtension (takeFileName file)+	++ variantMarker ++ variant+	++ takeExtension file++{- The filename to use when resolving a conflicted merge of a file,+ - that points to a key.+ -+ - Something derived from the key needs to be included in the filename,+ - but rather than exposing the whole key to the user, a very weak hash+ - is used. There is a very real, although still unlikely, chance of+ - conflicts using this hash.+ -+ - In the event that there is a conflict with the filename generated+ - for some other key, that conflict will itself be handled by the+ - conflicted merge resolution code. That case is detected, and the full+ - key is used in the filename.+ -}+variantFile :: FilePath -> Key -> FilePath+variantFile file key+	| doubleconflict = mkVariant file (key2file key)+	| otherwise = mkVariant file (shortHash $ key2file key)+  where+	doubleconflict = variantMarker `isInfixOf` file++shortHash :: String -> String+shortHash = take 4 . md5s . md5FilePath
Annex/View.hs view
@@ -11,6 +11,7 @@ import Annex.View.ViewedFile import Types.View import Types.MetaData+import Annex.MetaData import qualified Git import qualified Git.DiffTree as DiffTree import qualified Git.Branch@@ -51,52 +52,85 @@ visibleViewSize :: View -> Int visibleViewSize = length . filter viewVisible . viewComponents +{- Parses field=value, field!=value, tag, and !tag+ -+ - Note that the field may not be a legal metadata field name,+ - but it's let through anyway.+ - This is useful when matching on directory names with spaces,+ - which are not legal MetaFields.+ -}+parseViewParam :: String -> (MetaField, ViewFilter)+parseViewParam s = case separate (== '=') s of+	('!':tag, []) | not (null tag) ->+		( tagMetaField+		, mkExcludeValues tag+		)+	(tag, []) ->+		( tagMetaField+		, mkFilterValues tag+		)+	(field, wanted)+		| end field == "!" ->+			( mkMetaFieldUnchecked (beginning field)+			, mkExcludeValues wanted+			)+		| otherwise ->+			( mkMetaFieldUnchecked field+			, mkFilterValues wanted+			)+  where+	mkFilterValues v+		| any (`elem` v) "*?" = FilterGlob v+		| otherwise = FilterValues $ S.singleton $ toMetaValue v+	mkExcludeValues = ExcludeValues . S.singleton . toMetaValue+ 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+refineView :: View -> [(MetaField, ViewFilter)] -> (View, ViewChange)+refineView origview = checksize . calc Unchanged origview   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+	calc c v [] = (v, c)+	calc c v ((f, vf):rest) =+		let (v', c') = refine v f vf+		in calc (max c c') v' rest +	refine view field vf+		| field `elem` map viewField (viewComponents view) =+			let (components', viewchanges) = runWriter $+				mapM (\c -> updateViewComponent c field vf) (viewComponents view)+			    viewchange = if field `elem` map viewField (viewComponents origview)+			    	then maximum viewchanges+				else Narrowing+			in (view { viewComponents = components' }, viewchange)+		| otherwise = +			let component = mkViewComponent field vf+			    view' = view { viewComponents = component : viewComponents view }+			in (view', Narrowing)+	+	checksize r@(v, _)+		| viewTooLarge v = error $ "View is too large (" ++ show (visibleViewSize v) ++ " levels of subdirectories)"+		| otherwise = r++updateViewComponent :: ViewComponent -> MetaField -> ViewFilter -> Writer [ViewChange] ViewComponent+updateViewComponent c field vf+	| viewField c == field = do+		let (newvf, viewchange) = combineViewFilter (viewFilter c) vf+		tell [viewchange]+		return $ mkViewComponent field newvf+	| otherwise = return c+ {- 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 :: View -> [(MetaField, ViewFilter)] -> 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.  -@@ -117,6 +151,11 @@ 	| otherwise = (combined, Widening)   where 	combined = FilterValues (S.union olds news)+combineViewFilter old@(ExcludeValues olds) (ExcludeValues news)+	| combined == old = (combined, Unchanged)+	| otherwise = (combined, Narrowing)+  where+	combined = ExcludeValues (S.union olds news) combineViewFilter (FilterValues _) newglob@(FilterGlob _) = 	(newglob, Widening) combineViewFilter (FilterGlob oldglob) new@(FilterValues s)@@ -126,6 +165,10 @@ 	| old == new = (newglob, Unchanged) 	| matchGlob (compileGlob old CaseInsensative) new = (newglob, Narrowing) 	| otherwise = (newglob, Widening)+combineViewFilter (FilterGlob _) new@(ExcludeValues _) = (new, Narrowing)+combineViewFilter (ExcludeValues _) new@(FilterGlob _) = (new, Widening)+combineViewFilter (FilterValues _) new@(ExcludeValues _) = (new, Narrowing)+combineViewFilter (ExcludeValues _) new@(FilterValues _) = (new, Widening)  {- Generates views for a file from a branch, based on its metadata  - and the filename used in the branch.@@ -162,16 +205,23 @@  - 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)+	matcher (currentMetaDataValues metafield metadata)   where   	metafield = viewField viewcomponent 	matcher = case viewFilter viewcomponent of-		FilterValues s -> \values -> S.intersection s values+		FilterValues s -> \values -> setmatches $+			S.intersection s values 		FilterGlob glob -> 			let cglob = compileGlob glob CaseInsensative-			in \values -> +			in \values -> setmatches $ 				S.filter (matchGlob cglob . fromMetaValue) values+		ExcludeValues excludes -> \values -> +			if S.null (S.intersection values excludes)+				then Just []+				else Nothing+	setmatches s+		| S.null s = Nothing+		| otherwise = Just (S.toList s)  toViewPath :: MetaValue -> FilePath toViewPath = concatMap escapeslash . fromMetaValue
Assistant.hs view
@@ -124,7 +124,7 @@ 		notice ["starting", desc, "version", SysConfig.packageversion] 		urlrenderer <- liftIO newUrlRenderer #ifdef WITH_WEBAPP-		let webappthread = [ assist $ webAppThread d urlrenderer False cannotrun listenhost Nothing webappwaiter ]+		let webappthread = [ assist $ webAppThread d urlrenderer False cannotrun Nothing listenhost webappwaiter ] #else 		let webappthread = [] #endif
Assistant/Restart.hs view
@@ -31,6 +31,7 @@ import Utility.WinProcess #endif import Data.Default+import Network.URI  {- Before the assistant can be restarted, have to remove our   - gitAnnexUrlFile and our gitAnnexPidFile. Pausing the watcher is also@@ -78,14 +79,27 @@ 		v <- tryIO $ readFile urlfile 		case v of 			Left _ -> delayed $ waiturl urlfile-			Right url -> ifM (listening url)+			Right url -> ifM (assistantListening url) 				( return url 				, delayed $ waiturl urlfile 				)-	listening url = catchBoolIO $ fst <$> exists url def 	delayed a = do 		threadDelay 100000 -- 1/10th of a second 		a++{- Checks if the assistant is listening on an url.+ -+ - Always checks http, because https with self-signed cert is problimatic.+ - warp-tls listens to http, in order to show an error page, so this works.+ -}+assistantListening :: URLString -> IO Bool+assistantListening url = catchBoolIO $ fst <$> exists url' def+  where+	url' = case parseURI url of+		Nothing -> url+		Just uri -> show $ uri+			{ uriScheme = "http:"+			}  {- Does not wait for assistant to be listening for web connections.   -
Assistant/Ssh.hs view
@@ -143,6 +143,8 @@ addAuthorizedKeys gitannexshellonly dir pubkey = boolSystem "sh" 	[ Param "-c" , Param $ addAuthorizedKeysCommand gitannexshellonly dir pubkey ] +{- Should only be used within the same process that added the line;+ - the layout of the line is not kepy stable across versions. -} removeAuthorizedKeys :: Bool -> FilePath -> SshPubKey -> IO () removeAuthorizedKeys gitannexshellonly dir pubkey = do 	let keyline = authorizedKeysLine gitannexshellonly dir pubkey@@ -195,7 +197,7 @@ 	 - long perl script. -} 	| otherwise = pubkey   where-	limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding "+	limitcommand = "command=\"GIT_ANNEX_SHELL_DIRECTORY="++shellEscape dir++" ~/.ssh/git-annex-shell\",no-agent-forwarding,no-port-forwarding,no-X11-forwarding,no-pty "  {- Generates a ssh key pair. -} genSshKeyPair :: IO SshKeyPair
Assistant/Threads/Merger.hs view
@@ -17,7 +17,7 @@ import qualified Annex.Branch import qualified Git import qualified Git.Branch-import qualified Command.Sync+import Annex.AutoMerge import Annex.TaggedPush import Remote (remoteFromUUID) @@ -39,7 +39,7 @@ 		, modifyHook = changehook 		, errHook = errhook 		}-	void $ liftIO $ watchDir dir (const False) hooks id+	void $ liftIO $ watchDir dir (const False) True hooks id 	debug ["watching", dir]  type Handler = FilePath -> Assistant ()@@ -83,7 +83,7 @@ 				[ "merging", Git.fromRef changedbranch 				, "into", Git.fromRef current 				]-			void $ liftAnnex  $ Command.Sync.mergeFrom changedbranch+			void $ liftAnnex  $ autoMergeFrom changedbranch (Just current) 	mergecurrent _ = noop  	handleDesynced = case fromTaggedBranch changedbranch of
Assistant/Threads/SanityChecker.hs view
@@ -38,6 +38,7 @@ import Logs.Unused import Logs.Transfer import Config.Files+import Utility.DiskFree import qualified Annex #ifdef WITH_WEBAPP import Assistant.WebApp.Types@@ -203,17 +204,27 @@ #endif  #ifndef mingw32_HOST_OS-{- Rotate logs until log file size is < 1 mb. -}+{- Rotate logs once when total log file size is > 2 mb.+ -+ - If total log size is larger than the amount of free disk space,+ - continue rotating logs until size is < 2 mb, even if this+ - results in immediately losing the just logged data.+ -} checkLogSize :: Int -> Assistant () checkLogSize n = do 	f <- liftAnnex $ fromRepo gitAnnexLogFile 	logs <- liftIO $ listLogs f 	totalsize <- liftIO $ sum <$> mapM filesize logs-	when (totalsize > oneMegabyte) $ do+	when (totalsize > 2 * oneMegabyte) $ do 		notice ["Rotated logs due to size:", show totalsize] 		liftIO $ openLog f >>= redirLog-		when (n < maxLogs + 1) $-			checkLogSize $ n + 1+		when (n < maxLogs + 1) $ do+			df <- liftIO $ getDiskFree $ takeDirectory f+			case df of+				Just free+					| free < fromIntegral totalsize ->+						checkLogSize (n + 1)+				_ -> noop   where 	filesize f = fromIntegral . fileSize <$> liftIO (getFileStatus f)
Assistant/Threads/TransferWatcher.hs view
@@ -35,7 +35,7 @@ 		, modifyHook = modifyhook 		, errHook = errhook 		}-	void $ liftIO $ watchDir dir (const False) hooks id+	void $ liftIO $ watchDir dir (const False) True hooks id 	debug ["watching for transfers"]  type Handler = FilePath -> Assistant ()
Assistant/Threads/UpgradeWatcher.hs view
@@ -50,8 +50,9 @@ 		let dir = parentDir flagfile 		let depth = length (splitPath dir) + 1 		let nosubdirs f = length (splitPath f) == depth-		void $ liftIO $ watchDir dir nosubdirs hooks (startup mvar)+		void $ liftIO $ watchDir dir nosubdirs False hooks (startup mvar)   	-- Ignore bogus events generated during the startup scan.+	-- We ask the watcher to not generate them, but just to be safe..   	startup mvar scanner = do 		r <- scanner 		void $ swapMVar mvar Started
Assistant/Threads/Watcher.hs view
@@ -102,7 +102,8 @@ 		, delDirHook = deldirhook 		, errHook = errhook 		}-	handle <- liftIO $ watchDir "." ignored hooks startup+	scanevents <- liftAnnex $ annexStartupScan <$> Annex.getGitConfig+	handle <- liftIO $ watchDir "." ignored scanevents hooks startup 	debug [ "watching", "."] 	 	{- Let the DirWatcher thread run until signalled to pause it,
Assistant/Threads/WebApp.hs view
@@ -1,6 +1,6 @@ {- git-annex assistant webapp thread  -- - Copyright 2012 Joey Hess <joey@kitenet.net>+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>  -  - Licensed under the GNU GPL version 3 or higher.  -}@@ -41,10 +41,12 @@ import Utility.Tmp import Utility.FileMode import Git+import qualified Annex  import Yesod import Network.Socket (SockAddr, HostName) import Data.Text (pack, unpack)+import qualified Network.Wai.Handler.WarpTLS as TLS  mkYesodDispatch "WebApp" $(parseRoutesFile "Assistant/WebApp/routes") @@ -55,13 +57,17 @@ 	-> UrlRenderer 	-> Bool 	-> Maybe String-	-> Maybe HostName 	-> Maybe (IO Url)+	-> Maybe HostName 	-> Maybe (Url -> FilePath -> IO ()) 	-> NamedThread-webAppThread assistantdata urlrenderer noannex cannotrun listenhost postfirstrun onstartup = thread $ liftIO $ do+webAppThread assistantdata urlrenderer noannex cannotrun postfirstrun listenhost onstartup = thread $ liftIO $ do+	listenhost' <- if isJust listenhost+		then pure listenhost+		else getAnnex $ annexListen <$> Annex.getGitConfig+	tlssettings <- getAnnex getTlsSettings #ifdef __ANDROID__-	when (isJust listenhost) $+	when (isJust listenhost') $ 		-- See Utility.WebApp 		error "Sorry, --listen is not currently supported on Android" #endif@@ -73,22 +79,21 @@ 		<*> pure postfirstrun 		<*> pure cannotrun 		<*> pure noannex-		<*> pure listenhost+		<*> pure listenhost' 	setUrlRenderer urlrenderer $ yesodRender webapp (pack "") 	app <- toWaiAppPlain webapp 	app' <- ifM debugEnabled 		( return $ httpDebugLogger app 		, return app 		)-	runWebApp listenhost app' $ \addr -> if noannex+	runWebApp tlssettings listenhost' app' $ \addr -> if noannex 		then withTmpFile "webapp.html" $ \tmpfile h -> do 			hClose h-			go addr webapp tmpfile Nothing+			go tlssettings addr webapp tmpfile Nothing 		else do-			let st = threadState assistantdata-			htmlshim <- runThreadState st $ fromRepo gitAnnexHtmlShim-			urlfile <- runThreadState st $ fromRepo gitAnnexUrlFile-			go addr webapp htmlshim (Just urlfile)+			htmlshim <- getAnnex' $ fromRepo gitAnnexHtmlShim+			urlfile <- getAnnex' $ fromRepo gitAnnexUrlFile+			go tlssettings addr webapp htmlshim (Just urlfile)   where   	-- The webapp thread does not wait for the startupSanityCheckThread 	-- to finish, so that the user interface remains responsive while@@ -98,14 +103,31 @@ 		| noannex = return Nothing 		| otherwise = Just <$> 			(relHome =<< absPath-				=<< runThreadState (threadState assistantdata) (fromRepo repoPath))-	go addr webapp htmlshim urlfile = do-		let url = myUrl webapp addr+				=<< getAnnex' (fromRepo repoPath))+	go tlssettings addr webapp htmlshim urlfile = do+		let url = myUrl tlssettings webapp addr 		maybe noop (`writeFileProtected` url) urlfile 		writeHtmlShim "Starting webapp..." url htmlshim 		maybe noop (\a -> a url htmlshim) onstartup -myUrl :: WebApp -> SockAddr -> Url-myUrl webapp addr = unpack $ yesodRender webapp urlbase DashboardR []+	getAnnex a+		| noannex = pure Nothing+		| otherwise = getAnnex' a+	getAnnex' = runThreadState (threadState assistantdata)++myUrl :: Maybe TLS.TLSSettings -> WebApp -> SockAddr -> Url+myUrl tlssettings webapp addr = unpack $ yesodRender webapp urlbase DashboardR []   where-	urlbase = pack $ "http://" ++ show addr+	urlbase = pack $ proto ++ "://" ++ show addr+	proto+		| isJust tlssettings = "https"+		| otherwise = "http"++getTlsSettings :: Annex (Maybe TLS.TLSSettings)+getTlsSettings = do+	cert <- fromRepo gitAnnexWebCertificate+	privkey <- fromRepo gitAnnexWebPrivKey+	ifM (liftIO $ allM doesFileExist [cert, privkey])+		( return $ Just $ TLS.tlsSettings cert privkey+		, return Nothing+		)
Assistant/WebApp/Configurators/Edit.hs view
@@ -30,6 +30,7 @@ import Logs.Remote import Types.StandardGroups import qualified Git+import qualified Git.Types as Git import qualified Git.Command import qualified Git.Config import qualified Annex@@ -137,8 +138,8 @@  	legalName = makeLegalName . T.unpack . repoName -editRepositoryAForm :: Bool -> RepoConfig -> MkAForm RepoConfig-editRepositoryAForm ishere def = RepoConfig+editRepositoryAForm :: Maybe Remote -> RepoConfig -> MkAForm RepoConfig+editRepositoryAForm mremote def = RepoConfig 	<$> areq (if ishere then readonlyTextField else textField) 		"Name" (Just $ repoName def) 	<*> aopt textField "Description" (Just $ repoDescription def)@@ -146,10 +147,16 @@ 	<*> associateddirectory 	<*> areq checkBoxField "Syncing enabled" (Just $ repoSyncable def)   where+	ishere = isNothing mremote+	isspecial = fromMaybe False $+		(== Git.Unknown) . Git.location . Remote.repo <$> mremote 	groups = customgroups ++ standardgroups 	standardgroups :: [(Text, RepoGroup)]-	standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g))-		[minBound :: StandardGroup .. maxBound :: StandardGroup]+	standardgroups = map (\g -> (T.pack $ descStandardGroup g , RepoGroupStandard g)) $+		filter sanegroup [minBound..maxBound]+	sanegroup+		| isspecial = const True+		| otherwise = not . specialRemoteOnly 	customgroups :: [(Text, RepoGroup)] 	customgroups = case repoGroup def of 		RepoGroupCustom s -> [(T.pack s, RepoGroupCustom s)]@@ -187,7 +194,7 @@ 	curr <- liftAnnex $ getRepoConfig uuid mremote 	liftAnnex $ checkAssociatedDirectory curr mremote 	((result, form), enctype) <- liftH $-		runFormPostNoToken $ renderBootstrap $ editRepositoryAForm (isNothing mremote) curr+		runFormPostNoToken $ renderBootstrap $ editRepositoryAForm mremote curr 	case result of 		FormSuccess input -> liftH $ do 			setRepoConfig uuid mremote curr input
Assistant/WebApp/Configurators/Local.hs view
@@ -160,6 +160,8 @@ getFirstRepositoryR = postFirstRepositoryR postFirstRepositoryR :: Handler Html postFirstRepositoryR = page "Getting started" (Just Configuration) $ do+	unlessM (liftIO $ inPath "git") $+		error "You need to install git in order to use git-annex!" #ifdef __ANDROID__ 	androidspecial <- liftIO $ doesDirectoryExist "/sdcard/DCIM" 	let path = "/sdcard/annex"
Assistant/WebApp/OtherRepos.hs view
@@ -25,10 +25,12 @@ listOtherRepos = do 	dirs <- readAutoStartFile 	pwd <- getCurrentDirectory-	gooddirs <- filterM doesDirectoryExist $+	gooddirs <- filterM isrepo $ 		filter (\d -> not $ d `dirContains` pwd) dirs 	names <- mapM relHome gooddirs 	return $ sort $ zip names gooddirs+  where+	isrepo d = doesDirectoryExist (d </> ".git")  getSwitchToRepositoryR :: FilePath -> Handler Html getSwitchToRepositoryR repo = do
Build/Configure.hs view
@@ -35,8 +35,6 @@ 	, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null" 	, TestCase "wget" $ testCmd "wget" "wget --version >/dev/null" 	, TestCase "bup" $ testCmd "bup" "bup --version >/dev/null"-	, TestCase "quvi" $ testCmd "quvi" "quvi --version >/dev/null"-	, TestCase "newquvi" $ testCmd "newquvi" "quvi info >/dev/null" 	, TestCase "nice" $ testCmd "nice" "nice true >/dev/null" 	, TestCase "ionice" $ testCmd "ionice" "ionice -c3 true >/dev/null" 	, TestCase "nocache" $ testCmd "nocache" "nocache true >/dev/null"
Build/DistributionUpdate.hs view
@@ -21,13 +21,14 @@  makeinfos :: Annex () makeinfos = do+	version <- liftIO getChangelogVersion 	void $ inRepo $ runBool  		[ Param "commit"+		, Param "-a" 		, Param "-m" 		, Param $ "publishing git-annex " ++ version 		] 	basedir <- liftIO getRepoDir-	version <- liftIO getChangelogVersion 	now <- liftIO getCurrentTime 	liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir 	fs <- liftIO $ dirContentsRecursiveSkipping (const False) True (basedir </> "git-annex")
CHANGELOG view
@@ -1,3 +1,40 @@+git-annex (5.20140306) unstable; urgency=high++  * sync: Fix bug in direct mode that caused a file that was not+    checked into git to be deleted when there was a conflicting+    merge with a remote.+  * webapp: Now supports HTTPS.+  * webapp: No longer supports a port specified after --listen, since+    it was buggy, and that use case is better supported by setting up HTTPS.+  * annex.listen can be configured, instead of using --listen+  * annex.startupscan can be set to false to disable the assistant's startup+    scan.+  * Probe for quvi version at run time.+  * webapp: Filter out from Switch Repository list any+    repositories listed in autostart file that don't have a+    git directory anymore. (Or are bare)+  * webapp: Refuse to start in a bare git repository.+  * assistant --autostart: Refuse to start in a bare git repository.+  * webapp: Don't list the public repository group when editing a+    git repository; it only makes sense for special remotes.+  * view, vfilter: Add support for filtering tags and values out of a view,+    using !tag and field!=value.+  * vadd: Allow listing multiple desired values for a field.+  * view: Refuse to enter a view when no branch is currently checked out.+  * metadata: To only set a field when it's not already got a value, use+    -s field?=value+  * Run .git/hooks/pre-commit-annex whenever a commit is made.+  * sync: Automatically resolve merge conflict between and annexed file+    and a regular git file.+  * glacier: Pass --region to glacier checkpresent.+  * webdav: When built with a new enough haskell DAV (0.6), disable+    the http response timeout, which was only 5 seconds.+  * webapp: Include no-pty in ssh authorized_keys lines.+  * assistant: Smarter log file rotation, which takes free disk space+    into account.++ -- Joey Hess <joeyh@debian.org>  Thu, 06 Mar 2014 12:28:04 -0400+ git-annex (5.20140227) unstable; urgency=medium    * metadata: Field names limited to alphanumerics and a few whitelisted
Command/AddUrl.hs view
@@ -64,7 +64,7 @@ 		QuviDownloader -> usequvi 		DefaultDownloader ->  #ifdef WITH_QUVI-			ifM (liftIO $ Quvi.supported s')+			ifM (quviSupported s') 				( usequvi 				, regulardownload url 				)
Command/Assistant.hs view
@@ -19,7 +19,7 @@  def :: [Command] def = [noRepo checkAutoStart $ dontCheck repoExists $ withOptions options $-	command "assistant" paramNothing seek SectionCommon+	notBareRepo $ command "assistant" paramNothing seek SectionCommon 		"automatically handle changes"]  options :: [Option]
Command/ImportFeed.hs view
@@ -108,7 +108,7 @@ 		Nothing -> mkquvi f i #ifdef WITH_QUVI 	mkquvi f i = case getItemLink i of-		Just link -> ifM (liftIO $ Quvi.supported link)+		Just link -> ifM (quviSupported link) 			( return $ Just $ ToDownload f u i $ QuviLink link 			, return Nothing 			)
Command/PreCommit.hs view
@@ -13,6 +13,7 @@ import qualified Command.Add import qualified Command.Fix import Annex.Direct+import Annex.Hook import Annex.View import Annex.View.ViewedFile import Logs.View@@ -28,13 +29,16 @@  seek :: CommandSeek seek ps = ifM isDirect-	-- update direct mode mappings for committed files-	( withWords startDirect ps+	( do+		-- update direct mode mappings for committed files+		withWords startDirect ps+		runAnnexHook preCommitAnnexHook 	, do 		-- fix symlinks to files being committed 		withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps 		-- inject unlocked files into the annex 		withFilesUnlockedToBeCommitted startIndirect ps+		runAnnexHook preCommitAnnexHook 		-- committing changes to a view updates metadata 		mv <- currentView 		case mv of@@ -43,6 +47,7 @@ 				(addViewMetaData v) 				(removeViewMetaData v) 	)+	  startIndirect :: FilePath -> CommandStart startIndirect f = next $ do
Command/Sync.hs view
@@ -12,25 +12,18 @@ import Command import qualified Annex import qualified Annex.Branch-import qualified Annex.Queue import qualified Remote import qualified Types.Remote as Remote import Annex.Direct-import Annex.CatFile-import Annex.Link+import Annex.Hook import qualified Git.Command import qualified Git.LsFiles as LsFiles-import qualified Git.Merge import qualified Git.Branch import qualified Git.Ref import qualified Git-import Git.Types (BlobType(..)) import qualified Types.Remote import qualified Remote.Git-import Types.Key import Config-import Annex.ReplaceFile-import Git.FileMode import Annex.Wanted import Annex.Content import Command.Get (getKeyFile')@@ -38,9 +31,8 @@ import Logs.Location import Annex.Drop import Annex.UUID+import Annex.AutoMerge -import qualified Data.Set as S-import Data.Hash.MD5 import Control.Concurrent.MVar  def :: [Command]@@ -156,6 +148,7 @@   where 	go Nothing = return False 	go (Just branch) = do+		runAnnexHook preCommitAnnexHook 		parent <- inRepo $ Git.Ref.sha branch 		void $ inRepo $ Git.Branch.commit False commitmessage branch 			(maybeToList parent)@@ -176,7 +169,7 @@ 	go False = stop 	go True = do 		showStart "merge" $ Git.Ref.describe syncbranch-		next $ next $ mergeFrom syncbranch+		next $ next $ autoMergeFrom syncbranch (Just branch)  pushLocal :: Maybe Git.Ref -> CommandStart pushLocal Nothing = stop@@ -220,10 +213,11 @@ mergeRemote remote b = case b of 	Nothing -> do 		branch <- inRepo Git.Branch.currentUnsafe-		and <$> mapM merge (branchlist branch)-	Just _ -> and <$> (mapM merge =<< tomerge (branchlist b))+		and <$> mapM (merge Nothing) (branchlist branch)+	Just thisbranch ->+		and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b))   where-	merge = mergeFrom . remoteBranch remote+	merge thisbranch = flip autoMergeFrom thisbranch . remoteBranch remote 	tomerge = filterM (changed remote) 	branchlist Nothing = [] 	branchlist (Just branch) = [branch, syncBranch branch]@@ -303,206 +297,6 @@ mergeAnnex = do 	void Annex.Branch.forceUpdate 	stop--{- Merges from a branch into the current branch. -}-mergeFrom :: Git.Ref -> Annex Bool-mergeFrom branch = do-	showOutput-	ifM isDirect-		( maybe go godirect =<< inRepo Git.Branch.current-		, go-		)-  where-	go = runmerge $ inRepo $ Git.Merge.mergeNonInteractive branch-	godirect currbranch = do-		old <- inRepo $ Git.Ref.sha currbranch-		d <- fromRepo gitAnnexMergeDir-		r <- runmerge $ inRepo $ mergeDirect d branch-		new <- inRepo $ Git.Ref.sha currbranch-		case (old, new) of-			(Just oldsha, Just newsha) ->-				mergeDirectCleanup d oldsha newsha-			_ -> noop-		return r-	runmerge a = ifM a-		( return True-		, resolveMerge-		)--{- Resolves a conflicted merge. It's important that any conflicts be- - resolved in a way that itself avoids later merge conflicts, since- - multiple repositories may be doing this concurrently.- -- - Only annexed files are resolved; other files are left for the user to- - handle.- -- - This uses the Keys pointed to by the files to construct new- - filenames. So when both sides modified file foo, - - it will be deleted, and replaced with files foo.variant-A and- - foo.variant-B.- -- - On the other hand, when one side deleted foo, and the other modified it,- - it will be deleted, and the modified version stored as file- - foo.variant-A (or B).- -- - It's also possible that one side has foo as an annexed file, and- - the other as a directory or non-annexed file. The annexed file- - is renamed to resolve the merge, and the other object is preserved as-is.- -}-resolveMerge :: Annex Bool-resolveMerge = do-	top <- fromRepo Git.repoPath-	(fs, cleanup) <- inRepo (LsFiles.unmerged [top])-	mergedfs <- catMaybes <$> mapM resolveMerge' fs-	let merged = not (null mergedfs)-	void $ liftIO cleanup--	(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])-	unless (null deleted) $-		Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted-	void $ liftIO cleanup2--	when merged $ do-		unlessM isDirect $-			cleanConflictCruft mergedfs top-		Annex.Queue.flush-		void $ inRepo $ Git.Command.runBool-			[ Param "commit"-			, Param "-m"-			, Param "git-annex automatic merge conflict fix"-			]-		showLongNote "Merge conflict was automatically resolved; you may want to examine the result."-	return merged--resolveMerge' :: LsFiles.Unmerged -> Annex (Maybe FilePath)-resolveMerge' u-	| issymlink LsFiles.valUs && issymlink LsFiles.valThem = do-		kus <- getKey LsFiles.valUs-		kthem <- getKey LsFiles.valThem-		case (kus, kthem) of-			-- Both sides of conflict are annexed files-			(Just keyUs, Just keyThem) -> do-				removeoldfile keyUs-				if keyUs == keyThem-					then makelink keyUs-					else do-						makelink keyUs-						makelink keyThem-				return $ Just file-			-- Our side is annexed, other side is not.-			(Just keyUs, Nothing) -> do-				ifM isDirect-					( do-						removeoldfile keyUs-						makelink keyUs-						movefromdirectmerge file-					, do-						unstageoldfile-						makelink keyUs-					)-				return $ Just file-			-- Our side is not annexed, other side is.-			(Nothing, Just keyThem) -> do-				makelink keyThem-				unstageoldfile-				return $ Just file-			-- Neither side is annexed; cannot resolve.-			(Nothing, Nothing) -> return Nothing-	| otherwise = return Nothing-  where-	file = LsFiles.unmergedFile u-	issymlink select = select (LsFiles.unmergedBlobType u) `elem` [Just SymlinkBlob, Nothing]-	makelink key = do-		let dest = mergeFile file key-		l <- inRepo $ gitAnnexLink dest key-		replaceFile dest $ makeAnnexLink l-		stageSymlink dest =<< hashSymlink l-		whenM isDirect $-			toDirect key dest-	removeoldfile keyUs = do-		ifM isDirect-			( removeDirect keyUs file-			, liftIO $ nukeFile file-			)-		Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]-	unstageoldfile = Annex.Queue.addCommand "rm" [Params "--quiet -f --cached --"] [file]-	getKey select = case select (LsFiles.unmergedSha u) of-		Nothing -> return Nothing-		Just sha -> catKey sha symLinkMode-	-	{- Move something out of the direct mode merge directory and into-	 - the git work tree.-	 --	 - On a filesystem not supporting symlinks, this is complicated-	 - because a directory may contain annex links, but just-	 - moving them into the work tree will not let git know they are-	 - symlinks.-	 --	 - Also, if the content of the file is available, make it available-	 - in direct mode.-	 -}-	movefromdirectmerge item = do-		d <- fromRepo gitAnnexMergeDir-		liftIO $ rename (d </> item) item-		mapM_ setuplink =<< liftIO (dirContentsRecursive item)-	setuplink f = do-		v <- getAnnexLinkTarget f-		case v of-			Nothing -> noop-			Just target -> do-				unlessM (coreSymlinks <$> Annex.getGitConfig) $-					addAnnexLink target f-				maybe noop (`toDirect` f) -					(fileKey (takeFileName target))--{- git-merge moves conflicting files away to files- - named something like f~HEAD or f~branch, but the- - exact name chosen can vary. Once the conflict is resolved,- - this cruft can be deleted. To avoid deleting legitimate- - files that look like this, only delete files that are- - A) not staged in git and B) look like git-annex symlinks.- -}-cleanConflictCruft :: [FilePath] -> FilePath -> Annex ()-cleanConflictCruft resolvedfs top = do-	(fs, cleanup) <- inRepo $ LsFiles.notInRepo False [top]-	mapM_ clean fs-	void $ liftIO cleanup-  where-	clean f-		| matchesresolved f = whenM (isJust <$> isAnnexLink f) $-			liftIO $ nukeFile f-		| otherwise = noop-	s = S.fromList resolvedfs-	matchesresolved f = S.member (base f) s-	base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f--{- The filename to use when resolving a conflicted merge of a file,- - that points to a key.- -- - Something derived from the key needs to be included in the filename,- - but rather than exposing the whole key to the user, a very weak hash- - is used. There is a very real, although still unlikely, chance of- - conflicts using this hash.- -- - In the event that there is a conflict with the filename generated- - for some other key, that conflict will itself be handled by the- - conflicted merge resolution code. That case is detected, and the full- - key is used in the filename.- -}-mergeFile :: FilePath -> Key -> FilePath-mergeFile file key-	| doubleconflict = go $ key2file key-	| otherwise = go $ shortHash $ key2file key-  where-	varmarker = ".variant-"-	doubleconflict = varmarker `isInfixOf` file-	go v = takeDirectory file-		</> dropExtension (takeFileName file)-		++ varmarker ++ v-		++ takeExtension file-		-shortHash :: String -> String-shortHash = take 4 . md5s . md5FilePath  changed :: Remote -> Git.Ref -> Annex Bool changed remote b = do
Command/VAdd.hs view
@@ -10,7 +10,7 @@ import Common.Annex import Command import Annex.View-import Command.View (parseViewParam, checkoutViewBranch)+import Command.View (checkoutViewBranch)  def :: [Command] def = [notBareRepo $ notDirect $ command "vadd" (paramRepeating "FIELD=GLOB")
Command/VCycle.hs view
@@ -36,6 +36,6 @@ 			else next $ next $ checkoutViewBranch v' narrowView  	vcycle rest (c:cs)-		| multiValue (viewFilter c) = rest ++ cs ++ [c]+		| viewVisible c = rest ++ cs ++ [c] 		| otherwise = vcycle (c:rest) cs 	vcycle rest c = rest ++ c
Command/VFilter.hs view
@@ -10,7 +10,7 @@ import Common.Annex import Command import Annex.View-import Command.View (paramView, parseViewParam, checkoutViewBranch)+import Command.View (paramView, checkoutViewBranch)  def :: [Command] def = [notBareRepo $ notDirect $
Command/View.hs view
@@ -13,8 +13,6 @@ import qualified Git.Command import qualified Git.Ref import qualified Git.Branch-import Types.MetaData-import Annex.MetaData import Types.View import Annex.View import Logs.View@@ -36,7 +34,7 @@ 	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."+		| otherwise = error "Already in a view. Use the vfilter and vadd commands to further refine this view."  perform :: View -> CommandPerform perform view = do@@ -46,26 +44,12 @@ paramView :: String paramView = paramPair (paramRepeating "TAG") (paramRepeating "FIELD=VALUE") -{- Parse field=value- -- - Note that the field may not be a legal metadata field name,- - but it's let through anyway.- - This is useful when matching on directory names with spaces,- - which are not legal MetaFields.- -}-parseViewParam :: String -> (MetaField, String)-parseViewParam s = case separate (== '=') s of-	(tag, []) -> (tagMetaField, tag)-	(field, wanted) -> (mkMetaFieldUnchecked field, wanted)- mkView :: [String] -> Annex View-mkView params = do-	v <- View <$> viewbranch <*> pure []-	return $ fst $ refineView v $-		map parseViewParam $ reverse params+mkView params = go =<< inRepo Git.Branch.current   where-	viewbranch = fromMaybe (error "not on any branch!")-		<$> inRepo Git.Branch.current+	go Nothing = error "not on any branch!"+	go (Just b) = return $ fst $ refineView (View b []) $+		map parseViewParam $ reverse params  checkoutViewBranch :: View -> (View -> Annex Git.Branch) -> CommandCleanup checkoutViewBranch view mkbranch = do
Command/WebApp.hs view
@@ -68,18 +68,24 @@ 		cannotrun <- needsUpgrade . fromMaybe (error "no version") =<< getVersion 		browser <- fromRepo webBrowser 		f <- liftIO . absPath =<< fromRepo gitAnnexHtmlShim+		listenhost' <- if isJust listenhost+			then pure listenhost+			else annexListen <$> Annex.getGitConfig 		ifM (checkpid <&&> checkshim f) 			( if isJust listenhost 				then error "The assistant is already running, so --listen cannot be used." 				else do 					url <- liftIO . readFile 						=<< fromRepo gitAnnexUrlFile-					liftIO $ openBrowser browser f url Nothing Nothing-			, startDaemon True True Nothing cannotrun listenhost $ Just $ -				\origout origerr url htmlshim ->-					if isJust listenhost-						then maybe noop (`hPutStrLn` url) origout-						else openBrowser browser htmlshim url origout origerr+					liftIO $ if isJust listenhost'+						then putStrLn url+						else liftIO $ openBrowser browser f url Nothing Nothing+			, do+				startDaemon True True Nothing cannotrun listenhost' $ Just $ +					\origout origerr url htmlshim ->+						if isJust listenhost'+							then maybe noop (`hPutStrLn` url) origout+							else openBrowser browser htmlshim url origout origerr 			) 	auto 		| allowauto = liftIO $ startNoRepo []@@ -107,8 +113,11 @@ 		(d:_) -> do 			setCurrentDirectory d 			state <- Annex.new =<< Git.CurrentRepo.get-			void $ Annex.eval state $ callCommandAction $-				start' False listenhost+			void $ Annex.eval state $ do+				whenM (fromRepo Git.repoIsLocalBare) $+					error $ d ++ " is a bare git repository, cannot run the webapp in it"+				callCommandAction $+					start' False listenhost  {- Run the webapp without a repository, which prompts the user, makes one,  - changes to it, starts the regular assistant, and redirects the@@ -139,8 +148,9 @@ 	let callback a = Just $ a v 	runAssistant d $ do 		startNamedThread urlrenderer $-			webAppThread d urlrenderer True Nothing listenhost+			webAppThread d urlrenderer True Nothing 				(callback signaler)+				listenhost 				(callback mainthread) 		waitNamedThreads   where@@ -153,7 +163,8 @@ 			hFlush stdout 			go 		| otherwise = do-			browser <- maybe Nothing webBrowser <$> Git.Config.global+			browser <- maybe Nothing webBrowser+				<$> catchDefaultIO Nothing Git.Config.global 			openBrowser browser htmlshim url Nothing Nothing 			go 	  where
Git/CatFile.hs view
@@ -11,6 +11,7 @@ 	catFileStart', 	catFileStop, 	catFile,+	catFileDetails, 	catTree, 	catObject, 	catObjectDetails,@@ -50,6 +51,10 @@ {- Reads a file from a specified branch. -} catFile :: CatFileHandle -> Branch -> FilePath -> IO L.ByteString catFile h branch file = catObject h $ Ref $+	fromRef branch ++ ":" ++ toInternalGitPath file++catFileDetails :: CatFileHandle -> Branch -> FilePath -> IO (Maybe (L.ByteString, Sha, ObjectType))+catFileDetails h branch file = catObjectDetails h $ Ref $ 	fromRef branch ++ ":" ++ toInternalGitPath file  {- Uses a running git cat-file read the content of an object.
Git/Hook.hs view
@@ -15,6 +15,10 @@ 	{ hookName :: FilePath 	, hookScript :: String 	}+	deriving (Ord)++instance Eq Hook where+	a == b = hookName a == hookName b  hookFile :: Hook -> Repo -> FilePath hookFile h r = localGitDir r </> "hooks" </> hookName h
Git/UpdateIndex.hs view
@@ -15,6 +15,7 @@ 	startUpdateIndex, 	stopUpdateIndex, 	lsTree,+	lsSubTree, 	updateIndexLine, 	stageFile, 	unstageFile,@@ -74,6 +75,13 @@ 	void $ cleanup   where 	params = map Param ["ls-tree", "-z", "-r", "--full-tree", x]+lsSubTree :: Ref -> FilePath -> Repo -> Streamer+lsSubTree (Ref x) p repo streamer = do+	(s, cleanup) <- pipeNullSplit params repo+	mapM_ streamer s+	void $ cleanup+  where+	params = map Param ["ls-tree", "-z", "-r", "--full-tree", x, p]  {- Generates a line suitable to be fed into update-index, to add  - a given file with a given sha. -}
Locations.hs view
@@ -34,6 +34,8 @@ 	gitAnnexScheduleState, 	gitAnnexTransferDir, 	gitAnnexCredsDir,+	gitAnnexWebCertificate,+	gitAnnexWebPrivKey, 	gitAnnexFeedStateDir, 	gitAnnexFeedState, 	gitAnnexMergeDir,@@ -222,6 +224,13 @@  - remotes. -} gitAnnexCredsDir :: Git.Repo -> FilePath gitAnnexCredsDir r = addTrailingPathSeparator $ gitAnnexDir r </> "creds"++{- .git/annex/certificate.pem and .git/annex/key.pem are used by the webapp+ - when HTTPS is enabled -}+gitAnnexWebCertificate :: Git.Repo -> FilePath+gitAnnexWebCertificate r = gitAnnexDir r </> "certificate.pem"+gitAnnexWebPrivKey :: Git.Repo -> FilePath+gitAnnexWebPrivKey r = gitAnnexDir r </> "privkey.pem"  {- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -} gitAnnexFeedStateDir :: Git.Repo -> FilePath
Logs/View.hs view
@@ -75,12 +75,14 @@ 		| 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+	branchvals (FilterValues set) = '=' : branchset set+	branchvals (FilterGlob glob) = '=' : forcelegal glob+	branchvals (ExcludeValues set) = "!=" ++ branchset set+	branchset = intercalate ","+		. map (forcelegal . fromMetaValue)+		. S.toList 	forcelegal s 		| Git.Ref.legal True s = s 		| otherwise = map (\c -> if isAlphaNum c then c else '_') s
Remote/Glacier.hs view
@@ -196,7 +196,7 @@ 					else return $ Right False 			Left err -> return $ Left err -	params =+	params = glacierParams (config r) 		[ Param "archive" 		, Param "checkpresent" 		, Param $ getVault $ config r
Remote/WebDAV.hs view
@@ -386,6 +386,7 @@ #if MIN_VERSION_DAV(0,6,0) goDAV :: DavUrl -> DavUser -> DavPass -> DAVT IO a -> IO a goDAV url user pass a = choke $ evalDAVT url $ do+	setResponseTimeout Nothing -- disable default (5 second!) timeout 	setCreds user pass 	a   where
Test.hs view
@@ -32,7 +32,11 @@ import qualified Backend import qualified Git.CurrentRepo import qualified Git.Filename+import qualified Git.Construct import qualified Git.Types+import qualified Git.Ref+import qualified Git.LsTree+import qualified Git.FilePath import qualified Locations import qualified Types.KeySource import qualified Types.Backend@@ -197,9 +201,13 @@ 	, check "version" test_version 	, check "sync" test_sync 	, check "union merge regression" test_union_merge_regression-	, check "conflict resolution" test_conflict_resolution_movein_bug-	, check "conflict_resolution (mixed directory and file)" test_mixed_conflict_resolution-	, check "conflict_resolution (mixed directory and file) 2" test_mixed_conflict_resolution2+	, check "conflict resolution" test_conflict_resolution+	, check "conflict resolution movein regression" test_conflict_resolution_movein_regression+	, check "conflict resolution (mixed directory and file)" test_mixed_conflict_resolution+	, check "conflict resolution symlinks" test_conflict_resolution_symlinks+	, check "conflict resolution (uncommitted local file)" test_uncommitted_conflict_resolution+	, check "conflict resolution (removed file)" test_remove_conflict_resolution+	, check "conflict resolution (nonannexed)" test_nonannexed_conflict_resolution 	, check "map" test_map 	, check "uninit" test_uninit 	, check "uninit (in git-annex branch)" test_uninit_inbranch@@ -774,8 +782,8 @@  {- 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 -> +test_conflict_resolution_movein_regression :: TestEnv -> Assertion+test_conflict_resolution_movein_regression 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@@ -806,14 +814,48 @@ 		forM_ [r1, r2] $ \r -> indir env r $ do 		 	git_annex env "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r +{- Simple case of conflict resolution; 2 different versions of annexed+ - file. -}+test_conflict_resolution :: TestEnv -> Assertion+test_conflict_resolution env = +	withtmpclonerepo env False $ \r1 ->+		withtmpclonerepo env False $ \r2 -> do+			indir env r1 $ do+				disconnectOrigin+				writeFile conflictor "conflictor1"+				git_annex env "add" [conflictor] @? "add conflicter failed"+				git_annex env "sync" [] @? "sync failed in r1"+			indir env r2 $ do+				disconnectOrigin+				writeFile conflictor "conflictor2"+				git_annex env "add" [conflictor] @? "add conflicter failed"+				git_annex env "sync" [] @? "sync failed in r2"+			pair env r1 r2+			forM_ [r1,r2,r1] $ \r -> indir env r $+				git_annex env "sync" [] @? "sync failed"+			checkmerge "r1" r1+			checkmerge "r2" r2+  where+	conflictor = "conflictor"+	variantprefix = conflictor ++ ".variant"+	checkmerge what d = do+		l <- getDirectoryContents d+		let v = filter (variantprefix `isPrefixOf`) l+		length v == 2+			@? (what ++ " not exactly 2 variant files in: " ++ show l)+		indir env d $ do+			git_annex env "get" v @? "get failed"+			git_annex_expectoutput env "find" v v++ {- Check merge conflict resolution when one side is an annexed  - file, and the other is a directory. -} test_mixed_conflict_resolution :: TestEnv -> Assertion test_mixed_conflict_resolution env = do-	check_mixed_conflict True-	check_mixed_conflict False+	check True+	check False   where-	check_mixed_conflict inr1 = withtmpclonerepo env False $ \r1 ->+	check inr1 = withtmpclonerepo env False $ \r1 -> 		withtmpclonerepo env False $ \r2 -> do 			indir env r1 $ do 				disconnectOrigin@@ -823,7 +865,7 @@ 			indir env r2 $ do 				disconnectOrigin 				createDirectory conflictor-				writeFile (conflictor </> "subfile") "subfile"+				writeFile subfile "subfile" 				git_annex env "add" [conflictor] @? "add conflicter failed" 				git_annex env "sync" [] @? "sync failed in r2" 			pair env r1 r2@@ -831,40 +873,193 @@ 			forM_ l $ \r -> indir env r $ 				git_annex env "sync" [] @? "sync failed in mixed conflict" 			checkmerge "r1" r1-			checkmerge "r1" r2+			checkmerge "r2" r2 	conflictor = "conflictor"+	subfile = conflictor </> "subfile" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = do 		doesDirectoryExist (d </> conflictor) @? (d ++ " conflictor directory missing") 		l <- getDirectoryContents d-		any (variantprefix `isPrefixOf`) l-			@? (what ++ " conflictor file missing in: " ++ show l )+		let v = filter (variantprefix `isPrefixOf`) l+		not (null v)+			@? (what ++ " conflictor variant file missing in: " ++ show l )+		length v == 1+			@? (what ++ " too many variant files in: " ++ show v)+		indir env d $ do+			git_annex env "get" (conflictor:v) @? ("get failed in " ++ what)+			git_annex_expectoutput env "find" [conflictor] [Git.FilePath.toInternalGitPath subfile]+			git_annex_expectoutput env "find" v v -{- - - During conflict resolution, one of the annexed files in git is- - accidentially converted from a symlink to a regular file.- - This only happens on crippled filesystems.- -- - This test case happens to detect the problem when it tries the next- - pass of conflict resolution, since it's unable to resolve a conflict- - between an annexed and non-annexed file.- -}-test_mixed_conflict_resolution2 :: TestEnv -> Assertion-test_mixed_conflict_resolution2 env = go >> go+{- Check merge conflict resolution when both repos start with an annexed+ - file; one modifies it, and the other deletes it. -}+test_remove_conflict_resolution :: TestEnv -> Assertion+test_remove_conflict_resolution env = do+	check True+	check False   where-	go = withtmpclonerepo env False $ \r1 ->+	check inr1 = withtmpclonerepo env False $ \r1 -> 		withtmpclonerepo env False $ \r2 -> do 			indir env r1 $ do+				disconnectOrigin 				writeFile conflictor "conflictor" 				git_annex env "add" [conflictor] @? "add conflicter failed" 				git_annex env "sync" [] @? "sync failed in r1"+			indir env r2 $+				disconnectOrigin+			pair env r1 r2 			indir env r2 $ do-				createDirectory conflictor-				writeFile (conflictor </> "subfile") "subfile"-				git_annex env "add" [conflictor] @? "add conflicter failed" 				git_annex env "sync" [] @? "sync failed in r2"+				git_annex env "get" [conflictor]+					@? "get conflictor failed"+				unlessM (annexeval Config.isDirect) $ do+					git_annex env "unlock" [conflictor]+						@? "unlock conflictor failed"+				writeFile conflictor "newconflictor"+			indir env r1 $+				nukeFile conflictor+			let l = if inr1 then [r1, r2, r1] else [r2, r1, r2]+			forM_ l $ \r -> indir env r $+				git_annex env "sync" [] @? "sync failed"+			checkmerge "r1" r1+			checkmerge "r2" r2 	conflictor = "conflictor"+	variantprefix = conflictor ++ ".variant"+	checkmerge what d = do+		l <- getDirectoryContents d+		let v = filter (variantprefix `isPrefixOf`) l+		not (null v)+			@? (what ++ " conflictor variant file missing in: " ++ show l )+		length v == 1+			@? (what ++ " too many variant files in: " ++ show v) +{- Check merge confalict resolution when a file is annexed in one repo,+ - and checked directly into git in the other repo.+ -+ - This test requires indirect mode to set it up, but tests both direct and+ - indirect mode.+ -}+test_nonannexed_conflict_resolution :: TestEnv -> Assertion+test_nonannexed_conflict_resolution env = do+	check True False+	check False False+	check True True+	check False True+  where+	check inr1 switchdirect = withtmpclonerepo env False $ \r1 ->+		withtmpclonerepo env False $ \r2 -> do+			whenM (isInDirect r1 <&&> isInDirect r2) $ do+				indir env r1 $ do+					disconnectOrigin+					writeFile conflictor "conflictor"+					git_annex env "add" [conflictor] @? "add conflicter failed"+					git_annex env "sync" [] @? "sync failed in r1"+				indir env r2 $ do+					disconnectOrigin+					writeFile conflictor nonannexed_content+					boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed"+					git_annex env "sync" [] @? "sync failed in r2"+				pair env r1 r2+				let l = if inr1 then [r1, r2] else [r2, r1]+				forM_ l $ \r -> indir env r $ do+					when switchdirect $+						git_annex env "direct" [] @? "failed switching to direct mode"+					git_annex env "sync" [] @? "sync failed"+				checkmerge ("r1" ++ show switchdirect) r1+				checkmerge ("r2" ++ show switchdirect) r2+	conflictor = "conflictor"+	nonannexed_content = "nonannexed"+	variantprefix = conflictor ++ ".variant"+	checkmerge what d = do+		l <- getDirectoryContents d+		let v = filter (variantprefix `isPrefixOf`) l+		not (null v)+			@? (what ++ " conflictor variant file missing in: " ++ show l )+		length v == 1+			@? (what ++ " too many variant files in: " ++ show v)+		conflictor `elem` l @? (what ++ " conflictor file missing in: " ++ show l)+		s <- catchMaybeIO (readFile (d </> conflictor))+		s == Just nonannexed_content+			@? (what ++ " wrong content for nonannexed file: " ++ show s)++{- Check merge conflict resolution when there is a local file,+ - that is not staged or committed, that conflicts with what's being added+ - from the remmote.+ -+ - Case 1: Remote adds file named conflictor; local has a file named+ - conflictor.+ -+ - Case 2: Remote adds conflictor/file; local has a file named conflictor.+ -}+test_uncommitted_conflict_resolution :: TestEnv -> Assertion+test_uncommitted_conflict_resolution env = do+	check conflictor+	check (conflictor </> "file")+  where+	check remoteconflictor = withtmpclonerepo env False $ \r1 ->+		withtmpclonerepo env False $ \r2 -> do+			indir env r1 $ do+				disconnectOrigin+				createDirectoryIfMissing True (parentDir remoteconflictor)+				writeFile remoteconflictor annexedcontent+				git_annex env "add" [conflictor] @? "add remoteconflicter failed"+				git_annex env "sync" [] @? "sync failed in r1"+			indir env r2 $ do+				disconnectOrigin+				writeFile conflictor localcontent+			pair env r1 r2+			indir env r2 $ ifM (annexeval Config.isDirect)+				( do+					git_annex env "sync" [] @? "sync failed"+					let local = conflictor ++ localprefix+					doesFileExist local @? (local ++ " missing after merge")+					s <- readFile local+					s == localcontent @? (local ++ " has wrong content: " ++ s)+					git_annex env "get" [conflictor] @? "get failed"+					doesFileExist remoteconflictor @? (remoteconflictor ++ " missing after merge")+					s' <- readFile remoteconflictor+					s' == annexedcontent @? (remoteconflictor ++ " has wrong content: " ++ s)+				-- this case is intentionally not handled+				-- in indirect mode, since the user+				-- can recover on their own easily+				, not <$> git_annex env "sync" [] @? "sync failed to fail"+				)+	conflictor = "conflictor"+	localprefix = ".variant-local"+	localcontent = "local"+	annexedcontent = "annexed"++{- On Windows/FAT, repeated conflict resolution sometimes + - lost track of whether a file was a symlink. + -}+test_conflict_resolution_symlinks :: TestEnv -> Assertion+test_conflict_resolution_symlinks env = do+	withtmpclonerepo env False $ \r1 ->+		withtmpclonerepo env False $ \r2 -> do+			withtmpclonerepo env False $ \r3 -> do+				indir env r1 $ do+					writeFile conflictor "conflictor"+					git_annex env "add" [conflictor] @? "add conflicter failed"+					git_annex env "sync" [] @? "sync failed in r1"+					check_is_link conflictor "r1"+				indir env r2 $ do+					createDirectory conflictor+					writeFile (conflictor </> "subfile") "subfile"+					git_annex env "add" [conflictor] @? "add conflicter failed"+					git_annex env "sync" [] @? "sync failed in r2"+					check_is_link (conflictor </> "subfile") "r2"+				indir env r3 $ do+					writeFile conflictor "conflictor"+					git_annex env "add" [conflictor] @? "add conflicter failed"+					git_annex env "sync" [] @? "sync failed in r1"+					check_is_link (conflictor </> "subfile") "r3"+  where+	conflictor = "conflictor"+	check_is_link f what = do+		git_annex_expectoutput env "find" ["--include=*", f] [Git.FilePath.toInternalGitPath f]+		l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f]+		all (\i -> Git.Types.toBlobType (Git.LsTree.mode i) == Just Git.Types.SymlinkBlob) l+			@? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l)+ {- Set up repos as remotes of each other. -} pair :: TestEnv -> FilePath -> FilePath -> Assertion pair env r1 r2 = forM_ [r1, r2] $ \r -> indir env r $ do@@ -1151,6 +1346,11 @@ 		Annex.Init.initialize Nothing 		Config.isDirect +isInDirect :: FilePath -> IO Bool+isInDirect d = do+	s <- Annex.new =<< Git.Construct.fromPath d+	not <$> Annex.eval s Config.isDirect+ intmpbareclonerepo :: TestEnv -> Assertion -> Assertion intmpbareclonerepo env a = withtmpclonerepo env True $ \r -> indir env r a @@ -1344,7 +1544,8 @@ 	cwd <- getCurrentDirectory 	p <- Utility.Env.getEnvDefault "PATH" "" -	let env =+	env <- Utility.Env.getEnvironment+	let newenv = 		-- Ensure that the just-built git annex is used. 		[ ("PATH", cwd ++ [searchPathSeparator] ++ p) 		, ("TOPDIR", cwd)@@ -1360,7 +1561,7 @@ 		, ("FORCEDIRECT", if forcedirect then "1" else "") 		] -	return $ M.fromList env+	return $ M.fromList newenv `M.union` M.fromList env  changeToTmpDir :: TestEnv -> FilePath -> IO () changeToTmpDir env t = do
Types/GitConfig.hs view
@@ -50,6 +50,8 @@ 	, annexExpireUnused :: Maybe (Maybe Duration) 	, annexSecureEraseCommand :: Maybe String 	, annexGenMetaData :: Bool+	, annexListen :: Maybe String+	, annexStartupScan :: Bool 	, coreSymlinks :: Bool 	, gcryptId :: Maybe String 	}@@ -83,6 +85,8 @@ 		<$> getmaybe (annex "expireunused") 	, annexSecureEraseCommand = getmaybe (annex "secure-erase-command") 	, annexGenMetaData = getbool (annex "genmetadata") False+	, annexListen = getmaybe (annex "listen")+	, annexStartupScan = getbool (annex "startupscan") True 	, coreSymlinks = getbool "core.symlinks" True 	, gcryptId = getmaybe "core.gcrypt-id" 	}
Types/Key.hs view
@@ -78,8 +78,12 @@ 	findfields _ v = v  	addbackend k v = Just k { keyBackendName = v }-	addfield 's' k v = Just k { keySize = readish v }-	addfield 'm' k v = Just k { keyMtime = readish v }+	addfield 's' k v = do+		sz <- readish v+		return $ k { keySize = Just sz }+	addfield 'm' k v = do+		mtime <- readish v+		return $ k { keyMtime = Just mtime } 	addfield _ _ _ = Nothing  instance Arbitrary Key where@@ -93,4 +97,12 @@ prop_idempotent_key_encode k = Just k == (file2key . key2file) k  prop_idempotent_key_decode :: FilePath -> Bool-prop_idempotent_key_decode f = maybe True (\k -> key2file k == f) (file2key f)+prop_idempotent_key_decode f+	| normalfieldorder = maybe True (\k -> key2file k == f) (file2key f)+	| otherwise = True+  where+  	-- file2key will accept the fields in any order, so don't+	-- try the test unless the fields are in the normal order+	normalfieldorder = fields `isPrefixOf` "sm"+	fields = map (f !!) $ filter (< length f) $ map succ $+		elemIndices fieldSep f
Types/MetaData.hs view
@@ -219,6 +219,7 @@ 	= AddMeta MetaField MetaValue 	| DelMeta MetaField MetaValue 	| SetMeta MetaField MetaValue -- removes any existing values+	| MaybeSetMeta MetaField MetaValue -- when field has no existing value  {- Applies a ModMeta, generating the new MetaData.  - Note that the new MetaData does not include all the @@ -229,12 +230,16 @@ modMeta m (SetMeta f v) = updateMetaData f v $ 	foldr (updateMetaData f) emptyMetaData $ 		map unsetMetaValue $ S.toList $ currentMetaDataValues f m+modMeta m (MaybeSetMeta f v)+	| S.null (currentMetaDataValues f m) = updateMetaData f v emptyMetaData+	| otherwise = emptyMetaData -{- Parses field=value, field+=value, field-=value -}+{- Parses field=value, 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+	Just '?' -> MaybeSetMeta <$> mkMetaField f' <*> v 	_ -> SetMeta <$> mkMetaField f <*> v   where 	(f, sv) = separate (== '=') p
Types/StandardGroups.hs view
@@ -72,6 +72,10 @@ associatedDirectory Nothing PublicGroup = Just "public" associatedDirectory _ _ = Nothing +specialRemoteOnly :: StandardGroup -> Bool+specialRemoteOnly PublicGroup = True+specialRemoteOnly _ = False+ {- See doc/preferred_content.mdwn for explanations of these expressions. -} preferredContent :: StandardGroup -> PreferredContentExpression preferredContent ClientGroup = lastResort $
Types/View.hs view
@@ -38,14 +38,23 @@ data ViewFilter 	= FilterValues (S.Set MetaValue) 	| FilterGlob String+	| ExcludeValues (S.Set MetaValue) 	deriving (Eq, Read, Show)  instance Arbitrary ViewFilter where 	arbitrary = do 		size <- arbitrarySizedBoundedIntegral `suchThat` (< 100)-		FilterValues . S.fromList <$> vector size+		s <- S.fromList <$> vector size+		ifM arbitrary+			( return (FilterValues s)+			, return (ExcludeValues s)+			) +mkViewComponent :: MetaField -> ViewFilter -> ViewComponent+mkViewComponent f vf = ViewComponent f vf (multiValue vf)+ {- Can a ViewFilter match multiple different MetaValues? -} multiValue :: ViewFilter -> Bool multiValue (FilterValues s) = S.size s > 1 multiValue (FilterGlob _) = True+multiValue (ExcludeValues _) = False
Utility/DirWatcher.hs view
@@ -104,33 +104,33 @@  - to shutdown later. -} #if WITH_INOTIFY type DirWatcherHandle = INotify.INotify-watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle-watchDir dir prune hooks runstartup = do+watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle+watchDir dir prune scanevents hooks runstartup = do 	i <- INotify.initINotify-	runstartup $ INotify.watchDir i dir prune hooks+	runstartup $ INotify.watchDir i dir prune scanevents hooks 	return i #else #if WITH_KQUEUE type DirWatcherHandle = ThreadId-watchDir :: FilePath -> Pruner -> WatchHooks -> (IO Kqueue.Kqueue -> IO Kqueue.Kqueue) -> IO DirWatcherHandle-watchDir dir prune hooks runstartup = do+watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO Kqueue.Kqueue -> IO Kqueue.Kqueue) -> IO DirWatcherHandle+watchDir dir prune _scanevents hooks runstartup = do 	kq <- runstartup $ Kqueue.initKqueue dir prune 	forkIO $ Kqueue.runHooks kq hooks #else #if WITH_FSEVENTS type DirWatcherHandle = FSEvents.EventStream-watchDir :: FilePath -> Pruner -> WatchHooks -> (IO FSEvents.EventStream -> IO FSEvents.EventStream) -> IO DirWatcherHandle-watchDir dir prune hooks runstartup =-	runstartup $ FSEvents.watchDir dir prune hooks+watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO FSEvents.EventStream -> IO FSEvents.EventStream) -> IO DirWatcherHandle+watchDir dir prune scanevents hooks runstartup =+	runstartup $ FSEvents.watchDir dir prune scanevents hooks #else #if WITH_WIN32NOTIFY type DirWatcherHandle = Win32Notify.WatchManager-watchDir :: FilePath -> Pruner -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle-watchDir dir prune hooks runstartup =-	runstartup $ Win32Notify.watchDir dir prune hooks+watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO Win32Notify.WatchManager -> IO Win32Notify.WatchManager) -> IO DirWatcherHandle+watchDir dir prune scanevents hooks runstartup =+	runstartup $ Win32Notify.watchDir dir prune scanevents hooks #else type DirWatcherHandle = ()-watchDir :: FilePath -> Pruner -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle+watchDir :: FilePath -> Pruner -> Bool -> WatchHooks -> (IO () -> IO ()) -> IO DirWatcherHandle watchDir = undefined #endif #endif
Utility/DirWatcher/FSEvents.hs view
@@ -14,8 +14,8 @@ import qualified System.Posix.Files as Files import Data.Bits ((.&.)) -watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO EventStream-watchDir dir ignored hooks = do+watchDir :: FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO EventStream+watchDir dir ignored scanevents hooks = do 	unlessM fileLevelEventsSupported $ 		error "Need at least OSX 10.7.0 for file-level FSEvents" 	scan dir@@ -79,9 +79,11 @@ 					Nothing -> noop 					Just s 						| Files.isSymbolicLink s ->-							runhook addSymlinkHook ms+							when scanevents $+								runhook addSymlinkHook ms 						| Files.isRegularFile s ->-							runhook addHook ms+							when scanevents $+								runhook addHook ms 						| otherwise -> 							noop 		  where
Utility/DirWatcher/INotify.hs view
@@ -46,8 +46,8 @@  - So this will fail if there are too many subdirectories. The  - errHook is called when this happens.  -}-watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> WatchHooks -> IO ()-watchDir i dir ignored hooks+watchDir :: INotify -> FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO ()+watchDir i dir ignored scanevents hooks 	| ignored dir = noop 	| otherwise = do 		-- Use a lock to make sure events generated during initial@@ -61,7 +61,7 @@ 				mapM_ scan =<< filter (not . dirCruft) <$> 					getDirectoryContents dir   where-	recurse d = watchDir i d ignored hooks+	recurse d = watchDir i d ignored scanevents hooks  	-- Select only inotify events required by the enabled 	-- hooks, but always include Create so new directories can@@ -85,9 +85,11 @@ 				| Files.isDirectory s -> 					recurse $ indir f 				| Files.isSymbolicLink s ->-					runhook addSymlinkHook f ms+					when scanevents $+						runhook addSymlinkHook f ms 				| Files.isRegularFile s ->-					runhook addHook f ms+					when scanevents $+						runhook addHook f ms 				| otherwise -> 					noop
Utility/DirWatcher/Win32Notify.hs view
@@ -13,8 +13,8 @@ import System.Win32.Notify import qualified Utility.PosixFiles as Files -watchDir :: FilePath -> (FilePath -> Bool) -> WatchHooks -> IO WatchManager-watchDir dir ignored hooks = do+watchDir :: FilePath -> (FilePath -> Bool) -> Bool -> WatchHooks -> IO WatchManager+watchDir dir ignored scanevents hooks = do 	scan dir 	wm <- initWatchManager 	void $ watchDirectory wm dir True [Create, Delete, Modify, Move] handle@@ -52,7 +52,8 @@ 					Nothing -> noop 					Just s 						| Files.isRegularFile s ->-							runhook addHook ms+							when scanevents $+								runhook addHook ms 						| otherwise -> 							noop 		  where
Utility/Glob.hs view
@@ -24,6 +24,7 @@ import Text.Regex.TDFA.String #else import Text.Regex+import Data.Maybe #endif  newtype Glob = Glob Regex
Utility/Quvi.hs view
@@ -11,7 +11,6 @@  import Common import Utility.Url-import Build.SysConfig (newquvi)  import Data.Aeson import Data.ByteString.Lazy.UTF8 (fromString)@@ -19,6 +18,11 @@ import Network.URI (uriAuthority, uriRegName) import Data.Char +data QuviVersion+	= Quvi04+	| Quvi09+	| NoQuvi+ data Page = Page 	{ pageTitle :: String 	, pageLinks :: [Link]@@ -56,11 +60,19 @@ 	get = flip M.lookup m 	m = M.fromList $ map (separate (== '=')) $ lines s -type Query a = [CommandParam] -> URLString -> IO a+probeVersion :: IO QuviVersion+probeVersion = examine <$> processTranscript "quvi" ["--version"] Nothing+  where+	examine (s, True)+		| "quvi v0.4" `isInfixOf` s = Quvi04+		| otherwise = Quvi09+	examine _ = NoQuvi +type Query a = QuviVersion -> [CommandParam] -> URLString -> IO a+ {- Throws an error when quvi is not installed. -} forceQuery :: Query (Maybe Page)-forceQuery ps url = query' ps url `catchNonAsync` onerr+forceQuery v ps url = query' v ps url `catchNonAsync` onerr   where 	onerr _ = ifM (inPath "quvi") 		( error "quvi failed"@@ -70,33 +82,36 @@ {- Returns Nothing if the page is not a video page, or quvi is not  - installed. -} query :: Query (Maybe Page)-query ps url = flip catchNonAsync (const $ return Nothing) (query' ps url)+query v ps url = flip catchNonAsync (const $ return Nothing) (query' v ps url)  query' :: Query (Maybe Page)-query' ps url-	| newquvi = parseEnum-		<$> readProcess "quvi" (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])-	| otherwise = decode . fromString-		<$> readProcess "quvi" (toCommand $ ps ++ [Param url])+query' Quvi09 ps url = parseEnum+	<$> readProcess "quvi" (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])+query' Quvi04 ps url = decode . fromString+	<$> readProcess "quvi" (toCommand $ ps ++ [Param url])+query' NoQuvi _ _ = return Nothing  queryLinks :: Query [URLString]-queryLinks ps url = maybe [] (map linkUrl . pageLinks) <$> query ps url+queryLinks v ps url = maybe [] (map linkUrl . pageLinks) <$> query v ps url  {- Checks if quvi can still find a download link for an url.  - If quvi is not installed, returns False. -} check :: Query Bool-check ps url = maybe False (not . null . pageLinks) <$> query ps url+check v ps url = maybe False (not . null . pageLinks) <$> query v ps url  {- Checks if an url is supported by quvi, as quickly as possible  - (without hitting it if possible), and without outputting  - anything. Also returns False if quvi is not installed. -}-supported :: URLString -> IO Bool-supported url-	{- Use quvi-info to see if the url's domain is supported.-	 - If so, have to do a online verification of the url. -}-	| newquvi = (firstlevel <&&> secondlevel)+supported :: QuviVersion -> URLString -> IO Bool+supported NoQuvi _ = return False+supported Quvi04 url = boolSystem "quvi"+		[ Params "--verbosity mute --support"+		, Param url+		]+{- Use quvi-info to see if the url's domain is supported.+ - If so, have to do a online verification of the url. -}+supported Quvi09 url = (firstlevel <&&> secondlevel) 		`catchNonAsync` (\_ -> return False)-	| otherwise = boolSystem "quvi" [Params "--verbosity mute --support", Param url]   where   	firstlevel = case uriAuthority =<< parseURIRelaxed url of 		Nothing -> return False@@ -104,30 +119,30 @@ 			let domain = map toLower $ uriRegName auth 			let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ split "." domain 			any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h) -				. map (map toLower) <$> listdomains+				. map (map toLower) <$> listdomains Quvi09 	secondlevel = snd <$> processTranscript "quvi" 		(toCommand [Param "dump", Param "-o", Param url]) Nothing -listdomains :: IO [String]-listdomains -	| newquvi = concatMap (split ",") -		. concatMap (drop 1 . words) -		. filter ("domains: " `isPrefixOf`) . lines-		<$> readProcess "quvi"-			(toCommand [Param "info", Param "-p", Param "domains"])-	| otherwise = return []+listdomains :: QuviVersion -> IO [String]+listdomains Quvi09 = concatMap (split ",") +	. concatMap (drop 1 . words) +	. filter ("domains: " `isPrefixOf`) . lines+	<$> readProcess "quvi"+		(toCommand [Param "info", Param "-p", Param "domains"])+listdomains _ = return [] +type QuviParam = QuviVersion -> CommandParam+ {- Disables progress, but not information output. -}-quiet :: CommandParam-quiet-	-- Cannot use quiet as it now disables informational output.-	-- No way to disable progress.-	| newquvi = Params "--verbosity verbose"-	| otherwise = Params "--verbosity quiet"+quiet :: QuviParam+-- Cannot use quiet as it now disables informational output.+-- No way to disable progress.+quiet Quvi09 = Params "--verbosity verbose"+quiet Quvi04 = Params "--verbosity quiet"+quiet NoQuvi = Params ""  {- Only return http results, not streaming protocols. -}-httponly :: CommandParam-httponly-	-- No way to do it with 0.9?-	| newquvi = Params ""-	| otherwise = Params "-c http"+httponly :: QuviParam+-- No way to do it with 0.9?+httponly Quvi04 = Params "-c http"+httponly _ = Params "" -- No way to do it with 0.9?
Utility/WebApp.hs view
@@ -17,6 +17,7 @@ import qualified Yesod import qualified Network.Wai as Wai import Network.Wai.Handler.Warp+import Network.Wai.Handler.WarpTLS import Network.Wai.Logger import Control.Monad.IO.Class import Network.HTTP.Types@@ -70,10 +71,12 @@  - An IO action can also be run, to do something with the address,  - such as start a web browser to view the webapp.  -}-runWebApp :: Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO ()-runWebApp h app observer = withSocketsDo $ do+runWebApp :: Maybe TLSSettings -> Maybe HostName -> Wai.Application -> (SockAddr -> IO ()) -> IO ()+runWebApp tlssettings h app observer = withSocketsDo $ do 	sock <- getSocket h-	void $ forkIO $ runSettingsSocket webAppSettings sock app+	void $ forkIO $ +		(maybe runSettingsSocket (\ts -> runTLSSocket ts) tlssettings)+			webAppSettings sock app	 	sockaddr <- fixSockAddr <$> getSocketName sock 	observer sockaddr @@ -112,13 +115,13 @@ 	use sock   where #else-	addrs <- getAddrInfo (Just hints) (Just hostname) port+	addrs <- getAddrInfo (Just hints) (Just hostname) Nothing 	case (partition (\a -> addrFamily a == AF_INET) addrs) of 		(v4addr:_, _) -> go v4addr 		(_, v6addr:_) -> go v6addr 		_ -> error "unable to bind to a local socket"   where-	(hostname, port) = maybe (localhost, Nothing) splitHostPort h+	hostname = fromMaybe localhost h 	hints = defaultHints { addrSocketType = Stream } 	{- Repeated attempts because bind sometimes fails for an 	 - unknown reason on OSX. -} @@ -138,18 +141,6 @@ 	use sock = do 		listen sock maxListenQueue 		return sock--{- Splits address:port. For IPv6, use [address]:port. The port is optional. -}-splitHostPort :: String -> (HostName, Maybe ServiceName)-splitHostPort s-	| "[" `isPrefixOf` s = let (h, p) = break (== ']') (drop 1 s)-		in if "]:" `isPrefixOf` p-			then (h, Just $ drop 2 p)-			else (h, Nothing)-	| otherwise = let (h, p) = separate (== ':') s-		in if null p-			then (h, Nothing)-			else (h, Just p)  {- Checks if debugging is actually enabled. -} debugEnabled :: IO Bool
debian/changelog view
@@ -1,3 +1,40 @@+git-annex (5.20140306) unstable; urgency=high++  * sync: Fix bug in direct mode that caused a file that was not+    checked into git to be deleted when there was a conflicting+    merge with a remote.+  * webapp: Now supports HTTPS.+  * webapp: No longer supports a port specified after --listen, since+    it was buggy, and that use case is better supported by setting up HTTPS.+  * annex.listen can be configured, instead of using --listen+  * annex.startupscan can be set to false to disable the assistant's startup+    scan.+  * Probe for quvi version at run time.+  * webapp: Filter out from Switch Repository list any+    repositories listed in autostart file that don't have a+    git directory anymore. (Or are bare)+  * webapp: Refuse to start in a bare git repository.+  * assistant --autostart: Refuse to start in a bare git repository.+  * webapp: Don't list the public repository group when editing a+    git repository; it only makes sense for special remotes.+  * view, vfilter: Add support for filtering tags and values out of a view,+    using !tag and field!=value.+  * vadd: Allow listing multiple desired values for a field.+  * view: Refuse to enter a view when no branch is currently checked out.+  * metadata: To only set a field when it's not already got a value, use+    -s field?=value+  * Run .git/hooks/pre-commit-annex whenever a commit is made.+  * sync: Automatically resolve merge conflict between and annexed file+    and a regular git file.+  * glacier: Pass --region to glacier checkpresent.+  * webdav: When built with a new enough haskell DAV (0.6), disable+    the http response timeout, which was only 5 seconds.+  * webapp: Include no-pty in ssh authorized_keys lines.+  * assistant: Smarter log file rotation, which takes free disk space+    into account.++ -- Joey Hess <joeyh@debian.org>  Thu, 06 Mar 2014 12:28:04 -0400+ git-annex (5.20140227) unstable; urgency=medium    * metadata: Field names limited to alphanumerics and a few whitelisted
debian/control view
@@ -36,6 +36,7 @@ 	libghc-hamlet-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-clientsession-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-warp-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc],+	libghc-warp-tls-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-wai-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-wai-logger-dev [i386 amd64 kfreebsd-i386 kfreebsd-amd64 powerpc sparc], 	libghc-case-insensitive-dev,
+ doc/bugs/Box.com_ReposnseTimeout.mdwn view
@@ -0,0 +1,12 @@+Box.com is still not working properly in version 5.20140227 (I'm using it in Debian testing and sid).++I created a new clean repository and configured Box.com (everything from the webapp). At first it seamed to work, files where being uploaded and the logs where fine. Then I created another clean repository in another computer and started syncing. Downloading files worked properly, but when trying to upload a file from the second computer I got this:++    copy my_file (gpg) (checking box.com...) (to box.com...) +    100%          0.0 B/s 0sResponseTimeout+    failed                  +    git-annex: copy: 1 failed++When I got back to the first computer I saw the same behavior, uploading files wasn't working any more.++> [[duplicate|done]] --[[Joey]]
doc/bugs/Hangs_on_creating_repository_when_using_--listen.mdwn view
@@ -44,3 +44,6 @@ > to use when something else is already listening there. --[[Joey]]   [[!tag /design/assistant]]++>> --listen no longer accepts a port. Use the new HTTPS support instead.+>> [[done]] --[[Joey]]
+ doc/bugs/Log_rotation_loses_large_logs.mdwn view
@@ -0,0 +1,69 @@+### Please describe the problem.++I have a large git-annex repository created using the assistant. It has thousands of files in it and is about 50GB in size.+Yesterday I added a number of new files, and I also created a new "removable drive" repository for it to sync to.++During these operations I could see a large amount of data being added to the git-annex log files.+I left my computer on overnight to finish the sync.++Today I went to check the log files but there was no useful information in them.++Looking at the source I suspect I had a single log file > 1 Megabyte in size, which caused the rotation to occur repeatedly until it rolled off the end.+However, I would have preferred if this large logfile had been kept for more than a couple of hours.++See file contents below++### What steps will reproduce the problem?++See above++### What version of git-annex are you using? On what operating system?++Debian Wheezy, git-annex version: 5.20140210~bpo70+2 from wheezy-backports++### 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++When I look at the log files now, I see the following:+-rw-r--r--    1 pgl users     443 Mar  5 21:48 daemon.log+-rw-r--r--    1 pgl users     443 Mar  5 21:47 daemon.log.1+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.10+-rw-r--r--    1 pgl users      69 Mar  5 07:29 daemon.log.2+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.3+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.4+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.5+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.6+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.7+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.8+-rw-r--r--    1 pgl users      81 Mar  5 01:16 daemon.log.9++Looking at some of these log files.++pgl@....:/....../.git/annex$ cat daemon.log.3+[2014-03-05 01:16:15 GMT] SanityCheckerHourly: Rotated logs due to size: 1026416+pgl@....:/....../.git/annex$ cat daemon.log.4+[2014-03-05 01:16:15 GMT] SanityCheckerHourly: Rotated logs due to size: 1026416+pgl@....:/....../.git/annex$ cat daemon.log.5+[2014-03-05 01:16:15 GMT] SanityCheckerHourly: Rotated logs due to size: 1026416+pgl@....:/....../.git/annex$ cat daemon.log.6+[2014-03-05 01:16:15 GMT] SanityCheckerHourly: Rotated logs due to size: 1026416+pgl@....:/....../.git/annex$ cat daemon.log.7+[2014-03-05 01:16:15 GMT] SanityCheckerHourly: Rotated logs due to size: 1026416+pgl@....:/....../.git/annex$ cat daemon.log.8+[2014-03-05 01:16:15 GMT] SanityCheckerHourly: Rotated logs due to size: 1026416+pgl@....:/....../.git/annex$ cat daemon.log.9+[2014-03-05 01:16:15 GMT] SanityCheckerHourly: Rotated logs due to size: 1026416++# End of transcript or log.+"""]]++> Changed log rotation to only rotate 1 log per hour max,+> unless the total size of the log files is larger than the +> free disk space on the filesystem containing them.+> +> This way, runaway log growth will still be contained,+> but logs will generally rotate slowly enough to give plenty of time+> to see what's in them. [[done]] --[[Joey]]
doc/bugs/amd64_i386_standalone:_no_SKEIN.mdwn view
@@ -36,3 +36,6 @@ """]]  -- [[clacke]]++> [[done]] The autobuilds are now running debian unstable, and SKEIN is included+> now. --[[Joey]]
doc/bugs/assistant_eats_all_CPU.mdwn view
@@ -1,3 +1,5 @@+[[!meta title="debian system runs assistant in tight loop, rather than using select"]]+ ### Please describe the problem.  After running for a while, the assistant maxes my CPU. I have evidence
doc/bugs/box.com_never_stops_syncing..mdwn view
@@ -61,3 +61,14 @@ """]]  More to come(full log)++> This is [[fixed|done]] in git; when built with a new enough+> version of the haskell DAV library, git-annex disables the default 5+> second timeout.+> +> It'll still be present in the Debian stable backports, which are+> built with an old version of DAV. Not much I can do about that;+> backporting DAV would be difficult.+> +> The daily builds are updated to use the new version.+> --[[Joey]]
doc/bugs/can__39__t_get.mdwn view
@@ -73,3 +73,9 @@  # End of transcript or log. """]]++[[!tag moreinfo]]++> Tagged moreinfo since I have a workable theory about how this happened,+> which would make it user configuration error and not a bug, but +> that has not been confirmed. --[[Joey]]
+ doc/bugs/direct_mode_merge_can_overwrite_local__44___non-annexed_files.mdwn view
@@ -0,0 +1,14 @@+Direct mode merge handles the case where there's a conflict between local and remote files, that are checked into git.++However, the the local file (or directory, or symlink, whatever)+is not checked into git, the merge will overwrite it with the remote file from git.++> That's fixed; now this is detected and the local variant+> is renamed with ".variant-local", and possibly a number to make it+> unique.++New problem: If the merge pulls in a directory, and a file exists with+the name of the directory, locally, not annexed, the file is left alone,+but the directory is thus not checked out, and will be deleted on commit.++> [[fixed|done]]; regression test in place. --[[Joey]]
+ doc/bugs/quvi_0.9.5_does_not_work_with_git-annex.mdwn view
@@ -0,0 +1,87 @@+### Please describe the problem.+The syntax of quvi has changed somewhat, breaking use in git-annex.++quvi now requires one of four «commands» to be supplied: dump, get, info, scan++### What steps will reproduce the problem?+Install quvi 0.9.5, attempt to download a video.++### What version of git-annex are you using? On what operating system?+git-annex version: 5.20140227-gd872677++On ArchLinux up-to-date as of 28th of February 2014++### Please provide any additional information below.++[[!format text """+[0 zerodogg@browncoats Dokumentar]$ git annex addurl 'quvi:https://www.youtube.com/watch?v=de20gulo78g' --debug  +[2014-02-28 09:33:22 CET] read: quvi ["--verbosity","quiet","-c","http","https://www.youtube.com/watch?v=de20gulo78g"]+error: `--verbosity' is not a quvi command. See 'quvi help'.+git-annex: quvi failed+[1 zerodogg@browncoats Dokumentar]$ quvi --version+quvi v0.9.5+  built on 2013-11-12 17:02:06 +0000 for x86_64-unknown-linux-gnu+    with gcc, -march=x86-64 -mtune=generic -O2 -pipe -fstack-protector --param=ssp-buffer-size=4+  configuration: --prefix=/usr+libquvi v0.9.4+  built on 2013-12-17 11:27:41 +0000 for x86_64-unknown-linux-gnu+    with gcc, -march=x86-64 -mtune=generic -O2 -pipe -fstack-protector --param=ssp-buffer-size=4+  configuration: --prefix=/usr+libquvi-scripts v0.9.20131130+  configuration: --prefix=/usr --with-nsfw --with-geoblocked++Copyright (C) 2012,2013  Toni Gundogdu <legatvs@gmail.com>+quvi comes with ABSOLUTELY NO WARRANTY.  You may redistribute copies of+quvi under the terms of the GNU Affero General Public License version 3+or later. For more information, see <http://www.gnu.org/licenses/agpl.html>.++To contact the developers, please mail to <quvi-devel@lists.sourceforge.net>+[0 zerodogg@browncoats Dokumentar]$  quvi+Usage: quvi [--version] [--help] COMMAND [ARGS]++quvi commands are:+  dump    Query and print the property values+  get     Save media stream to a file+  info    Inspect the configuration and the script properties+  scan    Scan and print the found embedded media URLs++See 'quvi help COMMAND' for more information on a specific command.+[0 zerodogg@browncoats Dokumentar]$ git annex version+git-annex version: 5.20140227-gd872677+build flags: Assistant Webapp Pairing S3 Inotify DBus XMPP Feeds Quvi TDFA+key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SHA256 SHA1 SHA512 SHA224 SHA384 WORM URL+remote types: git gcrypt S3 bup directory rsync web tahoe glacier hook external+local repository version: 5+supported repository version: 5+upgrade supported from repository versions: 0 1 2 4+"""]]++quvi dump is probably something you could use++[[!format text """+[0 zerodogg@browncoats Dokumentar]$ quvi dump 'https://www.youtube.com/watch?v=de20gulo78g'+QUVI_MEDIA_PROPERTY_THUMBNAIL_URL=https://i1.ytimg.com/vi/de20gulo78g/default.jpg                                                                                        +QUVI_MEDIA_PROPERTY_TITLE=[Linux.conf.au 2013] - Git-annex+QUVI_MEDIA_PROPERTY_ID=de20gulo78g+QUVI_MEDIA_PROPERTY_START_TIME_MS=0+QUVI_MEDIA_PROPERTY_DURATION_MS=2328000+QUVI_MEDIA_STREAM_PROPERTY_VIDEO_ENCODING=vp8.0+QUVI_MEDIA_STREAM_PROPERTY_AUDIO_ENCODING=vorbis+QUVI_MEDIA_STREAM_PROPERTY_CONTAINER=webm+QUVI_MEDIA_STREAM_PROPERTY_URL=[Long googlevideo.com URL]+QUVI_MEDIA_STREAM_PROPERTY_ID=medium_webm_i43_360p+QUVI_MEDIA_STREAM_PROPERTY_VIDEO_BITRATE_KBIT_S=0+QUVI_MEDIA_STREAM_PROPERTY_AUDIO_BITRATE_KBIT_S=0+QUVI_MEDIA_STREAM_PROPERTY_VIDEO_HEIGHT=360+QUVI_MEDIA_STREAM_PROPERTY_VIDEO_WIDTH=640+"""]]++It does however output some status messages to STDERR (which it removes later) that doesn't look to be possible to suppress.++[[!format text """+[0 zerodogg@browncoats Dokumentar]$ quvi dump 'https://www.youtube.com/watch?v=de20gulo78g' >/dev/null 2>stderr+[0 zerodogg@browncoats Dokumentar]$ cat -v stderr +status: o--- resolve <url> ...                                                 ^M                                                                               ^Mstatus: -o-- fetch <url> ...                                                   ^M                                                                               ^M%               [0 zerodogg@browncoats Dokumentar]$              +""" ]]++> quvi version now probed at runtime. [[done]] --[[Joey]]
doc/design/metadata.mdwn view
@@ -18,43 +18,45 @@ 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.+## unmatched files in filtered branches +TODO Files not matching the view should be able to be included in+the filtered branch, in a special location, an "other" directory.++For example, it could make a "other" directory containing files+without a tag when viewing by tag.++It might be nice, if in a two level view, for the other directories+to nest. For example, `other/2014/file`. However, that leads to a+performance problem: When adding a level to a view, it has to look at each+file in the "other" directory and generate a view for it too. With a lot+of files, that'd be slow.++Instead, why not replicate the parent branch's directory structure inside+the "other" directory? Then the directory tree only has to be constructed+once, and can be left alone when refining a view.+ ## 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-  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.+  relevant metadata from the files. **done**  +  (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.+When annex.genmetadata is set, git annex add automatically attaches+some metadata to a file. Currently year and month fields, from its mtime. -Also auto add metadata when adding files to view branches. See below.+There's also a post-commit-annex hook script.  ## directory hierarchy metadata
doc/design/roadmap.mdwn view
@@ -9,8 +9,8 @@ * Month 3 user-driven features and polishing [[!traillink todo/direct_mode_guard]] [[!traillink assistant/upgrading]] * Month 4 [[!traillink assistant/windows text="Windows webapp"]], Linux arm, [[!traillink todo/support_for_writing_external_special_remotes]] * Month 5 user-driven features and polishing-* **Month 6 get Windows out of beta, [[!traillink design/metadata text="metadata and views"]]**-* Month 7 user-driven features and polishing+* Month 6 get Windows out of beta, [[!traillink design/metadata text="metadata and views"]]+* **Month 7 user-driven features and polishing** * Month 8 [[!traillink assistant/telehash]] * Month 9 [[!traillink assistant/gpgkeys]] [[!traillink assistant/sshpassword]] * Month 10 get [[assistant/Android]] out of beta
+ doc/devblog/day_124__day_off.mdwn view
@@ -0,0 +1,13 @@+Did not plan to work on git-annex today..++Unexpectedly ended up making the webapp support HTTPS. Not by default,+but if a key and certificate are provided, it'll use them. Great for+using the webapp remotely! See the new tip: [[tips/remote_webapp_setup]].++Also removed support for --listen with a port, which was buggy and not+necessary with HTTPS.++Also fixed several webapp/assistant bugs, including one that let it be run in+a bare git repository.++And, made the quvi version be probed at runtime, rather than compile time.
+ doc/devblog/day_125__metadata_and_views.mdwn view
@@ -0,0 +1,11 @@+Worked on metadata and views. Besides bugfixes, two features of note:++Made git-annex run a hook script, pre-commit-annex. And I wrote a+sample script that extracts metadata from lots of kinds of files,+including photos and sound files, using extract(1) to do the heavy lifting.+See [[tips/automatically_adding_metadata]].++Views can be filtered to not include a tag or a field.+For example, `git annex view tag=* !old year!=2013`++Today's work was sponsored by Stephan Schulz
+ doc/devblog/day_128__release_prep.mdwn view
@@ -0,0 +1,27 @@+Preparing for a release (probably tomorrow or Friday).++Part of that was updating the autobuilders. Had to deal with the gnutls+security hole fix, and upgrading that on the OSX autobuilder turned out to+be quite complicated due to library version skew. Also, I switched the+linux autobuilders over to building from Debian unstable, rather than+stable. That should be ok to do now that the standalone build bundles all+the libraries it needs... And the arm build has always used unstable, and+has been reported working on a lot of systems. So I think this will be+safe, but have backed up the old autobuilder chroots just in case.++Also been catching up on bug reports and traffic and +and dealt with quite a lot of things today. Smarter log file+rotation for the assistant, better webapp behavior when git is not+installed, and a fix for the webdav 5 second timeout problem.++Perhaps the most interesting change is a new `annex.startupscan` setting,+which can be disabled to prevent the assistant from doing the expensive+startup scan. This means it misses noticing any files that changed since it+last run, but this should be useful for those really big repositories.++(Last night, did more work on the test suite, including even more checking+of merge conflict resolution.)++----++Today's work was sponsored by Michael Alan Dorman.
+ doc/devblog/day__126-127__merge_fixes.mdwn view
@@ -0,0 +1,61 @@+Yesterday I learned of a nasty bug in handling of merges in direct mode. It+turns out that if the remote repository has added a file, and there is a+conflicting file in the local work tree, which has not been added to git, the+local file was overwritten when git-annex did a merge. That's really bad, I'm+very unhappy this bug lurked undetected for so long.++Understanding the bug was easy. Fixing it turned out to be hard, because+the automatic merge conflict resolution code was quite a mess. In+particular, it wrote files to the work tree, which made it difficult for a+later stage to detect and handle the abovementioned case. Also, the+automatic merge resolution code had weird asymmetric structure that I never+fully understood, and generally needed to be stared at for an hour to begin+to understand it.++In the process of cleaning that up, I wrote several more tests,+to ensure that every case was handled correctly. Coverage was about 50%+of the cases, and should now be 100%.++To add to the fun, a while ago I had dealt with a bug on FAT/Windows where+it sometimes lost the symlink bit during automatic merge resolution. Except+it turned out my test case for it had a heisenbug, and I had not actually+fixed it (I think). In any case, my old fix for it was a large part+of the ugliness I was cleaning up, and had to be rewritten.+Fully tracking down and dealing with that took a large part of today.++Finally this evening, I added support for automatically handling merge+conflicts where one side is an annexed file, and the other side has the+same filename committed to git in the normal way. This is not an important+case, but it's worth it for completeness. There was an unexpected benefit+to doing it; it turned out that the weird asymmetric part of the code went+away.++The final core of the automatic merge conflict resolver has morphed from+a mess I'd not want to paste here to a quite consise and easy to follow+bit of code.++[[!format haskell """+        case (kus, kthem) of+                -- Both sides of conflict are annexed files+                (Just keyUs, Just keyThem) -> resolveby $+                        if keyUs == keyThem+                                then makelink keyUs+                                else do+                                        makelink keyUs+                                        makelink keyThem+                -- Our side is annexed file, other side is not.+                (Just keyUs, Nothing) -> resolveby $ do+                        graftin them file+                        makelink keyUs+                -- Our side is not annexed file, other side is.+                (Nothing, Just keyThem) -> resolveby $ do+                        graftin us file+                        makelink keyThem+                -- Neither side is annexed file; cannot resolve.+                (Nothing, Nothing) -> return Nothing+"""]]++Since the bug that started all this is so bad, I want to make a release+pretty soon.. But I will probably let it soak and whale on the test suite+a bit more first. (This bug is also probably worth backporting to old+versions of git-annex in eg Debian stable.)
+ doc/devblog/whither_XMPP.mdwn view
@@ -0,0 +1,30 @@+Pushed a release today. Rest of day spent beating head against Windows XMPP+brick wall.++Actually made a lot of progress -- Finally found the right approach, and+got a clean build of the XMPP haskell libraries. But.. ghc fails to+load the libraries when running Template Haskell. +"Misaligned section: 18206e5b".+Filed [a bug report](https://ghc.haskell.org/trac/ghc/ticket/8830), +and I'm sure this alignment problem can be fixed,+but I'm not hopeful about fixing it myself.++One workaround would be to use the EvilSplicer, building once without the+XMPP library linked in, to get the TH splices expanded, and then a second+time with the XMPP library and no TH. Made a `winsplicehack` branch with+tons of ifdefs that allows doing this. However, several dozen haskell libraries+would need to be patched to get it to work. I have the patches from+Android, but would rather avoid doing all that again on Windows.++Another workaround would be to move XMPP into a separate process from the+webapp. This is not very appealing either, the IPC between them would be+fairly complicated since the webapp does stuff like show lists of XMPP+buddies, etc. But, one thing this idea has to recommend it is I am already+considering using a separate helper daemon like this for+[[design/assistant/Telehash]].++So there could be synergies between XMPP and Telehash support, possibly+leading to some kind of plugin interface in git-annex for this sort of+thing. But then, once Telehash or something like it is available and+working well, I plan to deprecate XMPP entirely. It's been a flakey pain+from the start, so that can't come too soon.
+ doc/forum/Assistant_Droping_Files.mdwn view
@@ -0,0 +1,8 @@+I have a setup as follows,++3 drives on a remote ssh server regular git annex repos.+One untrusted clone of this repository on my laptop. ++On my laptop in webapp I have set num of copies to 2 (each file does have two copies on the server already). all repos plus laptop is set to manual mode. What happens is whenever I get a file to the laptop it would drop it from the disk on the server. Even though laptop is marked as untrusted this does not happen when using annex at the command line when I do a git annex get . --auto on the server it does not take the files on the untrusted repos into account which is what I want so I can drop files without moving them back to the server.++Is this the intended behavior or am I doing something wrong?
+ doc/forum/Auto_sync_with_music_player.mdwn view
@@ -0,0 +1,1 @@+I have a music directory under Nexus 5 which is a git-annex repository. If I sync the same with remote repository, newly added songs or modified songs(modifed id3 tags) will not sync with music player. But if I use Android File Transfer to transfer songs, it will sync music player. The songs which are transferred using git-annex will reflect in music player only after restart. Do we have to execute any command which will sync music player.
+ doc/forum/Feature_Request:_Sync_Now_Button_in_Webapp.mdwn view
@@ -0,0 +1,1 @@+One Problem I am having is that I could never get the xmpp pairing to work so whenever I switch machines I have to manually run sync once on the command line to get the changes. Is it possible to have a sync now button of some sort that will trigger a sync on the repos?
+ doc/forum/WARNING:_linker:git-annex_has_text_relocations....mdwn view
@@ -0,0 +1,7 @@+I have configured git-annex on my Nexus 5. Even though it works fantastic, it shows some warning messages.++1: 'git-annex sync' :  WARNING: linker: git-annex has text relocations. This is wasting memory and is a security risk. Please fix.++2: 'git log': error: cannot run less. No such file or directory.++Both the commands will work has expected with these warnings. What could be the issue here.
+ doc/forum/copy_fails_for_some_fails_without_explanation.mdwn view
@@ -0,0 +1,5 @@+I have a large direct-mode repository whose files I'm trying to copy to a non-direct-mode repository.  Both repositories live on an HDD attached to an rpi.++When I do $ git annex copy --to pi dirs/to/copy, the copy starts out OK, but eventually many files fail to copy.  The only diagnostic I get is "failed".  Judging from the backscroll, I don't see a strong pattern to the files which fail to copy; they're kind of interspersed amongst files which were successfully copied.  If I try to copy one of these failed files explicitly (git annex copy --to pi file/which/failed), this succeeds.  I have plenty of free space on the disk.++Is there a way to get more diagnostics out of git annex so I can see why these files are failing to copy?
doc/git-annex.mdwn view
@@ -307,12 +307,20 @@   By default, the webapp can only be accessed from localhost, and running   it opens a browser window. -  With the `--listen=address[:port]` option, the webapp can be made to listen-  for connections on the specified address. This disables running a-  local web browser, and outputs the url you can use to open the webapp-  from a remote computer.-  Note that this does not yet use HTTPS for security, so use with caution!+  To use the webapp on a remote computer, use the `--listen=address`+  option to specify the address the web server should listen on+  (or set annex.listen).+  This disables running a local web browser, and outputs the url you+  can use to open the webapp. +  When using the webapp on a remote computer, you'll almost certianly+  want to enable HTTPS. The webapp will use HTTPS if it finds+  a .git/annex/privkey.pem and .git/annex/certificate.pem. Here's+  one way to generate those files, using a self-signed certificate:++    openssl genrsa -out .git/annex/privkey.pem 4096+    openssl req -new -x509 -key .git/annex/privkey.pem > .git/annex/certificate.pem+ # REPOSITORY SETUP COMMANDS  * `init [description]`@@ -709,27 +717,30 @@    To remove a value, use -s field-=value. +  To set a value, only if the field does not already have 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 [tag ...] [field=value ...] [location/=value]`+* `view [tag ...] [field=value ...] [field=glob ...] [!tag ...] [field!=value ...]`    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.--  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.      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 such 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.+   There are fields corresponding to the path to the file. So a file   "foo/bar/baz/file" has fields "/=foo", "foo/=bar", and "foo/bar/=baz".   These location fields can be used the same as other metadata to construct@@ -746,12 +757,12 @@    The optional number tells how many views to pop. -* `vfilter [tag ...] [field=value ...] [location/=value]`+* `vfilter [tag ...] [field=value ...] [!tag ...] [field!=value ...]`    Filters the current view to only the files that have the-  specified field values, tags, and locations.+  specified field values and tags. -* `vadd [field=glob ...] [location/=glob]`+* `vadd [field=glob ...] [field=value ...] [tag ...]`    Changes the current view, adding an additional level of directories   to categorize the files.@@ -1369,6 +1380,19 @@   Set to false to prevent the git-annex assistant from automatically   committing changes to files in the repository. +* `annex.startupscan`++  Set to false to prevent the git-annex assistant from scanning the+  repository for new and changed files on startup. This will prevent it+  from noticing changes that were made while it was not running, but can be+  a useful performance tweak for a large repository.++* `annex.listen`++  Configures which address the webapp listens on. The default is localhost.+  Can be either an IP address, or a hostname that resolves to the desired+  address.+ * `annex.debug`    Set to true to enable debug logging by default.@@ -1663,6 +1687,10 @@  `~/.config/git-annex/autostart` is a list of git repositories to start the git-annex assistant in.++`.git/hooks/pre-commit-annex` in your git repsitory will be run whenever+a commit is made, either by git commit, git-annex sync, or the git-annex+assistant.  # SEE ALSO
doc/install/Fedora.mdwn view
@@ -1,5 +1,4 @@-git-annex is available in recent versions of Fedora. Although it is-not currently a very recent version, it should work ok.+git-annex is available in recent versions of Fedora. [status](http://koji.fedoraproject.org/koji/packageinfo?packageID=14145)  Should be as simple as: `yum install git-annex`
doc/install/fromscratch.mdwn view
@@ -41,6 +41,7 @@   * [wai](http://hackage.haskell.org/package/wai)   * [wai-logger](http://hackage.haskell.org/package/wai-logger)   * [warp](http://hackage.haskell.org/package/warp)+  * [warp-tls](http://hackage.haskell.org/package/warp-tls)   * [blaze-builder](http://hackage.haskell.org/package/blaze-builder)   * [crypto-api](http://hackage.haskell.org/package/crypto-api)   * [hamlet](http://hackage.haskell.org/package/hamlet)
doc/metadata.mdwn view
@@ -30,7 +30,8 @@   being.    To make git-annex automatically set the year and month when adding files,-run `git config annex.genmetadata true`+run `git config annex.genmetadata true`. Also, see+[[tips/automatically_adding_metadata]].  git-annex's metadata can be updated in a distributed fashion. For example, two users, each with their own clone of a repository, can set and unset
+ doc/news/version_5.20140306.mdwn view
@@ -0,0 +1,34 @@+git-annex 5.20140306 released with [[!toggle text="these changes"]]+[[!toggleable text="""+   * sync: Fix bug in direct mode that caused a file that was not+     checked into git to be deleted when there was a conflicting+     merge with a remote.+   * webapp: Now supports HTTPS.+   * webapp: No longer supports a port specified after --listen, since+     it was buggy, and that use case is better supported by setting up HTTPS.+   * annex.listen can be configured, instead of using --listen+   * annex.startupscan can be set to false to disable the assistant's startup+     scan.+   * Probe for quvi version at run time.+   * webapp: Filter out from Switch Repository list any+     repositories listed in autostart file that don't have a+     git directory anymore. (Or are bare)+   * webapp: Refuse to start in a bare git repository.+   * assistant --autostart: Refuse to start in a bare git repository.+   * webapp: Don't list the public repository group when editing a+     git repository; it only makes sense for special remotes.+   * view, vfilter: Add support for filtering tags and values out of a view,+     using !tag and field!=value.+   * vadd: Allow listing multiple desired values for a field.+   * view: Refuse to enter a view when no branch is currently checked out.+   * metadata: To only set a field when it's not already got a value, use+     -s field?=value+   * Run .git/hooks/pre-commit-annex whenever a commit is made.+   * sync: Automatically resolve merge conflict between and annexed file+     and a regular git file.+   * glacier: Pass --region to glacier checkpresent.+   * webdav: When built with a new enough haskell DAV (0.6), disable+     the http response timeout, which was only 5 seconds.+   * webapp: Include no-pty in ssh authorized\_keys lines.+   * assistant: Smarter log file rotation, which takes free disk space+     into account."""]]
doc/related_software.mdwn view
@@ -10,3 +10,4 @@ * [sizes](http://hackage.haskell.org/package/sizes) is another du-like   utility, with a `-A` switch that enables git-annex support. * Emacs Org mode can auto-commit attached files to git-annex.+* [git annex darktable integration](https://github.com/xxv/darktable-git-annex)
doc/tips/Internet_Archive_via_S3.mdwn view
@@ -15,8 +15,13 @@ the Internet Archive a nice way to publish the large files associated with a public git repository. -----+## webapp setup +Just go to "Add Another Repository", pick "Internet Archive",+and you're on your way.++## basic setup+ Sign up for an account, and get your access keys here: <http://www.archive.org/account/s3.php> 	@@ -40,7 +45,7 @@  Then you can annex files and copy them to the remote as usual: -	# git annex add photo1.jpeg --backend=SHA1E+	# git annex add photo1.jpeg --backend=SHA256E 	add photo1.jpeg (checksum...) ok 	# git annex copy photo1.jpeg --fast --to archive-panama 	copy (to archive-panama...) ok@@ -50,9 +55,31 @@ on archive.org. (It may take a while for archive.org to make the file publically visibile.) -Note the use of the SHA1E [[backend|backends]] when adding files. That is+Note the use of the SHA256E [[backend|backends]] when adding files. That is the default backend used by git-annex, but even if you don't normally use-it, it makes most sense to use the WORM or SHA1E backend for files that+it, it makes most sense to use the WORM or SHA256E backend for files that will be stored in the Internet Archive, since the key name will be exposed as the filename there, and since the Archive does special processing of files based on their extension.++## publishing only one subdirectory++Perhaps you have a repository with lots of files in it, and only want+to publish some of them to a particular Internet Archive item. Of course+you can specify which files to send manually, but it's useful to+configure [[preferred_content]] settings so git-annex knows what content+you want to store in the Internet Archive.++One way to do this is using the "public" repository type.++	git annex enableremote archive-panama preferreddir=panama+	git annex wanted archive-panama standard+	git annex group archive-panama public++Now anything in a "panama" directory will be sent to that remote,+and anything else won't. You can use `git annex copy --auto` or the+assistant and it'll do the right thing.++When setting up an Internet Archive item using the webapp, this+configuration is automatically done, using an item name that the user+enters as the name of the subdirectory.
+ doc/tips/automatically_adding_metadata.mdwn view
@@ -0,0 +1,24 @@+git-annex's [[metadata]] works best when files have a lot of useful+metadata attached to them.++To make git-annex automatically set the year and month when adding files,+run `git config annex.genmetadata true`.++A git commit hook can be set up to extract lots of metadata from files+like photos, mp3s, etc.++1. Install the `extract` utility, from <http://www.gnu.org/software/libextractor/>  +   `apt-get install extract`+2. Download [[pre-commit-annex]] and install it in your git-annex repository+   as `.git/hooks/pre-commit-annex`.  +   Remember to make the script executable!+3. Run: `git config metadata.extract "artist album title camera_make video_dimensions"`++Now any fields you list in metadata.extract to will be extracted and+stored when files are committed.++To get a list of all possible fields, run: `extract -L | sed ' ' _`++By default, if a git-annex already has a metadata field for a file,+its value will not be overwritten with metadata taken from files.+To allow overwriting, run: `git config metadata.overwrite true`
+ doc/tips/automatically_adding_metadata/pre-commit-annex view
@@ -0,0 +1,57 @@+#!/bin/sh+# This script can be used to add git-annex metadata to files when they're+# committed.+#+# Copyright 2014 Joey Hess <id@joeyh.name>+# License: GPL-3+++extract="$(git config metadata.extract || true)" +want="$(perl -e 'print (join("|", map {s/_/ /g; "^$_ - "} (split " ", shift())))' "$extract")"++if [ -z "$want" ]; then+	exit 0+fi++echo "$want"++case "$(git config --bool metadata.overwrite || true)" in+	true)+		overwrite=1+	;;+	*)+		overwrite=""+	;;+esac++addmeta () {+	file="$1"+	field="$2"+	value="$3"+	afield="$(echo "$field" | tr ' ' _)"+	if [ "$overwrite" ]; then+		p="$afield=$value"++	else+		p="$afield?=$value"+	fi+	git -c annex.alwayscommit=false annex metadata "$file" -s "$p" --quiet+}++if git rev-parse --verify HEAD >/dev/null 2>&1; then+	against=HEAD+else+	# Initial commit: diff against an empty tree object+	against=4b825dc642cb6eb9a060e54bf8d69288fbee4904+fi++IFS="+"+for f in $(git diff-index --name-only --cached $against); do+	if [ -e "$f" ]; then+		for l in $(extract "$f" | egrep "$want"); do+			field="${l%% - *}"+			value="${l#* - }"+			addmeta "$f" "$field" "$value"+		done+	fi+done
+ doc/tips/remote_webapp_setup.mdwn view
@@ -0,0 +1,49 @@+Here's the scenario: You have a remote server you can ssh into,+and you want to use the git-annex webapp there, displaying back on your local+web browser.++Sure, no problem! It can even be done securely!++Let's start by making the git-annex repository on the remote server.++	git init annex+	cd annex+	git annex init++Now, you need to generate a private key and a certificate for HTTPS.+These files are stored in `.git/annex/privkey.pem` and +`.git/annex/certificate.pem` inside the git repository. Here's+one way to generate those files, using a self-signed certificate:++	(umask 077 ; openssl genrsa -out .git/annex/privkey.pem 4096)+	openssl req -new -x509 -key .git/annex/privkey.pem > .git/annex/certificate.pem++With those files in place, git-annex will automatically only accept HTTPS+connections. That's good, since HTTP connections are not secure over the+big bad internet.++All that remains is to make the webapp listen on the external interface+of the server. Normally, for security, git-annex only listens on localhost.+Tell it what hostname to listen on:++	git config annex.listen host.example.com++(If your hostname doesn't work, its IP address certianly will..)++When you run the webapp configured like that, it'll print out the+URL to use to open it. You can paste that into your web browser.++	git annex webapp+	http://host.example.com:42232/?auth=ea7857ad...++Notice that the URL has a big jumble of letters at the end -- this is a+secret token that the webapp uses to verify you're you. So random attackers+can't find your webapp and do bad things with it.++If you like, you can make the server run `git annex assistant --autostart`+on boot.++To automate opening the remote server's webapp in your local browser,+just run this:++	firefox "$(ssh host.example.com git annex webapp)"
+ doc/todo/custom_f-droid_repo.mdwn view
@@ -0,0 +1,3 @@+It would be great to have a custom f-droid repo "alla guardianproject.info" (before getting git-annex into the main f-droid repo).++See https://github.com/guardianproject/fdroid-repo (https://guardianproject.info/repo/).
+ doc/todo/required_content.mdwn view
@@ -0,0 +1,7 @@+We have preferred content, which is advisory, and numcopies, which is+enforced (except by `git annex move`). What is missing is an expression+like preferred content, which is enforced. So, required content.++For example, I might want a repository that is required to contain+`*.jpeg`. This would make get --auto get it (it's implicitly part of the+preferred content), and would make drop refuse to drop it.
doc/todo/windows_support.mdwn view
@@ -40,6 +40,13 @@   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)+* user feedback: "Git on windows installer provides openssh 4.6. git-annex installer+  provides openssh 6.2 . This seems to create problems regarding how+  `known_hosts` file path is setup. Setting `GIT_SSH=` to the git-annex+  openssh version fixes the problem."  +  However, I don't know how to determine what that location is after+  it's been installed. Maybe look for ssh.exe in same directory as+  git-annex.exe? --[[Joey]]  ## stuff needing testing @@ -49,15 +56,38 @@  ## trying to build XMPP -1. gnutls-$LATEST.zip from <http://josefsson.org/gnutls4win/>+Lots of library deps:++1. gsasl-$LATEST.zip from <http://josefsson.org/gnutls4win/> (includes+   gnuidn and gnutls) 2. pkg-config from    <http://sourceforge.net/projects/pkgconfiglite/files/latest/download?source=files> 3. libxml2 from mingw:    <http://sourceforge.net/projects/mingw/files/MSYS/Extension/libxml2/libxml2-2.7.6-1/>    both the -dll and the -dev-3. gsasl from <ftp://alpha.gnu.org/gnu/gsasl/>-3. gnuidn from <ftp://ftp.gnu.org/gnu/libidn/libidn-1.28-win32.zip> 3. Extract all the above into the Haskell platform's mingw directory. Note    that pkg-config needs to be moved out of a named subdirectory.-4. Run in DOS prompt (not cygwin!): cabal install gnutls libxml-sax gsasl gnuidn network-protocol-xmpp+4. Run in DOS prompt (not cygwin!): cabal install network-protocol-xmpp +Current FAIL:++<pre>+Loading package gnutls-0.1.5 ... ghc.exe: internal error: Misaligned section: 18206e5b+    (GHC version 7.6.3 for i386_unknown_mingw32)+        Please report this as a GHC bug:+	http://www.haskell.org/ghc/reportabug+</pre>++<https://ghc.haskell.org/trac/ghc/ticket/8830>++Note: This only happens in the TH link stage. So building w/o the webapp+works with XMPP.++Options:++1. Use EvilSplicer, building first without XMPP library, but with its UI,+   and a second time without TH, but with the XMPP library. Partially done+   on the `winsplicehack` branch, but requires building patched versions+   of lots of yesod dependency chain to export modules referenced by TH+   splices, like had to be done on Android. Horrible pain. Ugly as hell.+2. Make a helper program with the XMPP support in it, that does not use TH.
git-annex.1 view
@@ -284,12 +284,20 @@ By default, the webapp can only be accessed from localhost, and running it opens a browser window. .IP-With the \fB\-\-listen=address[:port]\fP option, the webapp can be made to listen-for connections on the specified address. This disables running a-local web browser, and outputs the url you can use to open the webapp-from a remote computer.-Note that this does not yet use HTTPS for security, so use with caution!+To use the webapp on a remote computer, use the \fB\-\-listen=address\fP+option to specify the address the web server should listen on+(or set annex.listen).+This disables running a local web browser, and outputs the url you+can use to open the webapp. .IP+When using the webapp on a remote computer, you'll almost certianly+want to enable HTTPS. The webapp will use HTTPS if it finds+a .git/annex/privkey.pem and .git/annex/certificate.pem. Here's+one way to generate those files, using a self\-signed certificate:+.IP+openssl genrsa \-out .git/annex/privkey.pem 4096+openssl req \-new \-x509 \-key .git/annex/privkey.pem > .git/annex/certificate.pem+.IP .SH REPOSITORY SETUP COMMANDS .IP "\fBinit [description]\fP" .IP@@ -654,26 +662,29 @@ .IP To remove a value, use \-s field\-=value. .IP+To set a value, only if the field does not already have 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 [tag ...] [field=value ...] [location/=value]\fP"+.IP "\fBview [tag ...] [field=value ...] [field=glob ...] [!tag ...] [field!=value ...]\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-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 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 such 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 There are fields corresponding to the path to the file. So a file "foo/bar/baz/file" has fields "/=foo", "foo/=bar", and "foo/bar/=baz". These location fields can be used the same as other metadata to construct@@ -689,11 +700,11 @@ .IP The optional number tells how many views to pop. .IP-.IP "\fBvfilter [tag ...] [field=value ...] [location/=value]\fP"+.IP "\fBvfilter [tag ...] [field=value ...] [!tag ...] [field!=value ...]\fP" Filters the current view to only the files that have the-specified field values, tags, and locations.+specified field values and tags. .IP-.IP "\fBvadd [field=glob ...] [location/=glob]\fP"+.IP "\fBvadd [field=glob ...] [field=value ...] [tag ...]\fP" Changes the current view, adding an additional level of directories to categorize the files. .IP@@ -1234,6 +1245,17 @@ Set to false to prevent the git\-annex assistant from automatically committing changes to files in the repository. .IP+.IP "\fBannex.startupscan\fP"+Set to false to prevent the git\-annex assistant from scanning the+repository for new and changed files on startup. This will prevent it+from noticing changes that were made while it was not running, but can be+a useful performance tweak for a large repository.+.IP+.IP "\fBannex.listen\fP"+Configures which address the webapp listens on. The default is localhost.+Can be either an IP address, or a hostname that resolves to the desired+address.+.IP .IP "\fBannex.debug\fP" Set to true to enable debug logging by default. .IP@@ -1487,6 +1509,10 @@ .PP \fB~/.config/git\-annex/autostart\fP is a list of git repositories to start the git\-annex assistant in.+.PP+\fB.git/hooks/pre\-commit\-annex\fP in your git repsitory will be run whenever+a commit is made, either by git commit, git\-annex sync, or the git\-annex+assistant. .PP .SH SEE ALSO Most of git\-annex's documentation is available on its web site,
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 5.20140227+Version: 5.20140306 Cabal-Version: >= 1.8 License: GPL-3 Maintainer: Joey Hess <joey@kitenet.net>@@ -176,7 +176,7 @@   if flag(Webapp)     Build-Depends:      yesod, yesod-default, yesod-static, yesod-form, yesod-core,-     http-types, transformers, wai, wai-logger, warp,+     http-types, transformers, wai, wai-logger, warp, warp-tls,      blaze-builder, crypto-api, hamlet, clientsession,      template-haskell, data-default, aeson, network-conduit     CPP-Options: -DWITH_WEBAPP
standalone/windows/build.sh view
@@ -28,7 +28,7 @@  # Don't allow build artifact from a past successful build to be extracted # if we fail.-#rm -f git-annex-installer.exe+rm -f git-annex-installer.exe  # Install haskell dependencies. # cabal install is not run in cygwin, because we don't want configure scripts