Record git-annex (5.20140717) in archive suite sid

.gitattributes

@@ -1 +0,0 @@
-debian/changelog merge=dpkg-mergechangelogs

.gitignore

@@ -1,34 +0,0 @@
-tags
-Setup
-*.hi
-*.o
-tmp
-test
-build-stamp
-Build/SysConfig.hs
-Build/InstallDesktopFile
-Build/EvilSplicer
-Build/Standalone
-Build/OSXMkLibs
-Build/LinuxMkLibs
-git-annex
-git-annex.1
-git-annex-shell.1
-git-union-merge
-git-union-merge.1
-doc/.ikiwiki
-html
-*.tix
-.hpc
-dist
-# Sandboxed builds
-cabal-dev
-.cabal-sandbox
-cabal.sandbox.config
-cabal.config
-# Project-local emacs configuration
-.dir-locals.el
-# OSX related
-.DS_Store
-.virthualenv
-.tasty-rerun-log

Annex/AutoMerge.hs

@@ -5,19 +5,23 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Annex.AutoMerge (autoMergeFrom) where
+module Annex.AutoMerge
+	( autoMergeFrom
+	, resolveMerge
+	, commitResolvedMerge
+	) 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
+import qualified Git.Branch
 import Git.Types (BlobType(..))
 import Config
 import Annex.ReplaceFile
@@ -28,18 +32,22 @@ import qualified Data.Set as S
 
 {- Merges from a branch into the current branch
  - (which may not exist yet),
- - with automatic merge conflict resolution. -}
+ - with automatic merge conflict resolution.
-autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Annex Bool
+ -
-autoMergeFrom branch currbranch = do
+ - Callers should use Git.Branch.changed first, to make sure that
+ - there are changed from the current branch to the branch being merged in.
+ -}
+autoMergeFrom :: Git.Ref -> (Maybe Git.Ref) -> Git.Branch.CommitMode -> Annex Bool
+autoMergeFrom branch currbranch commitmode = do
 	showOutput
 	case currbranch of
 		Nothing -> go Nothing
 		Just b -> go =<< inRepo (Git.Ref.sha b)
   where
 	go old = ifM isDirect
-		( mergeDirect currbranch old branch (resolveMerge old branch)
+		( mergeDirect currbranch old branch (resolveMerge old branch) commitmode
-		, inRepo (Git.Merge.mergeNonInteractive branch)
+		, inRepo (Git.Merge.mergeNonInteractive branch commitmode)
-			<||> (resolveMerge old branch <&&> commitResolvedMerge)
+			<||> (resolveMerge old branch <&&> commitResolvedMerge commitmode)
 		)
 
 {- Resolves a conflicted merge. It's important that any conflicts be
@@ -106,11 +114,11 @@ resolveMerge' (Just us) them u = do
 				makelink keyUs
 		-- Our side is annexed file, other side is not.
 		(Just keyUs, Nothing) -> resolveby $ do
-			graftin them file
+			graftin them file LsFiles.valThem LsFiles.valThem
 			makelink keyUs
 		-- Our side is not annexed file, other side is.
 		(Nothing, Just keyThem) -> resolveby $ do
-			graftin us file
+			graftin us file LsFiles.valUs LsFiles.valUs
 			makelink keyThem
 		-- Neither side is annexed file; cannot resolve.
 		(Nothing, Nothing) -> return Nothing
@@ -127,17 +135,41 @@ resolveMerge' (Just us) them u = do
 	makelink key = do
 		let dest = variantFile file key
 		l <- inRepo $ gitAnnexLink dest key
-		ifM isDirect
+		replacewithlink dest l
-			( 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 -}
+	replacewithlink dest link = ifM isDirect
-	graftin b item = Annex.Queue.addUpdateIndex
+		( do
-		=<< fromRepo (UpdateIndex.lsSubTree b item)
+			d <- fromRepo gitAnnexMergeDir
+			replaceFile (d </> dest) $ makeGitLink link
+		, replaceFile dest $ makeGitLink link
+		)
+
+	{- Stage a graft of a directory or file from a branch.
+	 -
+	 - When there is a conflicted merge where one side is a directory
+	 - or file, and the other side is a symlink, git merge always
+	 - updates the work tree to contain the non-symlink. So, the
+	 - directory or file will already be in the work tree correctly,
+	 - and they just need to be staged into place. Do so by copying the
+	 - index. (Note that this is also better than calling git-add
+	 - because on a crippled filesystem, it preserves any symlink
+	 - bits.)
+	 -
+	 - It's also possible for the branch to have a symlink in it,
+	 - which is not a git-annex symlink. In this special case,
+	 - git merge does not update the work tree to contain the symlink
+	 - from the branch, so we have to do so manually.
+	 -}
+	graftin b item select select' = do
+		Annex.Queue.addUpdateIndex
+			=<< fromRepo (UpdateIndex.lsSubTree b item)
+		when (select (LsFiles.unmergedBlobType u) == Just SymlinkBlob) $
+			case select' (LsFiles.unmergedSha u) of
+				Nothing -> noop
+				Just sha -> do
+					link <- catLink True sha
+					replacewithlink item link
 		
 	resolveby a = do
 		{- Remove conflicted file from index so merge can be resolved. -}
@@ -146,7 +178,7 @@ resolveMerge' (Just us) them u = do
 		return (Just file)
 
 {- git-merge moves conflicting files away to files
- - named something like f~HEAD or f~branch, but the
+ - named something like f~HEAD or f~branch or just f, 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
@@ -163,13 +195,12 @@ cleanConflictCruft resolvedfs top = do
 			liftIO $ nukeFile f
 		| otherwise = noop
 	s = S.fromList resolvedfs
-	matchesresolved f = S.member (base f) s
+	matchesresolved f = S.member f s || S.member (base f) s
 	base f = reverse $ drop 1 $ dropWhile (/= '~') $ reverse f
 	
-commitResolvedMerge :: Annex Bool
+commitResolvedMerge :: Git.Branch.CommitMode -> Annex Bool
-commitResolvedMerge = inRepo $ Git.Command.runBool
+commitResolvedMerge commitmode = inRepo $ Git.Branch.commitCommand commitmode
-	[ Param "commit"
+	[ Param "--no-verify"
-	, Param "--no-verify"
 	, Param "-m"
 	, Param "git-annex automatic merge conflict fix"
 	]

Annex/Branch.hs

@@ -92,7 +92,7 @@ getBranch = maybe (hasOrigin >>= go >>= use) return =<< branchsha
 		fromMaybe (error $ "failed to create " ++ fromRef name)
 			<$> branchsha
 	go False = withIndex' True $
-		inRepo $ Git.Branch.commitAlways "branch created" fullname []
+		inRepo $ Git.Branch.commitAlways Git.Branch.AutomaticCommit "branch created" fullname []
 	use sha = do
 		setIndexSha sha
 		return sha
@@ -252,7 +252,7 @@ commitIndex jl branchref message parents = do
 commitIndex' :: JournalLocked -> Git.Ref -> String -> [Git.Ref] -> Annex ()
 commitIndex' jl branchref message parents = do
 	updateIndex jl branchref
-	committedref <- inRepo $ Git.Branch.commitAlways message fullname parents
+	committedref <- inRepo $ Git.Branch.commitAlways Git.Branch.AutomaticCommit message fullname parents
 	setIndexSha committedref
 	parentrefs <- commitparents <$> catObject committedref
 	when (racedetected branchref parentrefs) $
@@ -389,19 +389,40 @@ stageJournal jl = withIndex $ do
 	prepareModifyIndex jl
 	g <- gitRepo
 	let dir = gitAnnexJournalDir g
-	fs <- getJournalFiles jl
+	(jlogf, jlogh) <- openjlog
-	liftIO $ do
+	withJournalHandle $ \jh -> do
 		h <- hashObjectStart g
 		Git.UpdateIndex.streamUpdateIndex g
-			[genstream dir h fs]
+			[genstream dir h jh jlogh]
 		hashObjectStop h
-	return $ liftIO $ mapM_ (removeFile . (dir </>)) fs
+	return $ cleanup dir jlogh jlogf
   where
-	genstream dir h fs streamer = forM_ fs $ \file -> do
+	genstream dir h jh jlogh streamer = do
-		let path = dir </> file
+		v <- readDirectory jh
-		sha <- hashFile h path
+		case v of
-		streamer $ Git.UpdateIndex.updateIndexLine
+			Nothing -> return ()
-			sha FileBlob (asTopFilePath $ fileJournal file)
+			Just file -> do
+				unless (dirCruft file) $ do
+					let path = dir </> file
+					sha <- hashFile h path
+					hPutStrLn jlogh file
+					streamer $ Git.UpdateIndex.updateIndexLine
+						sha FileBlob (asTopFilePath $ fileJournal file)
+				genstream dir h jh jlogh streamer
+	-- Clean up the staged files, as listed in the temp log file.
+	-- The temp file is used to avoid needing to buffer all the
+	-- filenames in memory.
+	cleanup dir jlogh jlogf = do
+		hFlush jlogh
+		hSeek jlogh AbsoluteSeek 0
+		stagedfs <- lines <$> hGetContents jlogh
+		mapM_ (removeFile . (dir </>)) stagedfs
+		hClose jlogh
+		nukeFile jlogf
+	openjlog = do
+		tmpdir <- fromRepo gitAnnexTmpMiscDir
+		createAnnexDirectory tmpdir
+		liftIO $ openTempFile tmpdir "jlog"
 
 {- This is run after the refs have been merged into the index,
  - but before the result is committed to the branch.
@@ -471,7 +492,7 @@ performTransitionsLocked jl ts neednewlocalbranch transitionedrefs = do
 		Annex.Queue.flush
 		if neednewlocalbranch
 			then do
-				committedref <- inRepo $ Git.Branch.commitAlways message fullname transitionedrefs
+				committedref <- inRepo $ Git.Branch.commitAlways Git.Branch.AutomaticCommit message fullname transitionedrefs
 				setIndexSha committedref
 			else do
 				ref <- getBranch

Annex/CatFile.hs

@@ -15,6 +15,7 @@ module Annex.CatFile (
 	catKey,
 	catKeyFile,
 	catKeyFileHEAD,
+	catLink,
 ) where
 
 import qualified Data.ByteString.Lazy as L
@@ -77,21 +78,25 @@ catFileHandle = do
 catKey :: Ref -> FileMode -> Annex (Maybe Key)
 catKey = catKey' True
 
-catKey' :: Bool -> Ref -> FileMode -> Annex (Maybe Key)
+catKey' :: Bool -> Sha -> FileMode -> Annex (Maybe Key)
-catKey' modeguaranteed ref mode
+catKey' modeguaranteed sha mode
 	| isSymLink mode = do
-		l <- fromInternalGitPath . decodeBS <$> get
+		l <- catLink modeguaranteed sha
 		return $ if isLinkToAnnex l
 			then fileKey $ takeFileName l
 			else Nothing
 	| otherwise = return Nothing
+
+{- Gets a symlink target. -}
+catLink :: Bool -> Sha -> Annex String
+catLink modeguaranteed sha = fromInternalGitPath . decodeBS <$> get
   where
   	-- If the mode is not guaranteed to be correct, avoid
 	-- buffering the whole file content, which might be large.
 	-- 8192 is enough if it really is a symlink.
   	get
-		| modeguaranteed = catObject ref
+		| modeguaranteed = catObject sha
-		| otherwise = L.take 8192 <$> catObject ref
+		| otherwise = L.take 8192 <$> catObject sha
 
 {- Looks up the key corresponding to the Ref using the running cat-file.
  -

Annex/Content.hs

@@ -218,7 +218,7 @@ getViaTmpUnchecked = finishGetViaTmp (return True)
 
 getViaTmpChecked :: Annex Bool -> Key -> (FilePath -> Annex Bool) -> Annex Bool
 getViaTmpChecked check key action = 
-	prepGetViaTmpChecked key $
+	prepGetViaTmpChecked key False $
 		finishGetViaTmp check key action
 
 {- Prepares to download a key via a tmp file, and checks that there is
@@ -229,8 +229,8 @@ getViaTmpChecked check key action =
  -
  - Wen there's enough free space, runs the download action.
  -}
-prepGetViaTmpChecked :: Key -> Annex Bool -> Annex Bool
+prepGetViaTmpChecked :: Key -> a -> Annex a -> Annex a
-prepGetViaTmpChecked key getkey = do
+prepGetViaTmpChecked key unabletoget getkey = do
 	tmp <- fromRepo $ gitAnnexTmpObjectLocation key
 
 	e <- liftIO $ doesFileExist tmp
@@ -242,7 +242,7 @@ prepGetViaTmpChecked key getkey = do
 			-- The tmp file may not have been left writable
 			when e $ thawContent tmp
 			getkey
-		, return False
+		, return unabletoget
 		)
 
 finishGetViaTmp :: Annex Bool -> Key -> (FilePath -> Annex Bool) -> Annex Bool

Annex/Direct.hs

@@ -36,6 +36,7 @@ import Annex.Exception
 import Annex.VariantFile
 import Git.Index
 import Annex.Index
+import Annex.LockFile
 
 {- 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. -}
@@ -150,13 +151,16 @@ addDirect file cache = do
  - directory, and the merge is staged into a copy of the index.
  - Then the work tree is updated to reflect the merge, and
  - finally, the merge is committed and the real index updated.
+ -
+ - A lock file is used to avoid races with any other caller of mergeDirect.
+ - 
+ - To avoid other git processes from making change to the index while our
+ - merge is in progress, the index lock file is used as the temp index
+ - file. This is the same as what git does when updating the index
+ - normally.
  -}
-mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> Annex Bool
+mergeDirect :: Maybe Git.Ref -> Maybe Git.Ref -> Git.Branch -> Annex Bool -> Git.Branch.CommitMode -> Annex Bool
-mergeDirect startbranch oldref branch resolvemerge = do
+mergeDirect startbranch oldref branch resolvemerge commitmode = exclusively $ do
-	-- Use the index lock file as the temp index file.
-	-- This is actually what git does when updating the index,
-	-- and so it will prevent other git processes from making
-	-- any changes to the index while our merge is in progress.
 	reali <- fromRepo indexFile
 	tmpi <- fromRepo indexFileLock
 	liftIO $ copyFile reali tmpi
@@ -168,19 +172,23 @@ mergeDirect startbranch oldref branch resolvemerge = do
 		createDirectoryIfMissing True d
 
 	withIndexFile tmpi $ do
-		merged <- stageMerge d branch
+		merged <- stageMerge d branch commitmode
 		r <- if merged
 			then return True
 			else resolvemerge
 		mergeDirectCleanup d (fromMaybe Git.Sha.emptyTree oldref)
-		mergeDirectCommit merged startbranch branch
+		mergeDirectCommit merged startbranch branch commitmode
+
 		liftIO $ rename tmpi reali
+
 		return r
+  where
+	exclusively = withExclusiveLock gitAnnexMergeLock
 
 {- Stage a merge into the index, avoiding changing HEAD or the current
  - branch. -}
-stageMerge :: FilePath -> Git.Branch -> Annex Bool
+stageMerge :: FilePath -> Git.Branch -> Git.Branch.CommitMode -> Annex Bool
-stageMerge d branch = do
+stageMerge d branch commitmode = do
 	-- XXX A bug in git makes stageMerge unsafe to use if the git repo
 	-- is configured with core.symlinks=false
 	-- Using mergeNonInteractive is not ideal though, since it will
@@ -190,7 +198,7 @@ stageMerge d branch = do
 	-- <http://marc.info/?l=git&m=140262402204212&w=2>
 	merger <- ifM (coreSymlinks <$> Annex.getGitConfig)
 		( return Git.Merge.stageMerge
-		, return Git.Merge.mergeNonInteractive
+		, return $ \ref -> Git.Merge.mergeNonInteractive ref commitmode
 		) 
 	inRepo $ \g -> merger branch $ 
 		g { location = Local { gitdir = Git.localGitDir g, worktree = Just d } }
@@ -198,8 +206,8 @@ stageMerge d branch = do
 {- Commits after a direct mode merge is complete, and after the work
  - tree has been updated by mergeDirectCleanup.
  -}
-mergeDirectCommit :: Bool -> Maybe Git.Ref -> Git.Branch -> Annex ()
+mergeDirectCommit :: Bool -> Maybe Git.Ref -> Git.Branch -> Git.Branch.CommitMode -> Annex ()
-mergeDirectCommit allowff old branch = do
+mergeDirectCommit allowff old branch commitmode = do
 	void preCommitDirect
 	d <- fromRepo Git.localGitDir
 	let merge_head = d </> "MERGE_HEAD"
@@ -211,7 +219,7 @@ mergeDirectCommit allowff old branch = do
 			msg <- liftIO $
 				catchDefaultIO ("merge " ++ fromRef branch) $
 					readFile merge_msg
-			void $ inRepo $ Git.Branch.commit False msg
+			void $ inRepo $ Git.Branch.commit commitmode False msg
 				Git.Ref.headRef [Git.Ref.headRef, branch]
 		)
 	liftIO $ mapM_ nukeFile [merge_head, merge_msg, merge_mode]
@@ -346,7 +354,11 @@ toDirectGen k f = do
 		void $ addAssociatedFile k f
 		modifyContent loc $ do
 			thawContent loc
-			replaceFile f $ liftIO . moveFile loc
+			replaceFileOr f
+				(liftIO . moveFile loc)
+				$ \tmp -> do -- rollback
+					liftIO (moveFile tmp loc)
+					freezeContent loc
 	fromdirect loc = do
 		replaceFile f $
 			liftIO . void . copyFileExternal loc

Annex/Journal.hs

@@ -17,10 +17,7 @@ import Common.Annex
 import Annex.Exception
 import qualified Git
 import Annex.Perms
-
+import Annex.LockFile
-#ifdef mingw32_HOST_OS
-import Utility.WinLock
-#endif
 
 {- Records content for a file in the branch to the journal.
  -
@@ -80,9 +77,18 @@ getJournalFilesStale = do
 		getDirectoryContents $ gitAnnexJournalDir g
 	return $ filter (`notElem` [".", ".."]) fs
 
+withJournalHandle :: (DirectoryHandle -> IO a) -> Annex a
+withJournalHandle a = do
+	d <- fromRepo gitAnnexJournalDir
+	bracketIO (openDirectory d) closeDirectory (liftIO . a)
+
 {- Checks if there are changes in the journal. -}
 journalDirty :: Annex Bool
-journalDirty = not . null <$> getJournalFilesStale
+journalDirty = do
+	d <- fromRepo gitAnnexJournalDir
+	liftIO $ 
+		(not <$> isDirectoryEmpty d)
+			`catchIO` (const $ doesDirectoryExist d)
 
 {- Produces a filename to use in the journal for a file on the branch.
  -
@@ -112,19 +118,4 @@ data JournalLocked = ProduceJournalLocked
 {- Runs an action that modifies the journal, using locking to avoid
  - contention with other git-annex processes. -}
 lockJournal :: (JournalLocked -> Annex a) -> Annex a
-lockJournal a = do
+lockJournal a = withExclusiveLock gitAnnexJournalLock $ a ProduceJournalLocked
-	lockfile <- fromRepo gitAnnexJournalLock
-	createAnnexDirectory $ takeDirectory lockfile
-	mode <- annexFileMode
-	bracketIO (lock lockfile mode) unlock (const $ a ProduceJournalLocked)
-  where
-#ifndef mingw32_HOST_OS
-	lock lockfile mode = do
-		l <- noUmask mode $ createFile lockfile mode
-		waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
-		return l
-	unlock = closeFd
-#else
-	lock lockfile _mode = waitToLock $ lockExclusive lockfile
-	unlock = dropLock
-#endif

Annex/Link.hs

@@ -68,6 +68,9 @@ getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
 					then ""
 					else s
 
+makeAnnexLink :: LinkTarget -> FilePath -> Annex ()
+makeAnnexLink = makeGitLink
+
 {- Creates a link on disk.
  -
  - On a filesystem that does not support symlinks, writes the link target
@@ -75,8 +78,8 @@ getAnnexLinkTarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
  - it's staged as such, so use addAnnexLink when adding a new file or
  - modified link to git.
  -}
-makeAnnexLink :: LinkTarget -> FilePath -> Annex ()
+makeGitLink :: LinkTarget -> FilePath -> Annex ()
-makeAnnexLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
+makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
 	( liftIO $ do
 		void $ tryIO $ removeFile file
 		createSymbolicLink linktarget file

Annex/LockFile.hs

@@ -0,0 +1,87 @@
+{- git-annex lock files.
+ -
+ - Copyright 2012, 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Annex.LockFile (
+	lockFileShared,
+	unlockFile,
+	getLockPool,
+	withExclusiveLock,
+) where
+
+import Common.Annex
+import Annex
+import Types.LockPool
+import qualified Git
+import Annex.Exception
+import Annex.Perms
+
+import qualified Data.Map as M
+
+#ifdef mingw32_HOST_OS
+import Utility.WinLock
+#endif
+
+{- Create a specified lock file, and takes a shared lock, which is retained
+ - in the pool. -}
+lockFileShared :: FilePath -> Annex ()
+lockFileShared file = go =<< fromLockPool file
+  where
+	go (Just _) = noop -- already locked
+	go Nothing = do
+#ifndef mingw32_HOST_OS
+		mode <- annexFileMode
+		lockhandle <- liftIO $ noUmask mode $
+			openFd file ReadOnly (Just mode) defaultFileFlags
+		liftIO $ waitToSetLock lockhandle (ReadLock, AbsoluteSeek, 0, 0)
+#else
+		lockhandle <- liftIO $ waitToLock $ lockShared file
+#endif
+		changeLockPool $ M.insert file lockhandle
+
+unlockFile :: FilePath -> Annex ()
+unlockFile file = maybe noop go =<< fromLockPool file
+  where
+	go lockhandle = do
+#ifndef mingw32_HOST_OS
+		liftIO $ closeFd lockhandle
+#else
+		liftIO $ dropLock lockhandle
+#endif
+		changeLockPool $ M.delete file
+
+getLockPool :: Annex LockPool
+getLockPool = getState lockpool
+
+fromLockPool :: FilePath -> Annex (Maybe LockHandle)
+fromLockPool file = M.lookup file <$> getLockPool
+
+changeLockPool :: (LockPool -> LockPool) -> Annex ()
+changeLockPool a = do
+	m <- getLockPool
+	changeState $ \s -> s { lockpool = a m }
+
+{- Runs an action with an exclusive lock held. If the lock is already
+ - held, blocks until it becomes free. -}
+withExclusiveLock :: (Git.Repo -> FilePath) -> Annex a -> Annex a
+withExclusiveLock getlockfile a = do
+	lockfile <- fromRepo getlockfile
+	createAnnexDirectory $ takeDirectory lockfile
+	mode <- annexFileMode
+	bracketIO (lock lockfile mode) unlock (const a)
+  where
+#ifndef mingw32_HOST_OS
+	lock lockfile mode = do
+		l <- noUmask mode $ createFile lockfile mode
+		waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
+		return l
+	unlock = closeFd
+#else
+	lock lockfile _mode = waitToLock $ lockExclusive lockfile
+	unlock = dropLock
+#endif

Annex/LockPool.hs

@@ -1,60 +0,0 @@
-{- git-annex lock pool
- -
- - Copyright 2012, 2014 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE CPP #-}
-
-module Annex.LockPool where
-
-import Common.Annex
-import Annex
-import Types.LockPool
-
-import qualified Data.Map as M
-
-#ifndef mingw32_HOST_OS
-import Annex.Perms
-#else
-import Utility.WinLock
-#endif
-
-{- Create a specified lock file, and takes a shared lock. -}
-lockFile :: FilePath -> Annex ()
-lockFile file = go =<< fromPool file
-  where
-	go (Just _) = noop -- already locked
-	go Nothing = do
-#ifndef mingw32_HOST_OS
-		mode <- annexFileMode
-		lockhandle <- liftIO $ noUmask mode $
-			openFd file ReadOnly (Just mode) defaultFileFlags
-		liftIO $ waitToSetLock lockhandle (ReadLock, AbsoluteSeek, 0, 0)
-#else
-		lockhandle <- liftIO $ waitToLock $ lockShared file
-#endif
-		changePool $ M.insert file lockhandle
-
-unlockFile :: FilePath -> Annex ()
-unlockFile file = maybe noop go =<< fromPool file
-  where
-	go lockhandle = do
-#ifndef mingw32_HOST_OS
-		liftIO $ closeFd lockhandle
-#else
-		liftIO $ dropLock lockhandle
-#endif
-		changePool $ M.delete file
-
-getPool :: Annex LockPool
-getPool = getState lockpool
-
-fromPool :: FilePath -> Annex (Maybe LockHandle)
-fromPool file = M.lookup file <$> getPool
-
-changePool :: (LockPool -> LockPool) -> Annex ()
-changePool a = do
-	m <- getPool
-	changeState $ \s -> s { lockpool = a m }

Annex/MakeRepo.hs

@@ -0,0 +1,88 @@
+{- making local repositories (used by webapp mostly)
+ -
+ - Copyright 2012-2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.MakeRepo where
+
+import Assistant.WebApp.Common
+import Annex.Init
+import qualified Git.Construct
+import qualified Git.Config
+import qualified Git.Command
+import qualified Git.Branch
+import qualified Annex
+import Annex.UUID
+import Annex.Direct
+import Types.StandardGroups
+import Logs.PreferredContent
+import qualified Annex.Branch
+
+{- Makes a new git repository. Or, if a git repository already
+ - exists, returns False. -}
+makeRepo :: FilePath -> Bool -> IO Bool
+makeRepo path bare = ifM (probeRepoExists path)
+	( return False
+	, do
+		(transcript, ok) <-
+			processTranscript "git" (toCommand params) Nothing
+		unless ok $
+			error $ "git init failed!\nOutput:\n" ++ transcript
+		return True
+	)
+  where
+	baseparams = [Param "init", Param "--quiet"]
+	params
+		| bare = baseparams ++ [Param "--bare", File path]
+		| otherwise = baseparams ++ [File path]
+
+{- Runs an action in the git repository in the specified directory. -}
+inDir :: FilePath -> Annex a -> IO a
+inDir dir a = do
+	state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir
+	Annex.eval state a
+
+{- Creates a new repository, and returns its UUID. -}
+initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID
+initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do
+	initRepo' desc mgroup
+	{- Initialize the master branch, so things that expect
+	 - to have it will work, before any files are added. -}
+	unlessM (Git.Config.isBare <$> gitRepo) $
+		void $ inRepo $ Git.Branch.commitCommand Git.Branch.AutomaticCommit
+			[ Param "--quiet"
+			, Param "--allow-empty"
+			, Param "-m"
+			, Param "created repository"
+			]
+	{- Repositories directly managed by the assistant use direct mode.
+	 - 
+	 - Automatic gc is disabled, as it can be slow. Insted, gc is done
+	 - once a day.
+	 -}
+	when primary_assistant_repo $ do
+		setDirect True
+		inRepo $ Git.Command.run
+			[Param "config", Param "gc.auto", Param "0"]
+	getUUID
+{- Repo already exists, could be a non-git-annex repo though so
+ - still initialize it. -}
+initRepo False _ dir desc mgroup = inDir dir $ do
+	initRepo' desc mgroup
+	getUUID
+
+initRepo' :: Maybe String -> Maybe StandardGroup -> Annex ()
+initRepo' desc mgroup = unlessM isInitialized $ do
+	initialize desc
+	u <- getUUID
+	maybe noop (defaultStandardGroup u) mgroup
+	{- Ensure branch gets committed right away so it is
+	 - available for merging immediately. -}
+	Annex.Branch.commit "update"
+
+{- Checks if a git repo exists at a location. -}
+probeRepoExists :: FilePath -> IO Bool
+probeRepoExists dir = isJust <$>
+	catchDefaultIO Nothing (Git.Construct.checkForRepo dir)

Annex/MetaData.hs

@@ -7,6 +7,7 @@
 
 module Annex.MetaData (
 	genMetaData,
+	dateMetaData,
 	module X
 ) where
 
@@ -37,20 +38,18 @@ genMetaData :: Key -> FilePath -> FileStatus -> Annex ()
 genMetaData key file status = do
 	maybe noop (flip copyMetaData key) =<< catKeyFileHEAD file
 	whenM (annexGenMetaData <$> Annex.getGitConfig) $ do
-		metadata <- getCurrentMetaData key
+		curr <- getCurrentMetaData key
-		let metadata' = genMetaData' status metadata
+		addMetaData key (dateMetaData mtime curr)
-		unless (metadata' == emptyMetaData) $
+  where
-			addMetaData key metadata'
+	mtime = posixSecondsToUTCTime $ realToFrac $ modificationTime status
 
-{- Generates metadata from the FileStatus.
+{- Generates metadata for a file's date stamp.
  - Does not overwrite any existing metadata values. -}
-genMetaData' :: FileStatus -> MetaData -> MetaData
+dateMetaData :: UTCTime -> MetaData -> MetaData
-genMetaData' status old = MetaData $ M.fromList $ filter isnew
+dateMetaData mtime old = MetaData $ M.fromList $ filter isnew
 	[ (yearMetaField, S.singleton $ toMetaValue $ show y)
 	, (monthMetaField, S.singleton $ toMetaValue $ show m)
 	]
   where
 	isnew (f, _) = S.null (currentMetaDataValues f old)
-	(y, m, _d) = toGregorian $ utctDay $ 
+	(y, m, _d) = toGregorian $ utctDay $ mtime
-		posixSecondsToUTCTime $ realToFrac $
-			modificationTime status

Annex/ReplaceFile.hs

@@ -23,11 +23,16 @@ import Annex.Exception
  - Throws an IO exception when it was unable to replace the file.
  -}
 replaceFile :: FilePath -> (FilePath -> Annex ()) -> Annex ()
-replaceFile file a = do
+replaceFile file action = replaceFileOr file action (liftIO . nukeFile)
+
+{- If unable to replace the file with the temp file, runs the
+ - rollback action, which is responsible for cleaning up the temp file. -}
+replaceFileOr :: FilePath -> (FilePath -> Annex ()) -> (FilePath -> Annex ()) -> Annex ()
+replaceFileOr file action rollback = do
 	tmpdir <- fromRepo gitAnnexTmpMiscDir
 	void $ createAnnexDirectory tmpdir
-	bracketIO (setup tmpdir) nukeFile $ \tmpfile -> do
+	bracketAnnex (liftIO $ setup tmpdir) rollback $ \tmpfile -> do
-		a tmpfile
+		action tmpfile
 		liftIO $ catchIO (rename tmpfile file) (fallback tmpfile)
   where
   	setup tmpdir = do

Annex/Ssh.hs

@@ -25,7 +25,7 @@ import Data.Hash.MD5
 import System.Exit
 
 import Common.Annex
-import Annex.LockPool
+import Annex.LockFile
 import qualified Build.SysConfig as SysConfig
 import qualified Annex
 import qualified Git
@@ -119,13 +119,13 @@ prepSocket socketfile = do
 	-- If the lock pool is empty, this is the first ssh of this
 	-- run. There could be stale ssh connections hanging around
 	-- from a previous git-annex run that was interrupted.
-	whenM (not . any isLock . M.keys <$> getPool)
+	whenM (not . any isLock . M.keys <$> getLockPool)
 		sshCleanup
 	-- Cleanup at end of this run.
 	Annex.addCleanup SshCachingCleanup sshCleanup
 
 	liftIO $ createDirectoryIfMissing True $ parentDir socketfile
-	lockFile $ socket2lock socketfile
+	lockFileShared $ socket2lock socketfile
 
 enumSocketFiles :: Annex [FilePath]
 enumSocketFiles = go =<< sshCacheDir

Annex/View.hs

@@ -433,7 +433,7 @@ genViewBranch :: View -> Annex () -> Annex Git.Branch
 genViewBranch view a = withIndex $ do
 	a
 	let branch = branchView view
-	void $ inRepo $ Git.Branch.commit True (fromRef branch) branch []
+	void $ inRepo $ Git.Branch.commit Git.Branch.AutomaticCommit True (fromRef branch) branch []
 	return branch
 
 {- Runs an action using the view index file.

Assistant.hs

@@ -52,9 +52,12 @@ import qualified Utility.Daemon
 import Utility.ThreadScheduler
 import Utility.HumanTime
 import qualified Build.SysConfig as SysConfig
-#ifndef mingw32_HOST_OS
-import Utility.LogFile
 import Annex.Perms
+import Utility.LogFile
+#ifdef mingw32_HOST_OS
+import Utility.Env
+import Config.Files
+import System.Environment (getArgs)
 #endif
 
 import System.Log.Logger
@@ -72,19 +75,18 @@ startDaemon :: Bool -> Bool -> Maybe Duration -> Maybe String -> Maybe HostName
 startDaemon assistant foreground startdelay cannotrun listenhost startbrowser = do
 	Annex.changeState $ \s -> s { Annex.daemon = True }
 	pidfile <- fromRepo gitAnnexPidFile
-#ifndef mingw32_HOST_OS
 	logfile <- fromRepo gitAnnexLogFile
+	liftIO $ debugM desc $ "logging to " ++ logfile
+#ifndef mingw32_HOST_OS
 	createAnnexDirectory (parentDir logfile)
-	logfd <- liftIO $ openLog logfile
+	logfd <- liftIO $ handleToFd =<< openLog logfile
 	if foreground
 		then do
 			origout <- liftIO $ catchMaybeIO $ 
 				fdToHandle =<< dup stdOutput
 			origerr <- liftIO $ catchMaybeIO $ 
 				fdToHandle =<< dup stdError
-			let undaemonize a = do
+			let undaemonize = Utility.Daemon.foreground logfd (Just pidfile)
-				debugM desc $ "logging to " ++ logfile
-				Utility.Daemon.foreground logfd (Just pidfile) a
 			start undaemonize $ 
 				case startbrowser of
 					Nothing -> Nothing
@@ -92,13 +94,29 @@ startDaemon assistant foreground startdelay cannotrun listenhost startbrowser =
 		else
 			start (Utility.Daemon.daemonize logfd (Just pidfile) False) Nothing
 #else
-	-- Windows is always foreground, and has no log file.
+	-- Windows doesn't daemonize, but does redirect output to the
+	-- log file. The only way to do so is to restart the program.
 	when (foreground || not foreground) $ do
-		liftIO $ Utility.Daemon.lockPidFile pidfile
+		let flag = "GIT_ANNEX_OUTPUT_REDIR"
-		start id $ do
+		createAnnexDirectory (parentDir logfile)
-			case startbrowser of
+		ifM (liftIO $ isNothing <$> getEnv flag)
-				Nothing -> Nothing
+			( liftIO $ withFile devNull WriteMode $ \nullh -> do
-				Just a -> Just $ a Nothing Nothing
+				loghandle <- openLog logfile
+				e <- getEnvironment
+				cmd <- readProgramFile
+				ps <- getArgs
+				(_, _, _, pid) <- createProcess (proc cmd ps)
+					{ env = Just (addEntry flag "1" e)
+					, std_in = UseHandle nullh
+					, std_out = UseHandle loghandle
+					, std_err = UseHandle loghandle
+					}
+				exitWith =<< waitForProcess pid
+			, start (Utility.Daemon.foreground (Just pidfile)) $
+				case startbrowser of
+					Nothing -> Nothing
+					Just a -> Just $ a Nothing Nothing
+			)
 #endif
   where
   	desc

Assistant/Install.hs

@@ -92,9 +92,9 @@ installNautilus :: FilePath -> IO ()
 #ifdef linux_HOST_OS
 installNautilus program = do
 	scriptdir <- (\d -> d </> "nautilus" </> "scripts") <$> userDataDir
-	whenM (doesDirectoryExist scriptdir) $ do
+	createDirectoryIfMissing True scriptdir
-		genscript scriptdir "get"
+	genscript scriptdir "get"
-		genscript scriptdir "drop"
+	genscript scriptdir "drop"
   where
 	genscript scriptdir action =
 		installscript (scriptdir </> scriptname action) $ unlines

Assistant/Sync.hs

@@ -96,7 +96,7 @@ reconnectRemotes notifypushes rs = void $ do
 		=<< fromMaybe [] . M.lookup (Remote.uuid r) . connectRemoteNotifiers
 			<$> getDaemonStatus
 
-{- Updates the local sync branch, then pushes it to all remotes, in
+{- Pushes the local sync branch to all remotes, in
  - parallel, along with the git-annex branch. This is the same
  - as "git annex sync", except in parallel, and will co-exist with use of
  - "git annex sync".
@@ -148,7 +148,6 @@ pushToRemotes' now notifypushes remotes = do
 	go _ _ _ _ [] = return [] -- no remotes, so nothing to do
 	go shouldretry (Just branch) g u rs =  do
 		debug ["pushing to", show rs]
-		liftIO $ Command.Sync.updateBranch (Command.Sync.syncBranch branch) g
 		(succeeded, failed) <- liftIO $ inParallel (push g branch) rs
 		updatemap succeeded []
 		if null failed

Assistant/Threads/Committer.hs

@@ -35,6 +35,7 @@ import qualified Annex
 import Utility.InodeCache
 import Annex.Content.Direct
 import qualified Command.Sync
+import qualified Git.Branch
 
 import Data.Time.Clock
 import Data.Tuple.Utils
@@ -219,7 +220,11 @@ commitStaged = do
 	v <- tryAnnex Annex.Queue.flush
 	case v of
 		Left _ -> return False
-		Right _ -> Command.Sync.commitStaged ""
+		Right _ -> do
+			ok <- Command.Sync.commitStaged Git.Branch.AutomaticCommit ""
+			when ok $
+				Command.Sync.updateSyncBranch =<< inRepo Git.Branch.current
+			return ok
 
 {- OSX needs a short delay after a file is added before locking it down,
  - when using a non-direct mode repository, as pasting a file seems to

Assistant/Threads/Merger.hs

@@ -78,12 +78,13 @@ onChange file
 	changedbranch = fileToBranch file
 
 	mergecurrent (Just current)
-		| equivBranches changedbranch current = do
+		| equivBranches changedbranch current =
-			debug
+			whenM (liftAnnex $ inRepo $ Git.Branch.changed current changedbranch) $ do
-				[ "merging", Git.fromRef changedbranch
+				debug
-				, "into", Git.fromRef current
+					[ "merging", Git.fromRef changedbranch
-				]
+					, "into", Git.fromRef current
-			void $ liftAnnex  $ autoMergeFrom changedbranch (Just current)
+					]
+				void $ liftAnnex $ autoMergeFrom changedbranch (Just current) Git.Branch.AutomaticCommit
 	mergecurrent _ = noop
 
 	handleDesynced = case fromTaggedBranch changedbranch of

Assistant/Threads/SanityChecker.hs

@@ -23,7 +23,7 @@ import Assistant.TransferQueue
 import Assistant.Types.UrlRenderer
 import qualified Annex.Branch
 import qualified Git.LsFiles
-import qualified Git.Command
+import qualified Git.Command.Batch
 import qualified Git.Config
 import Utility.ThreadScheduler
 import qualified Assistant.Threads.Watcher as Watcher
@@ -167,7 +167,7 @@ dailyCheck urlrenderer = do
 	 - to have a lot of small objects and they should not be a
 	 - significant size. -}
 	when (Git.Config.getMaybe "gc.auto" g == Just "0") $
-		liftIO $ void $ Git.Command.runBatch batchmaker
+		liftIO $ void $ Git.Command.Batch.run batchmaker
 			[ Param "-c", Param "gc.auto=670000"
 			, Param "gc"
 			, Param "--auto"
@@ -224,7 +224,7 @@ checkLogSize n = do
 	totalsize <- liftIO $ sum <$> mapM filesize logs
 	when (totalsize > 2 * oneMegabyte) $ do
 		notice ["Rotated logs due to size:", show totalsize]
-		liftIO $ openLog f >>= redirLog
+		liftIO $ openLog f >>= handleToFd >>= redirLog
 		when (n < maxLogs + 1) $ do
 			df <- liftIO $ getDiskFree $ takeDirectory f
 			case df of

Assistant/Upgrade.hs

@@ -33,6 +33,7 @@ import Utility.ThreadScheduler
 import Utility.Tmp
 import Utility.UserInfo
 import Utility.Gpg
+import Utility.FileMode
 import qualified Utility.Lsof as Lsof
 import qualified Build.SysConfig
 import qualified Utility.Url as Url
@@ -348,7 +349,7 @@ verifyDistributionSig :: FilePath -> IO Bool
 verifyDistributionSig sig = do
 	p <- readProgramFile
 	if isAbsolute p
-		then withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do
+		then withUmask 0o0077 $ withTmpDir "git-annex-gpg.tmp" $ \gpgtmp -> do
 			let trustedkeys = takeDirectory p </> "trustedkeys.gpg"
 			boolSystem gpgcmd
 				[ Param "--no-default-keyring"

Assistant/WebApp/Configurators/Local.hs

@@ -14,13 +14,11 @@ import Assistant.WebApp.Gpg
 import Assistant.WebApp.MakeRemote
 import Assistant.Sync
 import Assistant.Restart
-import Annex.Init
+import Annex.MakeRepo
 import qualified Git
-import qualified Git.Construct
 import qualified Git.Config
 import qualified Git.Command
 import qualified Git.Branch
-import qualified Annex
 import Config.Files
 import Utility.FreeDesktop
 import Utility.DiskFree
@@ -30,14 +28,12 @@ import Utility.Mounts
 import Utility.DataUnits
 import Remote (prettyUUID)
 import Annex.UUID
-import Annex.Direct
 import Types.StandardGroups
 import Logs.PreferredContent
 import Logs.UUID
 import Utility.UserInfo
 import Config
 import Utility.Gpg
-import qualified Annex.Branch
 import qualified Remote.GCrypt as GCrypt
 import qualified Types.Remote
 
@@ -413,69 +409,6 @@ startFullAssistant path repogroup setup = do
 		fromJust $ postFirstRun webapp
 	redirect $ T.pack url
 
-{- Makes a new git repository. Or, if a git repository already
- - exists, returns False. -}
-makeRepo :: FilePath -> Bool -> IO Bool
-makeRepo path bare = ifM (probeRepoExists path)
-	( return False
-	, do
-		(transcript, ok) <-
-			processTranscript "git" (toCommand params) Nothing
-		unless ok $
-			error $ "git init failed!\nOutput:\n" ++ transcript
-		return True
-	)
-  where
-	baseparams = [Param "init", Param "--quiet"]
-	params
-		| bare = baseparams ++ [Param "--bare", File path]
-		| otherwise = baseparams ++ [File path]
-
-{- Runs an action in the git repository in the specified directory. -}
-inDir :: FilePath -> Annex a -> IO a
-inDir dir a = do
-	state <- Annex.new =<< Git.Config.read =<< Git.Construct.fromPath dir
-	Annex.eval state a
-
-{- Creates a new repository, and returns its UUID. -}
-initRepo :: Bool -> Bool -> FilePath -> Maybe String -> Maybe StandardGroup -> IO UUID
-initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do
-	initRepo' desc mgroup
-	{- Initialize the master branch, so things that expect
-	 - to have it will work, before any files are added. -}
-	unlessM (Git.Config.isBare <$> gitRepo) $
-		void $ inRepo $ Git.Command.runBool
-			[ Param "commit"
-			, Param "--quiet"
-			, Param "--allow-empty"
-			, Param "-m"
-			, Param "created repository"
-			]
-	{- Repositories directly managed by the assistant use direct mode.
-	 - 
-	 - Automatic gc is disabled, as it can be slow. Insted, gc is done
-	 - once a day.
-	 -}
-	when primary_assistant_repo $ do
-		setDirect True
-		inRepo $ Git.Command.run
-			[Param "config", Param "gc.auto", Param "0"]
-	getUUID
-{- Repo already exists, could be a non-git-annex repo though so
- - still initialize it. -}
-initRepo False _ dir desc mgroup = inDir dir $ do
-	initRepo' desc mgroup
-	getUUID
-
-initRepo' :: Maybe String -> Maybe StandardGroup -> Annex ()
-initRepo' desc mgroup = unlessM isInitialized $ do
-	initialize desc
-	u <- getUUID
-	maybe noop (defaultStandardGroup u) mgroup
-	{- Ensure branch gets committed right away so it is
-	 - available for merging immediately. -}
-	Annex.Branch.commit "update"
-
 {- Checks if the user can write to a directory.
  -
  - The directory may be in the process of being created; if so
@@ -486,11 +419,6 @@ canWrite dir = do
 		(return dir, return $ parentDir dir)
 	catchBoolIO $ fileAccess tocheck False True False
 
-{- Checks if a git repo exists at a location. -}
-probeRepoExists :: FilePath -> IO Bool
-probeRepoExists dir = isJust <$>
-	catchDefaultIO Nothing (Git.Construct.checkForRepo dir)
-
 {- Gets the UUID of the git repo at a location, which may not exist, or
  - not be a git-annex repo. -}
 probeUUID :: FilePath -> IO (Maybe UUID)

Assistant/WebApp/DashBoard.hs

@@ -118,20 +118,22 @@ openFileBrowser = do
 	path <- liftAnnex $ fromRepo Git.repoPath
 #ifdef darwin_HOST_OS
 	let cmd = "open"
-	let params = [Param path]
+	let p = proc cmd [path]
 #else
 #ifdef mingw32_HOST_OS
+	{- Changing to the directory and then opening . works around
+	 - spaces in directory name, etc. -}
 	let cmd = "cmd"
-	let params = [Param $ "/c start " ++ path]
+	let p = (proc cmd ["/c start ."]) { cwd = Just path }
 #else
 	let cmd = "xdg-open"
-	let params = [Param path]
+	let p = proc cmd [path]
 #endif
 #endif
 	ifM (liftIO $ inPath cmd)
 		( do
 			let run = void $ liftIO $ forkIO $ void $
-				boolSystem cmd params
+				createProcess p
 			run
 #ifdef mingw32_HOST_OS
 			{- On windows, if the file browser is not

Assistant/WebApp/Types.hs

@@ -154,9 +154,11 @@ data RemovableDrive = RemovableDrive
 data RepoKey = RepoKey KeyId | NoRepoKey
 	deriving (Read, Show, Eq, Ord)
 
+#if ! MIN_VERSION_path_pieces(0,1,4)
 instance PathPiece Bool where
 	toPathPiece = pack . show
 	fromPathPiece = readish . unpack
+#endif
 
 instance PathPiece RemovableDrive where
 	toPathPiece = pack . show

Backend/Hash.hs

@@ -44,6 +44,7 @@ genBackend hash = Just Backend
 	, getKey = keyValue hash
 	, fsckKey = Just $ checkKeyChecksum hash
 	, canUpgradeKey = Just needsUpgrade
+	, fastMigrate = Just trivialMigrate
 	}
 
 genBackendE :: Hash -> Maybe Backend
@@ -129,6 +130,15 @@ needsUpgrade :: Key -> Bool
 needsUpgrade key = "\\" `isPrefixOf` keyHash key ||
 	any (not . validExtension) (takeExtensions $ keyName key)
 
+{- Fast migration from hashE to hash backend. (Optimisation) -}
+trivialMigrate :: Key -> Backend -> Maybe Key
+trivialMigrate oldkey newbackend
+	| keyBackendName oldkey == name newbackend ++ "E" = Just $ oldkey
+		{ keyName = keyHash oldkey
+		, keyBackendName = name newbackend
+		}
+	| otherwise = Nothing
+
 hashFile :: Hash -> FilePath -> Integer -> Annex String
 hashFile hash file filesize = liftIO $ go hash
   where

Backend/URL.hs

@@ -24,6 +24,7 @@ backend = Backend
 	, getKey = const $ return Nothing
 	, fsckKey = Nothing
 	, canUpgradeKey = Nothing
+	, fastMigrate = Nothing
 	}
 
 {- Every unique url has a corresponding key. -}

Backend/WORM.hs

@@ -22,6 +22,7 @@ backend = Backend
 	, getKey = keyValue
 	, fsckKey = Nothing
 	, canUpgradeKey = Nothing
+	, fastMigrate = Nothing
 	}
 
 {- The key includes the file size, modification time, and the

Build/BuildVersion.hs

@@ -0,0 +1,6 @@
+{- Outputs the version of git-annex that was built, for use by
+ - autobuilders. Note that this includes the git rev. -}
+
+import Build.Version
+
+main = putStr =<< getVersion

Build/Configure.hs

@@ -17,7 +17,7 @@ import qualified Git.Version
 
 tests :: [TestCase]
 tests =
-	[ TestCase "version" getVersion
+	[ TestCase "version" (Config "packageversion" . StringConfig <$> getVersion)
 	, TestCase "UPGRADE_LOCATION" getUpgradeLocation
 	, TestCase "git" $ requireCmd "git" "git --version >/dev/null"
 	, TestCase "git version" getGitVersion
@@ -60,7 +60,7 @@ shaTestCases l = map make l
 		Config key . MaybeStringConfig <$> search (shacmds n)
 	  where
 		key = "sha" ++ show n
-	  	search [] = return Nothing
+		search [] = return Nothing
 		search (c:cmds) = do
 			sha <- externalSHA c n "/dev/null"
 			if sha == Right knowngood

Build/DistributionUpdate.hs

@@ -1,6 +1,9 @@
-{- Builds distributon info files for each git-annex release in a directory
+{- Downloads git-annex autobuilds and installs them into the git-annex
- - tree, which must itself be part of a git-annex repository. Only files
+ - repository in ~/lib/downloads that is used to distribute git-annex
- - that are present have their info file created.
+ - releases.
+ -
+ - Generates info files, containing the version (of the corresponding file
+ - from the autobuild).
  -
  - Also gpg signs the files.
  -}
@@ -9,25 +12,87 @@ import Common.Annex
 import Types.Distribution
 import Build.Version
 import Utility.UserInfo
-import Utility.Path
+import Utility.Url
 import qualified Git.Construct
 import qualified Annex
 import Annex.Content
 import Backend
 import Git.Command
 
+import Data.Default
 import Data.Time.Clock
+import Data.Char
 
 -- git-annex distribution signing key (for Joey Hess)
 signingKey :: String
 signingKey = "89C809CB"
 
-main = do
+-- URL to an autobuilt git-annex file, and the place to install
-	state <- Annex.new =<< Git.Construct.fromPath =<< getRepoDir
+-- it in the repository.
-	Annex.eval state makeinfos
+autobuilds :: [(URLString, FilePath)]
+autobuilds = 
+	(map linuxarch ["i386", "amd64", "armel"]) ++
+	(map androidversion ["4.0", "4.3"]) ++
+	[ (autobuild "x86_64-apple-mavericks/git-annex.dmg", "git-annex/OSX/current/10.9_Mavericks/git-annex.dmg")
+	, (autobuild "windows/git-annex-installer.exe", "git-annex/windows/current/git-annex-installer.exe")
+	]
+  where
+	linuxarch a =
+		( autobuild (a ++ "/git-annex-standalone-" ++ a ++ ".tar.gz")
+		, "git-annex/linux/current/git-annex-standalone-" ++ a ++ ".tar.gz"
+		)
+	androidversion v =
+		( autobuild ("android/" ++ v ++ "/git-annex.apk")
+		, "git-annex/android/current/" ++ v ++ "/git-annex.apk"
+		)
+	autobuild f = "https://downloads.kitenet.net/git-annex/autobuild/" ++ f
 
-makeinfos :: Annex ()
+main :: IO ()
-makeinfos = do
+main = do
+	repodir <- getRepoDir
+	updated <- catMaybes <$> mapM (getbuild repodir) autobuilds
+	state <- Annex.new =<< Git.Construct.fromPath repodir
+	Annex.eval state (makeinfos updated)
+
+-- Download a build from the autobuilder, and return its version.
+-- It's very important that the version matches the build, otherwise
+-- auto-upgrades can loop reatedly. So, check build-version before
+-- and after downloading the file.
+getbuild :: FilePath -> (URLString, FilePath) -> IO (Maybe (FilePath, Version))
+getbuild repodir (url, f) = do
+	bv1 <- getbv
+	let dest = repodir </> f
+	let tmp = dest ++ ".tmp"
+	nukeFile tmp
+	createDirectoryIfMissing True (parentDir dest)
+	let oops s = do
+		nukeFile tmp
+		putStrLn $ "*** " ++ s
+		return Nothing
+	ifM (download url tmp def)
+		( do
+			bv2 <- getbv
+			case bv2 of
+				Nothing -> oops $ "no build-version file for " ++ url
+				(Just v)
+					| bv2 == bv1 -> do
+						nukeFile dest
+						renameFile tmp dest
+						-- remove git rev part of version
+						let v' = takeWhile (/= '-') v
+						return $ Just (f, v')
+					| otherwise -> oops $ "build version changed while downloading " ++ url ++ " " ++ show (bv1, bv2)
+		, oops $ "failed to download " ++ url
+		)
+  where
+	bvurl = takeDirectory url ++ "/build-version"
+	getbv = do
+		bv <- catchDefaultIO "" $ readProcess "curl" ["--silent", bvurl]
+		return $ if null bv || any (not . versionchar) bv then Nothing else Just bv
+	versionchar c = isAlphaNum c || c == '.' || c == '-'
+
+makeinfos :: [(FilePath, Version)] -> Annex ()
+makeinfos updated = do
 	version <- liftIO getChangelogVersion
 	void $ inRepo $ runBool 
 		[ Param "commit"
@@ -37,25 +102,24 @@ makeinfos = do
 		]
 	basedir <- liftIO getRepoDir
 	now <- liftIO getCurrentTime
-	liftIO $ putStrLn $ "building info files for version " ++ version ++ " in " ++ basedir
+	liftIO $ putStrLn $ "building info files in " ++ basedir
-	fs <- liftIO $ dirContentsRecursiveSkipping (const False) True (basedir </> "git-annex")
+	forM_ updated $ \(f, bv) -> do
-	forM_ fs $ \f -> do
+		v <- lookupFile (basedir </> f)
-		v <- lookupFile f
 		case v of
 			Nothing -> noop
 			Just k -> whenM (inAnnex k) $ do
 				liftIO $ putStrLn f
-				let infofile = f ++ ".info"
+				let infofile = basedir </> f ++ ".info"
 				liftIO $ writeFile infofile $ show $ GitAnnexDistribution
-					{ distributionUrl = mkUrl basedir f
+					{ distributionUrl = mkUrl f
 					, distributionKey = k
-					, distributionVersion = version
+					, distributionVersion = bv
 					, distributionReleasedate = now
 					, distributionUrgentUpgrade = Nothing
 					}
 				void $ inRepo $ runBool [Param "add", File infofile]
 				signFile infofile
-				signFile f
+				signFile (basedir </> f)
 	void $ inRepo $ runBool 
 		[ Param "commit"
 		, Param "-m"
@@ -70,7 +134,7 @@ makeinfos = do
 		, Params "sync"
 		]
 	
-	{- Check for out of date info files. -}
+	-- Check for out of date info files.
 	infos <- liftIO $ filter (".info" `isSuffixOf`)
 		<$> dirContentsRecursive (basedir </> "git-annex")
 	ds <- liftIO $ forM infos (readish <$$> readFile)
@@ -88,8 +152,8 @@ getRepoDir = do
 	home <- liftIO myHomeDir
 	return $ home </> "lib" </> "downloads"
 
-mkUrl :: FilePath -> FilePath -> String
+mkUrl :: FilePath -> String
-mkUrl basedir f = "https://downloads.kitenet.net/" ++ relPathDirToFile basedir f
+mkUrl f = "https://downloads.kitenet.net/" ++ f
 				
 signFile :: FilePath -> Annex ()
 signFile f = do

Build/EvilLinker.hs

@@ -20,7 +20,7 @@ import Data.Maybe
 import Data.List
 
 import Utility.Monad
-import Utility.Process
+import Utility.Process hiding (env)
 import Utility.Env
 
 data CmdParams = CmdParams

Build/NullSoftInstaller.hs

@@ -37,13 +37,16 @@ main = do
 		mustSucceed "ln" [File "dist/build/git-annex/git-annex.exe", File gitannex]
 		let license = tmpdir </> licensefile
 		mustSucceed "sh" [Param "-c", Param $ "zcat standalone/licences.gz > '" ++ license ++ "'"]
-		extrafiles <- forM (cygwinPrograms ++ cygwinDlls) $ \f -> do
+		extrabins <- forM (cygwinPrograms ++ cygwinDlls) $ \f -> do
 			p <- searchPath f
 			when (isNothing p) $
 				print ("unable to find in PATH", f)
 			return p
-		writeFile nsifile $ makeInstaller gitannex license $
+		webappscript <- vbsLauncher tmpdir "git-annex-webapp" "git-annex webapp"
-			catMaybes extrafiles
+		autostartscript <- vbsLauncher tmpdir "git-annex-autostart" "git annex assistant --autostart"
+		writeFile nsifile $ makeInstaller gitannex license
+			(catMaybes extrabins)
+			[ webappscript, autostartscript ]
 		mustSucceed "makensis" [File nsifile]
 	removeFile nsifile -- left behind if makensis fails
   where
@@ -54,6 +57,17 @@ main = do
 			True -> return ()
 			False -> error $ cmd ++ " failed"
 
+{- Generates a .vbs launcher which runs a command without any visible DOS
+ - box. -}
+vbsLauncher :: FilePath -> String -> String -> IO String
+vbsLauncher tmpdir basename cmd = do
+	let f = tmpdir </> basename ++ ".vbs"
+	writeFile f $ unlines
+		[ "Set objshell=CreateObject(\"Wscript.Shell\")"
+		, "objShell.Run(\"" ++ cmd ++ "\"), 0, False"
+		]
+	return f
+
 gitannexprogram :: FilePath
 gitannexprogram = "git-annex.exe"
 
@@ -67,11 +81,14 @@ uninstaller :: FilePath
 uninstaller = "git-annex-uninstall.exe"
 
 gitInstallDir :: Exp FilePath
-gitInstallDir = fromString "$PROGRAMFILES\\Git\\bin"
+gitInstallDir = fromString "$PROGRAMFILES\\Git"
 
 startMenuItem :: Exp FilePath
 startMenuItem = "$SMPROGRAMS/git-annex.lnk"
 
+autoStartItem :: Exp FilePath
+autoStartItem = "$SMSTARTUP/git-annex-autostart.lnk"
+
 needGit :: Exp String
 needGit = strConcat
 	[ fromString "You need git installed to use git-annex. Looking at "
@@ -81,8 +98,8 @@ needGit = strConcat
 	, fromString "You can install git from http:////git-scm.com//"
 	]
 
-makeInstaller :: FilePath -> FilePath -> [FilePath] -> String
+makeInstaller :: FilePath -> FilePath -> [FilePath] -> [FilePath] -> String
-makeInstaller gitannex license extrafiles = nsis $ do
+makeInstaller gitannex license extrabins launchers = nsis $ do
 	name "git-annex"
 	outFile $ str installer
 	{- Installing into the same directory as git avoids needing to modify
@@ -101,30 +118,46 @@ makeInstaller gitannex license extrafiles = nsis $ do
 	-- Start menu shortcut
 	Development.NSIS.createDirectory "$SMPROGRAMS"
 	createShortcut startMenuItem
-		[ Target "$INSTDIR/git-annex.exe"
+		[ Target "wscript.exe"
-		, Parameters "webapp"
+		, Parameters "\"$INSTDIR/git-annex-webapp.vbs\""
-		, IconFile "$INSTDIR/git-annex.exe"
+		, StartOptions "SW_SHOWNORMAL"
+		, IconFile "$INSTDIR/cmd/git-annex.exe"
 		, IconIndex 2
-		, StartOptions "SW_SHOWMINIMIZED"
 		, KeyboardShortcut "ALT|CONTROL|a"
 		, Description "git-annex webapp"
 		]
-	-- Groups of files to install
+	createShortcut autoStartItem
-	section "main" [] $ do
+		[ Target "wscript.exe"
-		setOutPath "$INSTDIR"
+		, Parameters "\"$INSTDIR/git-annex-autostart.vbs\""
+		, StartOptions "SW_SHOWNORMAL"
+		, IconFile "$INSTDIR/cmd/git-annex.exe"
+		, IconIndex 2
+		, Description "git-annex autostart"
+		]
+	section "bins" [] $ do
+		setOutPath "$INSTDIR\\bin"
+		mapM_ addfile extrabins
+	section "cmd" [] $ do
+		setOutPath "$INSTDIR\\cmd"
 		addfile gitannex
+	section "meta" [] $ do
+		setOutPath "$INSTDIR"
 		addfile license
-		mapM_ addfile extrafiles
+		mapM_ addfile launchers
 		writeUninstaller $ str uninstaller
 	uninstall $ do
 		delete [RebootOK] $ startMenuItem
-		mapM_ (\f -> delete [RebootOK] $ fromString $ "$INSTDIR/" ++ f) $
+		delete [RebootOK] $ autoStartItem
-			[ gitannexprogram
+		removefilesFrom "$INSTDIR/bin" extrabins
-			, licensefile
+		removefilesFrom "$INSTDIR/cmd" [gitannex]
+		removefilesFrom "$INSTDIR" $
+			launchers ++
+			[ license
 			, uninstaller
-			] ++ cygwinPrograms ++ cygwinDlls
+			]
   where
 	addfile f = file [] (str f)
+	removefilesFrom d = mapM_ (\f -> delete [RebootOK] $ fromString $ d ++ "/" ++ takeFileName f)
 
 cygwinPrograms :: [FilePath]
 cygwinPrograms = map (\p -> p ++ ".exe") bundledPrograms

Build/Version.hs

@@ -10,10 +10,11 @@ import System.Directory
 import Data.Char
 import System.Process
 
-import Build.TestConfig
 import Utility.Monad
 import Utility.Exception
 
+type Version = String
+
 {- Set when making an official release. (Distribution vendors should set
  - this too.) -}
 isReleaseBuild :: IO Bool
@@ -25,10 +26,10 @@ isReleaseBuild = isJust <$> catchMaybeIO (getEnv "RELEASE_BUILD")
  -
  - If git or a git repo is not available, or something goes wrong,
  - or this is a release build, just use the version from the changelog. -}
-getVersion :: Test
+getVersion :: IO Version
 getVersion = do
 	changelogversion <- getChangelogVersion
-	version <- ifM (isReleaseBuild)
+	ifM (isReleaseBuild)
 		( return changelogversion
 		, catchDefaultIO changelogversion $ do
 			let major = takeWhile (/= '.') changelogversion
@@ -40,9 +41,8 @@ getVersion = do
 				then return changelogversion
 				else return $ concat [ major, ".", autoversion ]
 		)
-	return $ Config "packageversion" (StringConfig version)
 	
-getChangelogVersion :: IO String
+getChangelogVersion :: IO Version
 getChangelogVersion = do
 	changelog <- readFile "debian/changelog"
 	let verline = takeWhile (/= '\n') changelog

CmdLine/GitAnnex.hs

@@ -54,6 +54,7 @@ import qualified Command.Whereis
 import qualified Command.List
 import qualified Command.Log
 import qualified Command.Merge
+import qualified Command.ResolveMerge
 import qualified Command.Info
 import qualified Command.Status
 import qualified Command.Migrate
@@ -164,6 +165,7 @@ cmds = concat
 	, Command.List.def
 	, Command.Log.def
 	, Command.Merge.def
+	, Command.ResolveMerge.def
 	, Command.Info.def
 	, Command.Status.def
 	, Command.Migrate.def

Command/AddUrl.hs

@@ -97,15 +97,17 @@ performQuvi relaxed pageurl videourl file = ifAnnexed file addurl geturl
   where
   	quviurl = setDownloader pageurl QuviDownloader
   	addurl key = next $ cleanup quviurl file key Nothing
-	geturl = next $ addUrlFileQuvi relaxed quviurl videourl file
+	geturl = next $ isJust <$> addUrlFileQuvi relaxed quviurl videourl file
 #endif
 
 #ifdef WITH_QUVI
-addUrlFileQuvi :: Bool -> URLString -> URLString -> FilePath -> Annex Bool
+addUrlFileQuvi :: Bool -> URLString -> URLString -> FilePath -> Annex (Maybe Key)
 addUrlFileQuvi relaxed quviurl videourl file = do
 	key <- Backend.URL.fromUrl quviurl Nothing
 	ifM (pure relaxed <||> Annex.getState Annex.fast)
-		( cleanup quviurl file key Nothing
+		( do
+			cleanup' quviurl file key Nothing
+			return (Just key)
 		, do
 			{- Get the size, and use that to check
 			 - disk space. However, the size info is not
@@ -113,7 +115,7 @@ addUrlFileQuvi relaxed quviurl videourl file = do
 			 - might change and we want to be able to download
 			 - it later. -}
 			sizedkey <- addSizeUrlKey videourl key
-			prepGetViaTmpChecked sizedkey $ do
+			prepGetViaTmpChecked sizedkey Nothing $ do
 				tmp <- fromRepo $ gitAnnexTmpObjectLocation key
 				showOutput
 				ok <- Transfer.notifyTransfer Transfer.Download (Just file) $
@@ -121,15 +123,17 @@ addUrlFileQuvi relaxed quviurl videourl file = do
 						liftIO $ createDirectoryIfMissing True (parentDir tmp)
 						downloadUrl [videourl] tmp
 				if ok
-					then cleanup quviurl file key (Just tmp)
+					then do
-					else return False
+						cleanup' quviurl file key (Just tmp)
+						return (Just key)
+					else return Nothing
 		)
 #endif
 
 perform :: Bool -> URLString -> FilePath -> CommandPerform
 perform relaxed url file = ifAnnexed file addurl geturl
   where
-	geturl = next $ addUrlFile relaxed url file
+	geturl = next $ isJust <$> addUrlFile relaxed url file
 	addurl key
 		| relaxed = do
 			setUrlPresent key url
@@ -149,7 +153,7 @@ perform relaxed url file = ifAnnexed file addurl geturl
 						stop
 			)
 
-addUrlFile :: Bool -> URLString -> FilePath -> Annex Bool
+addUrlFile :: Bool -> URLString -> FilePath -> Annex (Maybe Key)
 addUrlFile relaxed url file = do
 	liftIO $ createDirectoryIfMissing True (parentDir file)
 	ifM (Annex.getState Annex.fast <||> pure relaxed)
@@ -159,13 +163,13 @@ addUrlFile relaxed url file = do
 			download url file
 		)
 
-download :: URLString -> FilePath -> Annex Bool
+download :: URLString -> FilePath -> Annex (Maybe Key)
 download url file = do
 	{- Generate a dummy key to use for this download, before we can
 	 - examine the file and find its real key. This allows resuming
 	 - downloads, as the dummy key for a given url is stable. -}
 	dummykey <- addSizeUrlKey url =<< Backend.URL.fromUrl url Nothing
-	prepGetViaTmpChecked dummykey $ do
+	prepGetViaTmpChecked dummykey Nothing $ do
 		tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey
 		showOutput
 		ifM (runtransfer dummykey tmp)
@@ -178,9 +182,11 @@ download url file = do
 					}
 				k <- genKey source backend
 				case k of
-					Nothing -> return False
+					Nothing -> return Nothing
-					Just (key, _) -> cleanup url file key (Just tmp)
+					Just (key, _) -> do
-			, return False
+						cleanup' url file key (Just tmp)
+						return (Just key)
+			, return Nothing
 			)
   where
   	runtransfer dummykey tmp =  Transfer.notifyTransfer Transfer.Download (Just file) $
@@ -200,6 +206,11 @@ addSizeUrlKey url key = do
 
 cleanup :: URLString -> FilePath -> Key -> Maybe FilePath -> Annex Bool
 cleanup url file key mtmp = do
+	cleanup' url file key mtmp
+	return True
+
+cleanup' :: URLString -> FilePath -> Key -> Maybe FilePath -> Annex ()
+cleanup' url file key mtmp = do
 	when (isJust mtmp) $
 		logStatus key InfoPresent
 	setUrlPresent key url
@@ -210,9 +221,8 @@ cleanup url file key mtmp = do
 		 - must already exist, so flush the queue. -}
 		Annex.Queue.flush
 	maybe noop (moveAnnex key) mtmp
-	return True
 
-nodownload :: Bool -> URLString -> FilePath -> Annex Bool
+nodownload :: Bool -> URLString -> FilePath -> Annex (Maybe Key)
 nodownload relaxed url file = do
 	(exists, size) <- if relaxed
 		then pure (True, Nothing)
@@ -220,10 +230,11 @@ nodownload relaxed url file = do
 	if exists
 		then do
 			key <- Backend.URL.fromUrl url size
-			cleanup url file key Nothing
+			cleanup' url file key Nothing
+			return (Just key)
 		else do
 			warning $ "unable to access url: " ++ url
-			return False
+			return Nothing
 
 url2file :: URI -> Maybe Int -> Int -> FilePath
 url2file url pathdepth pathmax = case pathdepth of

Command/Assistant.hs

@@ -14,6 +14,7 @@ import Annex.Init
 import Config.Files
 import qualified Build.SysConfig
 import Utility.HumanTime
+import Assistant.Install
 
 import System.Environment
 
@@ -50,6 +51,7 @@ start foreground stopdaemon autostart startdelay
 		liftIO $ autoStart startdelay
 		stop
 	| otherwise = do
+		liftIO ensureInstalled
 		ensureInitialized
 		Command.Watch.start True foreground stopdaemon startdelay
 

Command/Direct.hs

@@ -12,8 +12,8 @@ import Control.Exception.Extensible
 import Common.Annex
 import Command
 import qualified Git
-import qualified Git.Command
 import qualified Git.LsFiles
+import qualified Git.Branch
 import Config
 import Annex.Direct
 import Annex.Exception
@@ -33,9 +33,8 @@ perform :: CommandPerform
 perform = do
 	showStart "commit" ""
 	showOutput
-	_ <- inRepo $ Git.Command.runBool
+	_ <- inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
-		[ Param "commit"
+		[ Param "-a"
-		, Param "-a"
 		, Param "-m"
 		, Param "commit before switching to direct mode"
 		]

Command/ImportFeed.hs

@@ -33,6 +33,9 @@ import Annex.Quvi
 import qualified Utility.Quvi as Quvi
 import Command.AddUrl (addUrlFileQuvi)
 #endif
+import Types.MetaData
+import Logs.MetaData
+import Annex.MetaData
 
 def :: [Command]
 def = [notBareRepo $ withOptions [templateOption, relaxedOption] $
@@ -165,12 +168,14 @@ performDownload relaxed cache todownload = case location todownload of
 			Nothing -> return True
 			Just f -> do
 				showStart "addurl" f
-				ok <- getter f
+				mk <- getter f
-				if ok
+				case mk of
-					then do
+					Just key -> do
+						whenM (annexGenMetaData <$> Annex.getGitConfig) $
+							addMetaData key $ extractMetaData todownload
 						showEndOk
 						return True
-					else do
+					Nothing -> do
 						showEndFail
 						checkFeedBroken (feedurl todownload)
 
@@ -205,25 +210,12 @@ defaultTemplate = "${feedtitle}/${itemtitle}${extension}"
 {- Generates a filename to use for a feed item by filling out the template.
  - The filename may not be unique. -}
 feedFile :: Utility.Format.Format -> ToDownload -> String -> FilePath
-feedFile tmpl i extension = Utility.Format.format tmpl $ M.fromList
+feedFile tmpl i extension = Utility.Format.format tmpl $
-	[ field "feedtitle" $ getFeedTitle $ feed i
+	M.map sanitizeFilePath $ M.fromList $ extractFields i ++
-	, fieldMaybe "itemtitle" $ getItemTitle $ item i
+		[ ("extension", extension)
-	, fieldMaybe "feedauthor" $ getFeedAuthor $ feed i
+		, extractField "itempubdate" [pubdate $ item i]
-	, fieldMaybe "itemauthor" $ getItemAuthor $ item i
+		]
-	, fieldMaybe "itemsummary" $ getItemSummary $ item i
-	, fieldMaybe "itemdescription" $ getItemDescription $ item i
-	, fieldMaybe "itemrights" $ getItemRights $ item i
-	, fieldMaybe "itemid" $ snd <$> getItemId (item i)
-	, fieldMaybe "itempubdate" $ pubdate $ item i
-	, ("extension", sanitizeFilePath extension)
-	]
   where
-	field k v = 
-		let s = sanitizeFilePath v in
-		if null s then (k, "none") else (k, s)
-	fieldMaybe k Nothing = (k, "none")
-	fieldMaybe k (Just v) = field k v
-
 #if MIN_VERSION_feed(0,3,9)
 	pubdate itm = case getItemPublishDate itm :: Maybe (Maybe UTCTime) of
 		Just (Just d) -> Just $
@@ -234,11 +226,46 @@ feedFile tmpl i extension = Utility.Format.format tmpl $ M.fromList
 	pubdate _ = Nothing
 #endif
 
+extractMetaData :: ToDownload -> MetaData
+extractMetaData i = case getItemPublishDate (item i) :: Maybe (Maybe UTCTime) of
+	Just (Just d) -> unionMetaData meta (dateMetaData d meta)
+	_ -> meta
+  where
+	tometa (k, v) = (mkMetaFieldUnchecked k, S.singleton (toMetaValue v))
+	meta = MetaData $ M.fromList $ map tometa $ extractFields i
+
+{- Extract fields from the feed and item, that are both used as metadata,
+ - and to generate the filename. -}
+extractFields :: ToDownload -> [(String, String)]
+extractFields i = map (uncurry extractField)
+	[ ("feedtitle", [feedtitle])
+	, ("itemtitle", [itemtitle])
+	, ("feedauthor", [feedauthor])
+	, ("itemauthor", [itemauthor])
+	, ("itemsummary", [getItemSummary $ item i])
+	, ("itemdescription", [getItemDescription $ item i])
+	, ("itemrights", [getItemRights $ item i])
+	, ("itemid", [snd <$> getItemId (item i)])
+	, ("title", [itemtitle, feedtitle])
+	, ("author", [itemauthor, feedauthor])
+	]
+  where
+	feedtitle = Just $ getFeedTitle $ feed i
+	itemtitle = getItemTitle $ item i
+	feedauthor = getFeedAuthor $ feed i
+	itemauthor = getItemAuthor $ item i
+
+extractField :: String -> [Maybe String] -> (String, String)
+extractField k [] = (k, "none")
+extractField k (Just v:_)
+	| not (null v) = (k, v)
+extractField k (_:rest) = extractField k rest
+
 {- Called when there is a problem with a feed.
  - Throws an error if the feed is broken, otherwise shows a warning. -}
 feedProblem :: URLString -> String -> Annex ()
 feedProblem url message = ifM (checkFeedBroken url)
-	( error $ message ++ " (having repeated problems with this feed!)"
+	( error $ message ++ " (having repeated problems with feed: " ++ url ++ ")"
 	, warning $ "warning: " ++ message
 	)
 

Command/Indirect.hs

@@ -12,7 +12,7 @@ import Control.Exception.Extensible
 import Common.Annex
 import Command
 import qualified Git
-import qualified Git.Command
+import qualified Git.Branch
 import qualified Git.LsFiles
 import Git.FileMode
 import Config
@@ -49,9 +49,8 @@ perform = do
 	showStart "commit" ""
 	whenM stageDirect $ do
 		showOutput
-		void $ inRepo $ Git.Command.runBool
+		void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
-			[ Param "commit"
+			[ Param "-m"
-			, Param "-m"
 			, Param "commit before switching to indirect mode"
 			]
 	showEndOk

Command/Migrate.hs

@@ -11,7 +11,7 @@ import Common.Annex
 import Command
 import Backend
 import qualified Types.Key
-import qualified Types.Backend
+import Types.Backend (canUpgradeKey, fastMigrate)
 import Types.KeySource
 import Annex.Content
 import qualified Command.ReKey
@@ -51,8 +51,7 @@ start file key = do
 upgradableKey :: Backend -> Key -> Bool
 upgradableKey backend key = isNothing (Types.Key.keySize key) || backendupgradable
   where
-	backendupgradable = maybe False (\a -> a key)
+	backendupgradable = maybe False (\a -> a key) (canUpgradeKey backend)
-		(Types.Backend.canUpgradeKey backend)
 
 {- Store the old backend's key in the new backend
  - The old backend's key is not dropped from it, because there may
@@ -67,15 +66,22 @@ perform :: FilePath -> Key -> Backend -> Backend -> CommandPerform
 perform file oldkey oldbackend newbackend = go =<< genkey
   where
   	go Nothing = stop
-	go (Just newkey) = stopUnless checkcontent $ finish newkey
+	go (Just (newkey, knowngoodcontent))
+		| knowngoodcontent = finish newkey
+		| otherwise = stopUnless checkcontent $ finish newkey
 	checkcontent = Command.Fsck.checkBackend oldbackend oldkey $ Just file
 	finish newkey = stopUnless (Command.ReKey.linkKey oldkey newkey) $
 		next $ Command.ReKey.cleanup file oldkey newkey
-	genkey = do
+	genkey = case maybe Nothing (\fm -> fm oldkey newbackend) (fastMigrate oldbackend) of
-		content <- calcRepo $ gitAnnexLocation oldkey
+		Just newkey -> return $ Just (newkey, True)
-		let source = KeySource
+		Nothing -> do
-			{ keyFilename = file
+			content <- calcRepo $ gitAnnexLocation oldkey
-			, contentLocation = content
+			let source = KeySource
-			, inodeCache = Nothing
+				{ keyFilename = file
-			}
+				, contentLocation = content
-		liftM fst <$> genKey source (Just newbackend)
+				, inodeCache = Nothing
+				}
+			v <- genKey source (Just newbackend)
+			return $ case v of
+				Just (newkey, _) -> Just (newkey, False)
+				_ -> Nothing

Command/ResolveMerge.hs

@@ -0,0 +1,40 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.ResolveMerge where
+
+import Common.Annex
+import Command
+import qualified Git
+import Git.Sha
+import qualified Git.Branch
+import Annex.AutoMerge
+
+def :: [Command]
+def = [command "resolvemerge" paramNothing seek SectionPlumbing
+	"resolve merge conflicts"]
+
+seek :: CommandSeek
+seek ps = withNothing start ps
+
+start :: CommandStart
+start = do
+	showStart "resolvemerge" ""
+	us <- fromMaybe nobranch <$> inRepo Git.Branch.current
+	d <- fromRepo Git.localGitDir
+	let merge_head = d </> "MERGE_HEAD"
+	them <- fromMaybe (error nomergehead) . extractSha
+		<$> liftIO (readFile merge_head)
+	ifM (resolveMerge (Just us) them)
+		( do
+			void $ commitResolvedMerge Git.Branch.ManualCommit
+			next $ next $ return True
+		, error "Merge conflict could not be automatically resolved."
+		)
+  where
+	nobranch = error "No branch is currently checked out."
+	nomergehead = error "No SHA found in .git/merge_head"

Command/Sync.hs

@@ -127,14 +127,12 @@ commit = next $ next $ ifM isDirect
 		showStart "commit" ""
 		void stageDirect
 		void preCommitDirect
-		commitStaged commitmessage
+		commitStaged Git.Branch.ManualCommit commitmessage
 	, do
 		showStart "commit" ""
 		Annex.Branch.commit "update"
-		-- Commit will fail when the tree is clean, so ignore failure.
+		inRepo $ Git.Branch.commitQuiet Git.Branch.ManualCommit
-		_ <- inRepo $ tryIO . Git.Command.runQuiet
+			[ Param "-a"
-			[ Param "commit"
-			, Param "-a"
 			, Param "-m"
 			, Param commitmessage
 			]
@@ -143,14 +141,14 @@ commit = next $ next $ ifM isDirect
   where
 	commitmessage = "git-annex automatic sync"
 
-commitStaged :: String -> Annex Bool
+commitStaged :: Git.Branch.CommitMode -> String -> Annex Bool
-commitStaged commitmessage = go =<< inRepo Git.Branch.currentUnsafe
+commitStaged commitmode commitmessage = go =<< inRepo Git.Branch.currentUnsafe
   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
+		void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch
 			(maybeToList parent)
 		return True
 
@@ -169,11 +167,16 @@ mergeLocal (Just branch) = go =<< needmerge
 	go False = stop
 	go True = do
 		showStart "merge" $ Git.Ref.describe syncbranch
-		next $ next $ autoMergeFrom syncbranch (Just branch)
+		next $ next $ autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit
 
 pushLocal :: Maybe Git.Ref -> CommandStart
-pushLocal Nothing = stop
+pushLocal b = do
-pushLocal (Just branch) = do
+	updateSyncBranch b
+	stop
+
+updateSyncBranch :: Maybe Git.Ref -> Annex ()
+updateSyncBranch Nothing = noop
+updateSyncBranch (Just branch) = do
 	-- Update the sync branch to match the new state of the branch
 	inRepo $ updateBranch $ syncBranch branch
 	-- In direct mode, we're operating on some special direct mode
@@ -181,7 +184,6 @@ pushLocal (Just branch) = do
 	-- branch.
 	whenM isDirect $
 		inRepo $ updateBranch $ fromDirectBranch branch
-	stop
 
 updateBranch :: Git.Ref -> Git.Repo -> IO ()
 updateBranch syncbranch g = 
@@ -217,7 +219,7 @@ mergeRemote remote b = case b of
 	Just thisbranch ->
 		and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b))
   where
-	merge thisbranch = flip autoMergeFrom thisbranch . remoteBranch remote
+	merge thisbranch br = autoMergeFrom (remoteBranch remote br) thisbranch Git.Branch.ManualCommit
 	tomerge = filterM (changed remote)
 	branchlist Nothing = []
 	branchlist (Just branch) = [branch, syncBranch branch]

Command/Unannex.hs

@@ -16,6 +16,7 @@ import qualified Annex
 import Annex.Content
 import Annex.Content.Direct
 import qualified Git.Command
+import qualified Git.Branch
 import qualified Git.Ref
 import qualified Git.DiffTree as DiffTree
 import Utility.CopyFile
@@ -45,9 +46,8 @@ wrapUnannex a = ifM isDirect
 		)
 	)
   where
-	commit = inRepo $ Git.Command.run
+	commit = inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
-		[ Param "commit"
+		[ Param "-q"
-		, Param "-q"
 		, Param "--allow-empty"
 		, Param "--no-verify"
 		, Param "-m", Param "content removed from git annex"

Command/Uninit.hs

@@ -16,6 +16,10 @@ import qualified Command.Unannex
 import qualified Annex.Branch
 import Annex.Content
 import Annex.Init
+import Utility.FileMode
+
+import System.IO.HVFS
+import System.IO.HVFS.Utils
 
 def :: [Command]
 def = [addCheck check $ command "uninit" paramPaths seek 
@@ -56,6 +60,7 @@ finish = do
 	annexdir <- fromRepo gitAnnexDir
 	annexobjectdir <- fromRepo gitAnnexObjectDir
 	leftovers <- removeUnannexed =<< getKeysPresent InAnnex
+	liftIO $ prepareRemoveAnnexDir annexdir
 	if null leftovers
 		then liftIO $ removeDirectoryRecursive annexdir
 		else error $ unlines
@@ -82,6 +87,12 @@ finish = do
 		[Param "branch", Param "-D", Param $ Git.fromRef Annex.Branch.name]
 	liftIO exitSuccess
 
+{- Turn on write bits in all remaining files in the annex directory, in
+ - preparation for removal. -}
+prepareRemoveAnnexDir :: FilePath -> IO ()
+prepareRemoveAnnexDir annexdir =
+	recurseDir SystemFS annexdir >>= mapM_ (void . tryIO . allowWrite)
+
 {- Keys that were moved out of the annex have a hard link still in the
  - annex, with > 1 link count, and those can be removed.
  -

Command/Unused.hs

@@ -10,9 +10,6 @@
 module Command.Unused where
 
 import qualified Data.Set as S
-import Data.BloomFilter
-import Data.BloomFilter.Easy
-import Data.BloomFilter.Hash
 import Control.Monad.ST
 import qualified Data.Map as M
 
@@ -36,6 +33,7 @@ import Annex.CatFile
 import Types.Key
 import Git.FilePath
 import Logs.View (is_branchView)
+import Utility.Bloom
 
 def :: [Command]
 def = [withOptions [unusedFromOption] $ command "unused" paramNothing seek

Command/Vicfg.hs

@@ -139,9 +139,11 @@ genCfg cfg descs = unlines $ intercalate [""]
 	  	grouplist = unwords $ map fromStandardGroup [minBound..]
 
 	preferredcontent = settings cfg descs cfgPreferredContentMap
-		[ com "Repository preferred contents" ]
+		[ com "Repository preferred contents"
+		, com "(Set to \"standard\" to use a repository's group's preferred contents)"
+		]
 		(\(s, u) -> line "wanted" u s)
-		(\u -> line "wanted" u "standard")
+		(\u -> line "wanted" u "")
 	
 	requiredcontent = settings cfg descs cfgRequiredContentMap
 		[ com "Repository required contents" ]
@@ -153,7 +155,7 @@ genCfg cfg descs = unlines $ intercalate [""]
 		, com "(Used by repositories with \"groupwanted\" in their preferred contents)"
 		]
 		(\(s, g) -> gline g s)
-		(\g -> gline g "standard")
+		(\g -> gline g "")
 	  where
 	  	gline g value = [ unwords ["groupwanted", g, "=", value] ]
 		allgroups = S.unions $ stdgroups : M.elems (cfgGroupMap cfg)

Git/Branch.hs

@@ -14,6 +14,7 @@ import Git
 import Git.Sha
 import Git.Command
 import qualified Git.Ref
+import qualified Git.BuildVersion
 
 {- The currently checked out branch.
  -
@@ -103,6 +104,31 @@ fastForward branch (first:rest) repo =
 			(False, True) -> findbest c rs -- worse
 			(False, False) -> findbest c rs -- same
 
+{- The user may have set commit.gpgsign, indending all their manual
+ - commits to be signed. But signing automatic/background commits could
+ - easily lead to unwanted gpg prompts or failures.
+ -}
+data CommitMode = ManualCommit | AutomaticCommit
+	deriving (Eq)
+
+applyCommitMode :: CommitMode -> [CommandParam] -> [CommandParam]
+applyCommitMode commitmode ps
+	| commitmode == AutomaticCommit && not (Git.BuildVersion.older "2.0.0") =
+		Param "--no-gpg-sign" : ps
+	| otherwise = ps
+
+{- Commit via the usual git command. -}
+commitCommand :: CommitMode -> [CommandParam] -> Repo -> IO Bool
+commitCommand = commitCommand' runBool
+
+{- Commit will fail when the tree is clean. This suppresses that error. -}
+commitQuiet :: CommitMode -> [CommandParam] -> Repo -> IO ()
+commitQuiet commitmode ps = void . tryIO . commitCommand' runQuiet commitmode ps
+
+commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> [CommandParam] -> Repo -> IO a
+commitCommand' runner commitmode ps = runner $
+	Param "commit" : applyCommitMode commitmode ps
+
 {- Commits the index into the specified branch (or other ref), 
  - with the specified parent refs, and returns the committed sha.
  -
@@ -112,30 +138,31 @@ fastForward branch (first:rest) repo =
  - Unlike git-commit, does not run any hooks, or examine the work tree
  - in any way.
  -}
-commit :: Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
+commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
-commit allowempty message branch parentrefs repo = do
+commit commitmode allowempty message branch parentrefs repo = do
 	tree <- getSha "write-tree" $
 		pipeReadStrict [Param "write-tree"] repo
 	ifM (cancommit tree)
 		( do
-			sha <- getSha "commit-tree" $ pipeWriteRead
+			sha <- getSha "commit-tree" $
-				(map Param $ ["commit-tree", fromRef tree] ++ ps)
+				pipeWriteRead ([Param "commit-tree", Param (fromRef tree)] ++ ps) sendmsg repo
-				(Just $ flip hPutStr message) repo
 			update branch sha repo
 			return $ Just sha
 		, return Nothing
 		)
   where
-	ps = concatMap (\r -> ["-p", fromRef r]) parentrefs
+	ps = applyCommitMode commitmode $
+		map Param $ concatMap (\r -> ["-p", fromRef r]) parentrefs
 	cancommit tree
 		| allowempty = return True
 		| otherwise = case parentrefs of
 			[p] -> maybe False (tree /=) <$> Git.Ref.tree p repo
 			_ -> return True
+	sendmsg = Just $ flip hPutStr message
 
-commitAlways :: String -> Branch -> [Ref] -> Repo -> IO Sha
+commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha
-commitAlways message branch parentrefs repo = fromJust
+commitAlways commitmode message branch parentrefs repo = fromJust
-	<$> commit True message branch parentrefs repo
+	<$> commit commitmode True message branch parentrefs repo
 
 {- A leading + makes git-push force pushing a branch. -}
 forcePush :: String -> String

Git/Command.hs

@@ -13,7 +13,6 @@ import Common
 import Git
 import Git.Types
 import qualified Utility.CoProcess as CoProcess
-import Utility.Batch
 
 {- Constructs a git command line operating on the specified repo. -}
 gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
@@ -31,12 +30,6 @@ runBool :: [CommandParam] -> Repo -> IO Bool
 runBool params repo = assertLocal repo $
 	boolSystemEnv "git" (gitCommandLine params repo) (gitEnv repo)
 
-{- Runs git in batch mode. -}
-runBatch :: BatchCommandMaker -> [CommandParam] -> Repo -> IO Bool
-runBatch batchmaker params repo = assertLocal repo $ do
-	let (cmd, params') = batchmaker ("git", gitCommandLine params repo)
-	boolSystemEnv cmd params' (gitEnv repo)
-
 {- Runs git in the specified repo, throwing an error if it fails. -}
 run :: [CommandParam] -> Repo -> IO ()
 run params repo = assertLocal repo $

Git/Command/Batch.hs

@@ -0,0 +1,19 @@
+{- running batch git commands
+ -
+ - Copyright 2010-2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Git.Command.Batch where
+
+import Common
+import Git
+import Git.Command
+import Utility.Batch
+
+{- Runs git in batch mode. -}
+run :: BatchCommandMaker -> [CommandParam] -> Repo -> IO Bool
+run batchmaker params repo = assertLocal repo $ do
+	let (cmd, params') = batchmaker ("git", gitCommandLine params repo)
+	boolSystemEnv cmd params' (gitEnv repo)

Git/GCrypt.hs

@@ -99,6 +99,9 @@ getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
 remoteParticipantConfigKey :: RemoteName -> String
 remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants"
 
+remotePublishParticipantConfigKey :: RemoteName -> String
+remotePublishParticipantConfigKey = remoteConfigKey "gcrypt-publish-participants"
+
 remoteSigningKey :: RemoteName -> String
 remoteSigningKey = remoteConfigKey "gcrypt-signingkey"
 

Git/Merge.hs

@@ -11,14 +11,19 @@ import Common
 import Git
 import Git.Command
 import Git.BuildVersion
+import Git.Branch (CommitMode(..))
 
 {- Avoids recent git's interactive merge. -}
-mergeNonInteractive :: Ref -> Repo -> IO Bool
+mergeNonInteractive :: Ref -> CommitMode -> Repo -> IO Bool
-mergeNonInteractive branch
+mergeNonInteractive branch commitmode
 	| older "1.7.7.6" = merge [Param $ fromRef branch]
-	| otherwise = merge [Param "--no-edit", Param $ fromRef branch]
+	| otherwise = merge $ [Param "--no-edit", Param $ fromRef branch]
   where
-	merge ps = runBool $ Param "merge" : ps
+	merge ps = runBool $ cp ++ [Param "merge"] ++ ps
+	cp
+		| commitmode == AutomaticCommit =
+			[Param "-c", Param "commit.gpgsign=false"]
+		| otherwise = []
 
 {- Stage the merge into the index, but do not commit it.-}
 stageMerge :: Ref -> Repo -> IO Bool

Git/Queue.hs

@@ -82,15 +82,15 @@ new lim = Queue 0 (fromMaybe defaultLimit lim) M.empty
  -}
 addCommand :: String -> [CommandParam] -> [FilePath] -> Queue -> Repo -> IO Queue
 addCommand subcommand params files q repo =
-	updateQueue action different (length newfiles) q repo
+	updateQueue action different (length files) q repo
   where
 	key = actionKey action
 	action = CommandAction
 		{ getSubcommand = subcommand
 		, getParams = params
-		, getFiles = newfiles
+		, getFiles = allfiles
 		}
-	newfiles = map File files ++ maybe [] getFiles (M.lookup key $ items q)
+	allfiles = map File files ++ maybe [] getFiles (M.lookup key $ items q)
 	
 	different (CommandAction { getSubcommand = s }) = s /= subcommand
 	different _ = True

Locations.hs

@@ -42,6 +42,7 @@ module Locations (
 	gitAnnexJournalDir,
 	gitAnnexJournalLock,
 	gitAnnexPreCommitLock,
+	gitAnnexMergeLock,
 	gitAnnexIndex,
 	gitAnnexIndexStatus,
 	gitAnnexViewIndex,
@@ -262,6 +263,10 @@ gitAnnexJournalLock r = gitAnnexDir r </> "journal.lck"
 gitAnnexPreCommitLock :: Git.Repo -> FilePath
 gitAnnexPreCommitLock r = gitAnnexDir r </> "precommit.lck"
 
+{- Lock file for direct mode merge. -}
+gitAnnexMergeLock :: Git.Repo -> FilePath
+gitAnnexMergeLock r = gitAnnexDir r </> "merge.lck"
+
 {- .git/annex/index is used to stage changes to the git-annex branch -}
 gitAnnexIndex :: Git.Repo -> FilePath
 gitAnnexIndex r = gitAnnexDir r </> "index"

Logs/MetaData.hs

@@ -95,10 +95,12 @@ addMetaData k metadata = addMetaData' k metadata =<< liftIO getPOSIXTime
  - will tend to be generated across the different log files, and so
  - git will be able to pack the data more efficiently. -}
 addMetaData' :: Key -> MetaData -> POSIXTime -> Annex ()
-addMetaData' k (MetaData m) now = Annex.Branch.change (metaDataLogFile k) $
+addMetaData' k d@(MetaData m) now
-	showLog . simplifyLog 
+	| d == emptyMetaData = noop
-		. S.insert (LogEntry now metadata)
+	| otherwise = Annex.Branch.change (metaDataLogFile k) $
-		. parseLog
+		showLog . simplifyLog 
+			. S.insert (LogEntry now metadata)
+			. parseLog
   where
 	metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m
 

Makefile

@@ -59,7 +59,7 @@ retest: git-annex
 
 # hothasktags chokes on some template haskell etc, so ignore errors
 tags:
-	find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$' | xargs hothasktags > tags 2>/dev/null
+	(for f in $$(find . | grep -v /.git/ | grep -v /tmp/ | grep -v /dist/ | grep -v /doc/ | egrep '\.hs$$'); do hothasktags -c --cpp -c -traditional -c --include=dist/build/autogen/cabal_macros.h $$f; done) 2>/dev/null | sort > tags
 
 # If ikiwiki is available, build static html docs suitable for being
 # shipped in the software package.
@@ -83,7 +83,8 @@ clean:
 	rm -rf tmp dist git-annex $(mans) configure  *.tix .hpc \
 		doc/.ikiwiki html dist tags Build/SysConfig.hs build-stamp \
 		Setup Build/InstallDesktopFile Build/EvilSplicer \
-		Build/Standalone Build/OSXMkLibs Build/LinuxMkLibs Build/DistributionUpdate \
+		Build/Standalone Build/OSXMkLibs Build/LinuxMkLibs \
+		Build/DistributionUpdate Build/BuildVersion \
 		git-union-merge .tasty-rerun-log
 	find . -name \*.o -exec rm {} \;
 	find . -name \*.hi -exec rm {} \;
@@ -255,7 +256,7 @@ hdevtools:
 distributionupdate:
 	git pull
 	cabal configure
-	ghc --make Build/DistributionUpdate -XPackageImports -optP-include -optPdist/build/autogen/cabal_macros.h
+	ghc -Wall --make Build/DistributionUpdate -XPackageImports -optP-include -optPdist/build/autogen/cabal_macros.h
 	./Build/DistributionUpdate
 
 .PHONY: git-annex git-union-merge git-recover-repository tags build-stamp

Remote/GCrypt.hs

@@ -263,10 +263,14 @@ shellOrRsync r ashell arsync = case method of
  - participants, which gcrypt requires is the case, and may not be
  - depending on system configuration.
  -
- - (For shared encryption, gcrypt's default behavior is used.) -}
+ - (For shared encryption, gcrypt's default behavior is used.)
+ -
+ - Also, sets gcrypt-publish-participants to avoid unncessary gpg
+ - passphrase prompts.
+ -}
 setGcryptEncryption :: RemoteConfig -> String -> Annex ()
 setGcryptEncryption c remotename = do
-	let participants = ConfigKey $ Git.GCrypt.remoteParticipantConfigKey remotename
+	let participants = remoteconfig Git.GCrypt.remoteParticipantConfigKey
 	case extractCipher c of
 		Nothing -> noCrypto
 		Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) -> do
@@ -278,6 +282,10 @@ setGcryptEncryption c remotename = do
 				(k:_) -> setConfig signingkey k
 		Just (SharedCipher _) ->
 			unsetConfig participants
+	setConfig (remoteconfig Git.GCrypt.remotePublishParticipantConfigKey)
+		(Git.Config.boolConfig True)
+  where
+	remoteconfig n = ConfigKey $ n remotename
 
 store :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 store r rsyncopts (cipher, enck) k p

Remote/Git.hs

@@ -191,20 +191,11 @@ tryGitConfigRead r
 	| Git.repoIsHttp r = store geturlconfig
 	| Git.GCrypt.isEncrypted r = handlegcrypt =<< getConfigMaybe (remoteConfig r "uuid")
 	| Git.repoIsUrl r = return r
-	| otherwise = store $ safely $ do
+	| otherwise = store $ liftIO $ 
-		s <- Annex.new r
+		readlocalannexconfig `catchNonAsync` (const $ return r)
-		Annex.eval s $ do
-			Annex.BranchState.disableUpdate
-			ensureInitialized
-			Annex.getState Annex.repo
   where
 	haveconfig = not . M.null . Git.config
 
-	-- Reading config can fail due to IO error or
-	-- for other reasons; catch all possible exceptions.
-	safely a = either (const $ return r) return
-			=<< liftIO (try a :: IO (Either SomeException Git.Repo))
-
 	pipedconfig cmd params = do
 		v <- Git.Config.fromPipe r cmd params
 		case v of
@@ -283,6 +274,16 @@ tryGitConfigRead r
 			Just v -> store $ liftIO $ setUUID r $
 				genUUIDInNameSpace gCryptNameSpace v
 
+	{- The local repo may not yet be initialized, so try to initialize
+	 - it if allowed. However, if that fails, still return the read
+	 - git config. -}
+	readlocalannexconfig = do
+		s <- Annex.new r
+		Annex.eval s $ do
+			Annex.BranchState.disableUpdate
+			void $ tryAnnex $ ensureInitialized
+			Annex.getState Annex.repo
+
 {- Checks if a given remote has the content for a key inAnnex.
  - If the remote cannot be accessed, or if it cannot determine
  - whether it has the content, returns a Left error message.

Remote/Helper/Hooks.hs

@@ -15,7 +15,7 @@ import Common.Annex
 import Types.Remote
 import Types.CleanupActions
 import qualified Annex
-import Annex.LockPool
+import Annex.LockFile
 #ifndef mingw32_HOST_OS
 import Annex.Perms
 #else
@@ -48,7 +48,7 @@ runHooks :: Remote -> Maybe String -> Maybe String -> Annex a -> Annex a
 runHooks r starthook stophook a = do
 	dir <- fromRepo gitAnnexRemotesDir
 	let lck = dir </> remoteid ++ ".lck"
-	whenM (notElem lck . M.keys <$> getPool) $ do
+	whenM (notElem lck . M.keys <$> getLockPool) $ do
 		liftIO $ createDirectoryIfMissing True dir
 		firstrun lck
 	a
@@ -63,7 +63,7 @@ runHooks r starthook stophook a = do
 		-- of it from running the stophook. If another
 		-- instance is shutting down right now, this
 		-- will block waiting for its exclusive lock to clear.
-		lockFile lck
+		lockFileShared lck
 
 		-- The starthook is run even if some other git-annex
 		-- is already running, and ran it before.

Remote/S3.hs

@@ -255,20 +255,28 @@ iaMunge = (>>= munge)
 		| isSpace c = []
 		| otherwise = "&" ++ show (ord c) ++ ";"
 
+{- Generate the bucket if it does not already exist, including creating the
+ - UUID file within the bucket.
+ -
+ - To check if the bucket exists, ask for its location. However, some ACLs
+ - can allow read/write to buckets, but not querying location, so first
+ - check if the UUID file already exists and we can skip doing anything.
+ -}
 genBucket :: RemoteConfig -> UUID -> Annex ()
 genBucket c u = do
 	conn <- s3ConnectionRequired c u
 	showAction "checking bucket"
-	loc <- liftIO $ getBucketLocation conn bucket 
+	unlessM ((== Right True) <$> checkUUIDFile c u conn) $ do
-	case loc of
+		loc <- liftIO $ getBucketLocation conn bucket
-		Right _ -> writeUUIDFile c u
+		case loc of
-		Left err@(NetworkError _) -> s3Error err
+			Right _ -> writeUUIDFile c u
-		Left (AWSError _ _) -> do
+			Left err@(NetworkError _) -> s3Error err
-			showAction $ "creating bucket in " ++ datacenter
+			Left (AWSError _ _) -> do
-			res <- liftIO $ createBucketIn conn bucket datacenter
+				showAction $ "creating bucket in " ++ datacenter
-			case res of
+				res <- liftIO $ createBucketIn conn bucket datacenter
-				Right _ -> writeUUIDFile c u
+				case res of
-				Left err -> s3Error err
+					Right _ -> writeUUIDFile c u
+					Left err -> s3Error err
   where
 	bucket = fromJust $ getBucket c
 	datacenter = fromJust $ M.lookup "datacenter" c
@@ -284,20 +292,38 @@ genBucket c u = do
 writeUUIDFile :: RemoteConfig -> UUID -> Annex ()
 writeUUIDFile c u = do
 	conn <- s3ConnectionRequired c u
-	go conn =<< liftIO (tryNonAsync $ getObject conn $ mkobject L.empty)
+	v <- checkUUIDFile  c u conn
+	case v of
+		Left e -> error e
+		Right True -> return ()
+		Right False -> do
+			let object = setStorageClass (getStorageClass c) (mkobject uuidb)
+			either s3Error return =<< liftIO (sendObject conn object)
   where
-	go _conn (Right (Right o)) = unless (obj_data o == uuidb) $
+	file = uuidFile c
-		error $ "This bucket is already in use by a different S3 special remote, with UUID: " ++ show (obj_data o)
-	go conn _ = do
-		let object = setStorageClass (getStorageClass c) (mkobject uuidb)
-		either s3Error return =<< liftIO (sendObject conn object)
-
-	file = filePrefix c ++ "annex-uuid"
 	uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]
 	bucket = fromJust $ getBucket c
 
 	mkobject = S3Object bucket file "" (getXheaders c)
 
+{- Checks if the UUID file exists in the bucket and has the specified UUID already. -}
+checkUUIDFile :: RemoteConfig -> UUID -> AWSConnection -> Annex (Either String Bool)
+checkUUIDFile c u conn = check <$> liftIO (tryNonAsync $ getObject conn $ mkobject L.empty)
+  where
+	check (Right (Right o))
+		| obj_data o == uuidb = Right True
+		| otherwise = Left $ "This bucket is already in use by a different S3 special remote, with UUID: " ++ show (obj_data o)
+	check _ = Right False
+
+	uuidb = L.fromChunks [T.encodeUtf8 $ T.pack $ fromUUID u]
+	bucket = fromJust $ getBucket c
+	file = uuidFile c
+
+	mkobject = S3Object bucket file "" (getXheaders c)
+
+uuidFile :: RemoteConfig -> FilePath
+uuidFile c = filePrefix c ++ "annex-uuid"
+
 s3ConnectionRequired :: RemoteConfig -> UUID -> Annex AWSConnection
 s3ConnectionRequired c u =
 	maybe (error "Cannot connect to S3") return =<< s3Connection c u

Test.hs

@@ -22,9 +22,7 @@ import qualified Options.Applicative.Types as Opt
 #endif
 import Control.Exception.Extensible
 import qualified Data.Map as M
-import System.IO.HVFS (SystemFS(..))
 import qualified Text.JSON
-import System.Path
 
 import Common
 
@@ -78,6 +76,7 @@ import qualified Utility.Hash
 import qualified Utility.Scheduled
 import qualified Utility.HumanTime
 import qualified Utility.ThreadScheduler
+import qualified Command.Uninit
 #ifndef mingw32_HOST_OS
 import qualified CmdLine.GitAnnex as GitAnnex
 import qualified Remote.Helper.Encryptable
@@ -218,10 +217,11 @@ unitTests note gettestenv = testGroup ("Unit Tests " ++ note)
 	, 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 symlink bit" test_conflict_resolution_symlink_bit
 	, 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 "conflict resolution (nonannexed file)" test_nonannexed_file_conflict_resolution
+	, check "conflict resolution (nonannexed symlink)" test_nonannexed_symlink_conflict_resolution
 	, check "map" test_map
 	, check "uninit" test_uninit
 	, check "uninit (in git-annex branch)" test_uninit_inbranch
@@ -857,6 +857,7 @@ test_conflict_resolution testenv =
 		let v = filter (variantprefix `isPrefixOf`) l
 		length v == 2
 			@? (what ++ " not exactly 2 variant files in: " ++ show l)
+		conflictor `notElem` l @? ("conflictor still present after conflict resolution")
 		indir testenv d $ do
 			git_annex testenv "get" v @? "get failed"
 			git_annex_expectoutput testenv "find" v v
@@ -946,14 +947,14 @@ test_remove_conflict_resolution testenv = do
 		length v == 1
 			@? (what ++ " too many variant files in: " ++ show v)
 
-{- Check merge confalict resolution when a file is annexed in one repo,
+ {- Check merge confalict resolution when a file is annexed in one repo,
- - and checked directly into git in the other repo.
+  - and checked directly into git in the other repo.
- -
+  -
- - This test requires indirect mode to set it up, but tests both direct and
+  - This test requires indirect mode to set it up, but tests both direct and
- - indirect mode.
+  - indirect mode.
- -}
+  -}
-test_nonannexed_conflict_resolution :: TestEnv -> Assertion
+test_nonannexed_file_conflict_resolution :: TestEnv -> Assertion
-test_nonannexed_conflict_resolution testenv = do
+test_nonannexed_file_conflict_resolution testenv = do
 	check True False
 	check False False
 	check True True
@@ -995,6 +996,57 @@ test_nonannexed_conflict_resolution testenv = do
 		s == Just nonannexed_content
 			@? (what ++ " wrong content for nonannexed file: " ++ show s)
 
+
+{- Check merge confalict resolution when a file is annexed in one repo,
+ - and is a non-git-annex symlink in the other repo.
+ -
+ - Test can only run when coreSymlinks is supported, because git needs to
+ - be able to check out the non-git-annex symlink.
+ -}
+test_nonannexed_symlink_conflict_resolution :: TestEnv -> Assertion
+test_nonannexed_symlink_conflict_resolution testenv = do
+	check True False
+	check False False
+	check True True
+	check False True
+  where
+	check inr1 switchdirect = withtmpclonerepo testenv False $ \r1 ->
+		withtmpclonerepo testenv False $ \r2 -> do
+			whenM (checkRepo (Types.coreSymlinks <$> Annex.getGitConfig) r1
+			       <&&> isInDirect r1 <&&> isInDirect r2) $ do
+				indir testenv r1 $ do
+					disconnectOrigin
+					writeFile conflictor "conflictor"
+					git_annex testenv "add" [conflictor] @? "add conflicter failed"
+					git_annex testenv "sync" [] @? "sync failed in r1"
+				indir testenv r2 $ do
+					disconnectOrigin
+					createSymbolicLink symlinktarget "conflictor"
+					boolSystem "git" [Params "add", File conflictor] @? "git add conflictor failed"
+					git_annex testenv "sync" [] @? "sync failed in r2"
+				pair testenv r1 r2
+				let l = if inr1 then [r1, r2] else [r2, r1]
+				forM_ l $ \r -> indir testenv r $ do
+					when switchdirect $
+						git_annex testenv "direct" [] @? "failed switching to direct mode"
+					git_annex testenv "sync" [] @? "sync failed"
+				checkmerge ("r1" ++ show switchdirect) r1
+				checkmerge ("r2" ++ show switchdirect) r2
+	conflictor = "conflictor"
+	symlinktarget = "dummy-target"
+	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 (readSymbolicLink (d </> conflictor))
+		s == Just symlinktarget
+			@? (what ++ " wrong target for nonannexed symlink: " ++ 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.
@@ -1045,8 +1097,8 @@ test_uncommitted_conflict_resolution testenv = do
 {- 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_symlink_bit :: TestEnv -> Assertion
-test_conflict_resolution_symlinks testenv = do
+test_conflict_resolution_symlink_bit testenv = do
 	withtmpclonerepo testenv False $ \r1 ->
 		withtmpclonerepo testenv False $ \r2 -> do
 			withtmpclonerepo testenv False $ \r3 -> do
@@ -1360,10 +1412,13 @@ intmpclonerepoInDirect testenv a = intmpclonerepo testenv $
 		Annex.Init.initialize Nothing
 		Config.isDirect
 
-isInDirect :: FilePath -> IO Bool
+checkRepo :: Types.Annex a -> FilePath -> IO a
-isInDirect d = do
+checkRepo getval d = do
 	s <- Annex.new =<< Git.Construct.fromPath d
-	not <$> Annex.eval s Config.isDirect
+	Annex.eval s getval
+
+isInDirect :: FilePath -> IO Bool
+isInDirect = checkRepo (not <$> Config.isDirect)
 
 intmpbareclonerepo :: TestEnv -> Assertion -> Assertion
 intmpbareclonerepo testenv a = withtmpclonerepo testenv True $ \r -> indir testenv r a
@@ -1406,9 +1461,9 @@ clonerepo testenv old new bare = do
 	ensuretmpdir
 	let b = if bare then " --bare" else ""
 	boolSystem "git" [Params ("clone -q" ++ b), File old, File new] @? "git clone failed"
+	configrepo testenv new
 	indir testenv new $
 		git_annex testenv "init" ["-q", new] @? "git annex init failed"
-	configrepo testenv new
 	unless bare $
 		indir testenv new $
 			handleforcedirect testenv
@@ -1416,8 +1471,11 @@ clonerepo testenv old new bare = do
 
 configrepo :: TestEnv -> FilePath -> IO ()
 configrepo testenv dir = indir testenv dir $ do
+	-- ensure git is set up to let commits happen
 	boolSystem "git" [Params "config user.name", Param "Test User"] @? "git config failed"
 	boolSystem "git" [Params "config user.email test@example.com"] @? "git config failed"
+	-- avoid signed commits by test suite
+	boolSystem "git" [Params "config commit.gpgsign false"] @? "git config failed"
 
 handleforcedirect :: TestEnv -> IO ()
 handleforcedirect testenv = when (M.lookup "FORCEDIRECT" testenv == Just "1") $
@@ -1434,11 +1492,7 @@ cleanup = cleanup' False
 
 cleanup' :: Bool -> FilePath -> IO ()
 cleanup' final dir = whenM (doesDirectoryExist dir) $ do
-	-- Allow all files and directories to be written to, so
+	Command.Uninit.prepareRemoveAnnexDir dir
-	-- they can be deleted. Both git and git-annex use file
-	-- permissions to prevent deletion.
-	recurseDir SystemFS dir >>=
-		mapM_ (void . tryIO . Utility.FileMode.allowWrite)
 	-- This sometimes fails on Windows, due to some files
 	-- being still opened by a subprocess.
 	catchIO (removeDirectoryRecursive dir) $ \e ->

Types/Backend.hs

@@ -17,6 +17,7 @@ data BackendA a = Backend
 	, getKey :: KeySource -> a (Maybe Key) 
 	, fsckKey :: Maybe (Key -> FilePath -> a Bool)
 	, canUpgradeKey :: Maybe (Key -> Bool)
+	, fastMigrate :: Maybe (Key -> BackendA a -> Maybe Key)
 	}
 
 instance Show (BackendA a) where

Utility/Bloom.hs

@@ -0,0 +1,60 @@
+{- bloomfilter compatability wrapper
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - License: BSD-2-clause
+ -}
+
+{-# LANGUAGE CPP #-}
+
+module Utility.Bloom (
+	Bloom,
+	suggestSizing,
+	Hashable,
+	cheapHashes,
+	notElemB,
+
+	newMB,
+	insertMB,
+	unsafeFreezeMB,
+) where
+
+#if MIN_VERSION_bloomfilter(2,0,0)
+import qualified Data.BloomFilter.Mutable as MBloom
+import qualified Data.BloomFilter as Bloom
+#else
+import qualified Data.BloomFilter as Bloom
+#endif
+import Data.BloomFilter.Easy (suggestSizing, Bloom)
+import Data.BloomFilter.Hash (Hashable, cheapHashes)
+import Control.Monad.ST.Safe (ST)
+
+#if MIN_VERSION_bloomfilter(2,0,0)
+
+notElemB :: a -> Bloom a -> Bool
+notElemB = Bloom.notElem
+
+newMB :: (a -> [Bloom.Hash]) -> Int -> ST s (MBloom.MBloom s a)
+newMB = MBloom.new
+
+insertMB :: MBloom.MBloom s a -> a -> ST s ()
+insertMB = MBloom.insert
+
+unsafeFreezeMB :: MBloom.MBloom s a -> ST s (Bloom a)
+unsafeFreezeMB = Bloom.unsafeFreeze
+
+#else
+
+notElemB :: a -> Bloom a -> Bool
+notElemB = Bloom.notElemB
+
+newMB :: (a -> [Bloom.Hash]) -> Int -> ST s (Bloom.MBloom s a)
+newMB = Bloom.newMB
+
+insertMB :: Bloom.MBloom s a -> a -> ST s ()
+insertMB = Bloom.insertMB
+
+unsafeFreezeMB :: Bloom.MBloom s a -> ST s (Bloom a)
+unsafeFreezeMB = Bloom.unsafeFreezeMB
+
+#endif

Utility/Daemon.hs

@@ -21,6 +21,8 @@ import Utility.WinLock
 #ifndef mingw32_HOST_OS
 import System.Posix
 import Control.Concurrent.Async
+#else
+import System.Exit
 #endif
 
 #ifndef mingw32_HOST_OS
@@ -54,15 +56,26 @@ daemonize logfd pidfile changedirectory a = do
 		wait =<< asyncWithUnmask (\unmask -> unmask a)
 		out
 	out = exitImmediately ExitSuccess
+#endif
 
 {- To run an action that is normally daemonized in the forground. -}
+#ifndef mingw32_HOST_OS
 foreground :: Fd -> Maybe FilePath -> IO () -> IO ()
 foreground logfd pidfile a = do
+#else
+foreground :: Maybe FilePath -> IO () -> IO ()
+foreground pidfile a = do
+#endif
 	maybe noop lockPidFile pidfile
+#ifndef mingw32_HOST_OS
 	_ <- tryIO createSession
 	redirLog logfd
+#endif
 	a
+#ifndef mingw32_HOST_OS
 	exitImmediately ExitSuccess
+#else
+	exitWith ExitSuccess
 #endif
 
 {- Locks the pid file, with an exclusive, non-blocking lock,

Utility/Directory.hs

@@ -1,4 +1,4 @@
-{- directory manipulation
+{- directory traversal and manipulation
  -
  - Copyright 2011-2014 Joey Hess <joey@kitenet.net>
  -
@@ -11,12 +11,20 @@ module Utility.Directory where
 
 import System.IO.Error
 import System.Directory
-import Control.Exception (throw)
+import Control.Exception (throw, bracket)
 import Control.Monad
 import Control.Monad.IfElse
 import System.FilePath
 import Control.Applicative
+import Control.Concurrent
 import System.IO.Unsafe (unsafeInterleaveIO)
+import Data.Maybe
+
+#ifdef mingw32_HOST_OS
+import qualified System.Win32 as Win32
+#else
+import qualified System.Posix as Posix
+#endif
 
 import Utility.PosixFiles
 import Utility.SafeCommand
@@ -133,3 +141,90 @@ nukeFile file = void $ tryWhenExists go
 #else
 	go = removeFile file
 #endif
+
+#ifndef mingw32_HOST_OS
+data DirectoryHandle = DirectoryHandle IsOpen Posix.DirStream
+#else
+data DirectoryHandle = DirectoryHandle IsOpen Win32.HANDLE Win32.FindData (MVar ())
+#endif
+
+type IsOpen = MVar () -- full when the handle is open
+
+openDirectory :: FilePath -> IO DirectoryHandle
+openDirectory path = do
+#ifndef mingw32_HOST_OS
+	dirp <- Posix.openDirStream path
+	isopen <- newMVar ()
+	return (DirectoryHandle isopen dirp)
+#else
+	(h, fdat) <- Win32.findFirstFile (path </> "*")
+	-- Indicate that the fdat contains a filename that readDirectory
+	-- has not yet returned, by making the MVar be full.
+	-- (There's always at least a "." entry.)
+	alreadyhave <- newMVar ()
+	isopen <- newMVar ()
+	return (DirectoryHandle isopen h fdat alreadyhave)
+#endif
+
+closeDirectory :: DirectoryHandle -> IO ()
+#ifndef mingw32_HOST_OS
+closeDirectory (DirectoryHandle isopen dirp) =
+	whenOpen isopen $
+		Posix.closeDirStream dirp
+#else
+closeDirectory (DirectoryHandle isopen h _ alreadyhave) =
+	whenOpen isopen $ do
+		_ <- tryTakeMVar alreadyhave
+		Win32.findClose h
+#endif
+  where
+	whenOpen :: IsOpen -> IO () -> IO ()
+	whenOpen mv f = do
+		v <- tryTakeMVar mv
+		when (isJust v) f
+
+{- |Reads the next entry from the handle. Once the end of the directory
+is reached, returns Nothing and automatically closes the handle.
+-}
+readDirectory :: DirectoryHandle -> IO (Maybe FilePath)
+#ifndef mingw32_HOST_OS
+readDirectory hdl@(DirectoryHandle _ dirp) = do
+	e <- Posix.readDirStream dirp
+	if null e
+		then do
+			closeDirectory hdl
+			return Nothing
+		else return (Just e)
+#else
+readDirectory hdl@(DirectoryHandle _ h fdat mv) = do
+	-- If the MVar is full, then the filename in fdat has
+	-- not yet been returned. Otherwise, need to find the next
+	-- file.
+	r <- tryTakeMVar mv
+	case r of
+		Just () -> getfn
+		Nothing -> do
+			more <- Win32.findNextFile h fdat
+			if more
+				then getfn
+				else do
+					closeDirectory hdl
+					return Nothing
+  where
+	getfn = do
+		filename <- Win32.getFindDataFileName fdat
+		return (Just filename)
+#endif
+
+-- True only when directory exists and contains nothing.
+-- Throws exception if directory does not exist.
+isDirectoryEmpty :: FilePath -> IO Bool
+isDirectoryEmpty d = bracket (openDirectory d) closeDirectory check
+  where
+	check h = do
+		v <- readDirectory h
+		case v of
+			Nothing -> return True
+			Just f
+				| not (dirCruft f) -> return False
+				| otherwise -> check h

Utility/ExternalSHA.hs

@@ -14,6 +14,7 @@ import Utility.SafeCommand
 import Utility.Process
 import Utility.FileSystemEncoding
 import Utility.Misc
+import Utility.Exception
 
 import Data.List
 import Data.Char
@@ -22,7 +23,7 @@ import System.IO
 
 externalSHA :: String -> Int -> FilePath -> IO (Either String String)
 externalSHA command shasize file = do
-	ls <- lines <$> readsha (toCommand [File file])
+	ls <- lines <$> catchDefaultIO "" (readsha (toCommand [File file]))
 	return $ sanitycheck =<< parse ls
   where
 	{- sha commands output the filename, so need to set fileEncoding -}

Utility/LogFile.hs

@@ -15,13 +15,10 @@ import Common
 import System.Posix.Types
 #endif
 
-#ifndef mingw32_HOST_OS
+openLog :: FilePath -> IO Handle
-openLog :: FilePath -> IO Fd
 openLog logfile = do
 	rotateLog logfile
-	openFd logfile WriteOnly (Just stdFileMode)
+	openFile logfile AppendMode
-		defaultFileFlags { append = True }
-#endif
 
 rotateLog :: FilePath -> IO ()
 rotateLog logfile = go 0

Utility/ThreadScheduler.hs

@@ -57,8 +57,7 @@ unboundDelay time = do
 waitForTermination :: IO ()
 waitForTermination = do
 #ifdef mingw32_HOST_OS
-	runEvery (Seconds 600) $
+	forever $ threadDelaySeconds (Seconds 6000)
-		void getLine
 #else
 	lock <- newEmptyMVar
 	let check sig = void $

debian/changelog

@@ -1,3 +1,74 @@
+git-annex (5.20140717) unstable; urgency=high
+
+  * Fix minor FD leak in journal code. Closes: #754608
+  * direct: Fix handling of case where a work tree subdirectory cannot
+    be written to due to permissions.
+  * migrate: Avoid re-checksumming when migrating from hashE to hash backend.
+  * uninit: Avoid failing final removal in some direct mode repositories
+    due to file modes.
+  * S3: Deal with AWS ACL configurations that do not allow creating or
+    checking the location of a bucket, but only reading and writing content to
+    it.
+  * resolvemerge: New plumbing command that runs the automatic merge conflict
+    resolver.
+  * Deal with change in git 2.0 that made indirect mode merge conflict
+    resolution leave behind old files.
+  * sync: Fix git sync with local git remotes even when they don't have an
+    annex.uuid set. (The assistant already did so.)
+  * Set gcrypt-publish-participants when setting up a gcrypt repository,
+    to avoid unncessary passphrase prompts.
+    This is a security/usability tradeoff. To avoid exposing the gpg key
+    ids who can decrypt the repository, users can unset
+    gcrypt-publish-participants.
+  * Install nautilus hooks even when ~/.local/share/nautilus/ does not yet
+    exist, since it is not automatically created for Gnome 3 users.
+  * Windows: Move .vbs files out of git\bin, to avoid that being in the
+    PATH, which caused some weird breakage. (Thanks, divB)
+  * Windows: Fix locking issue that prevented the webapp starting
+    (since 5.20140707).
+
+ -- Joey Hess <joeyh@debian.org>  Thu, 17 Jul 2014 11:27:25 -0400
+
+git-annex (5.20140709) unstable; urgency=medium
+
+  * Fix race in direct mode merge code that could cause all files in the
+    repository to be removed. It should be able to recover repositories
+    experiencing this bug without data loss. See:
+    http://git-annex.branchable.com/bugs/bad_merge_commit_deleting_all_files/
+  * Fix git version that supported --no-gpg-sign.
+  * Fix bug in automatic merge conflict resolution, when one side is an
+    annexed symlink, and the other side is a non-annexed symlink.
+  * Really fix bug that caused the assistant to make many unncessary
+    empty merge commits.
+
+ -- Joey Hess <joeyh@debian.org>  Wed, 09 Jul 2014 15:28:03 -0400
+
+git-annex (5.20140707) unstable; urgency=medium
+
+  * assistant: Fix bug, introduced in last release, that caused the assistant
+    to make many unncessary empty merge commits.
+  * assistant: Fix one-way assistant->assistant sync in direct mode.
+  * Fix bug in annex.queuesize calculation that caused much more
+    queue flushing than necessary.
+  * importfeed: When annex.genmetadata is set, metadata from the feed
+    is added to files that are imported from it.
+  * Support users who have set commit.gpgsign, by disabling gpg signatures
+    for git-annex branch commits and commits made by the assistant.
+  * Fix memory leak when committing millions of changes to the git-annex
+    branch, eg after git-annex add has run on 2 million files in one go.
+  * Support building with bloomfilter 2.0.0.
+  * Run standalone install process when the assistant is started
+    (was only being run when the webapp was opened).
+  * Android: patch git to avoid fchmod, which fails on /sdcard.
+  * Windows: Got rid of that pesky DOS box when starting the webapp.
+  * Windows: Added Startup menu item so assistant starts automatically
+    on login.
+  * Windows: Fix opening file browser from webapp when repo is in a
+    directory with spaces.
+  * Windows: Assistant now logs to daemon.log.
+
+ -- Joey Hess <joeyh@debian.org>  Mon, 07 Jul 2014 12:24:13 -0400
+
 git-annex (5.20140613) unstable; urgency=medium
 
   * Ignore setsid failures.

doc/backends.mdwn

@@ -5,8 +5,8 @@ to retrieve the file's content (its value).
 Multiple pluggable key-value backends are supported, and a single repository
 can use different ones for different files.
 
-* `SHA256E` -- The default backend for new files, combines a SHA256 hash of
+* `SHA256E` -- The default backend for new files, combines a 256 bit SHA-2
-  the file's content with the file's extension. This allows
+  hash of the file's content with the file's extension. This allows
   verifying that the file content is right, and can avoid duplicates of
   files with the same content. Its need to generate checksums
   can make it slower for large files. 
@@ -16,12 +16,13 @@ can use different ones for different files.
   the same basename, size, and modification time has the same content.
   This is the least expensive backend, recommended for really large
   files or slow systems.
-* `SHA512`, `SHA512E` -- Best currently available hash, for the very paranoid.
+* `SHA512`, `SHA512E` -- Best SHA-2 hash, for the very paranoid.
 * `SHA1`, `SHA1E` -- Smaller hash than `SHA256` for those who want a checksum
    but are not concerned about security.
 * `SHA384`, `SHA384E`, `SHA224`, `SHA224E` -- Hashes for people who like
   unusual sizes.
-* `SKEIN512`, `SKEIN256` -- [Skein hash](http://en.wikipedia.org/wiki/Skein_hash),
+* `SKEIN512`, `SKEIN512E`, `SKEIN256`, `SKEIN256E`
+  -- [Skein hash](http://en.wikipedia.org/wiki/Skein_hash),
   a well-regarded SHA3 hash competition finalist.
 
 The `annex.backends` git-config setting can be used to list the backends

doc/bugs/Android_fails_on_Google_Nexus_10_Jellybean.mdwn

@@ -0,0 +1,166 @@
+### Please describe the problem.
+
+Install seems to die because /data/app-lib not found. Sorry, I did not copy. Git-annex log is below. 
+
+I tried To run git-annex second time, here's what terminal says.
+
+
+Falling back to hardcoded app location; cannot find expected files in /data/app-lib
+git annex webapp
+u0_a36@manta:/sdcard/git-annex.home $ git annex webapp
+WARNING: linker: git-annex has text relocations. This is wasting memory and is a security risk. Please fix.
+error: fchmod on /sdcard/mediashare/.git/config.lock failed: Operation not permitted
+error: fchmod on /sdcard/mediashare/.git/config.lock failed: Operation not permitted
+
+From git terminal, can start web viewer, it offers to make repo. I chose /sdcard/mediashare, result is browser fail:
+
+git [Param "config",Param "annex.uuid",Param "380f6ec2-a7b0-43db-9447-f0de1b5a1b5b"] failed
+
+The install did create /sdcard/mediashare. I did have the sdcard directory all along.
+
+I can't say for sure what else is in file system. ES File manager shows /data exists, but it is empty. But tablet not easy to diagnose
+
+### What steps will reproduce the problem?
+
+Install git-annex.apk from website. I downloaded 20140620.
+
+### What version of git-annex are you using? On what operating system?
+
+Android 4.4.2 on Nexus tablet.
+
+### Please provide any additional information below.
+
+Git-anex-install.log. it is only file in /sdcard/git-annex.home. note it says it is installing to /data/data/.  I may manually create that structure and see if a reinstall ends differently.
+
+[[!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
+Installation starting to /data/data/ga.androidterm
+1bebb0d66f3f7c5ac4889b86669cab04ebee9bba
+installing busybox
+installing git-annex
+installing git-shell
+installing git-upload-pack
+installing git
+installing gpg
+installing rsync
+installing ssh
+installing ssh-keygen
+linking ./bin/git-upload-archive to git
+linking ./bin/git-receive-pack to git
+linking ./libexec/git-core/git-help to git
+linking ./libexec/git-core/git-fsck to git
+linking ./libexec/git-core/git-cat-file to git
+linking ./libexec/git-core/git-init to git
+linking ./libexec/git-core/git-checkout-index to git
+linking ./libexec/git-core/git-notes to git
+linking ./libexec/git-core/git-grep to git
+linking ./libexec/git-core/git-blame to git
+linking ./libexec/git-core/git-verify-tag to git
+linking ./libexec/git-core/git-write-tree to git
+linking ./libexec/git-core/git-log to git
+linking ./libexec/git-core/git-stage to git
+linking ./libexec/git-core/git-update-ref to git
+linking ./libexec/git-core/git-status to git
+linking ./libexec/git-core/git-show-branch to git
+linking ./libexec/git-core/git-merge-file to git
+linking ./libexec/git-core/git-for-each-ref to git
+linking ./libexec/git-core/git to git
+linking ./libexec/git-core/git-replace to git
+linking ./libexec/git-core/git-update-index to git
+linking ./libexec/git-core/git-annotate to git
+linking ./libexec/git-core/git-patch-id to git
+linking ./libexec/git-core/git-merge-recursive to git
+linking ./libexec/git-core/git-rm to git
+linking ./libexec/git-core/git-ls-tree to git
+linking ./libexec/git-core/git-update-server-info to git
+linking ./libexec/git-core/git-diff-tree to git
+linking ./libexec/git-core/git-merge-tree to git
+linking ./libexec/git-core/git-mktag to git
+linking ./libexec/git-core/git-rev-list to git
+linking ./libexec/git-core/git-column to git
+linking ./libexec/git-core/git-apply to git
+linking ./libexec/git-core/git-var to git
+linking ./libexec/git-core/git-rev-parse to git
+linking ./libexec/git-core/git-archive to git
+linking ./libexec/git-core/git-verify-pack to git
+linking ./libexec/git-core/git-push to git
+linking ./libexec/git-core/git-commit to git
+linking ./libexec/git-core/git-tag to git
+linking ./libexec/git-core/git-pack-refs to git
+linking ./libexec/git-core/git-fmt-merge-msg to git
+linking ./libexec/git-core/git-fast-export to git
+linking ./libexec/git-core/git-remote-ext to git
+linking ./libexec/git-core/git-mailsplit to git
+linking ./libexec/git-core/git-send-pack to git
+linking ./libexec/git-core/git-diff-index to git
+linking ./libexec/git-core/git-mailinfo to git
+linking ./libexec/git-core/git-revert to git
+linking ./libexec/git-core/git-diff-files to git
+linking ./libexec/git-core/git-merge-ours to git
+linking ./libexec/git-core/git-show-ref to git
+linking ./libexec/git-core/git-diff to git
+linking ./libexec/git-core/git-clean to git
+linking ./libexec/git-core/git-bundle to git
+linking ./libexec/git-core/git-check-mailmap to git
+linking ./libexec/git-core/git-describe to git
+linking ./libexec/git-core/git-branch to git
+linking ./libexec/git-core/git-checkout to git
+linking ./libexec/git-core/git-name-rev to git
+linking ./libexec/git-core/git-gc to git
+linking ./libexec/git-core/git-fetch to git
+linking ./libexec/git-core/git-whatchanged to git
+linking ./libexec/git-core/git-cherry to git
+linking ./libexec/git-core/git-reflog to git
+linking ./libexec/git-core/git-hash-object to git
+linking ./libexec/git-core/git-init-db to git
+linking ./libexec/git-core/git-rerere to git
+linking ./libexec/git-core/git-reset to git
+linking ./libexec/git-core/git-stripspace to git
+linking ./libexec/git-core/git-prune to git
+linking ./libexec/git-core/git-mktree to git
+linking ./libexec/git-core/git-unpack-file to git
+linking ./libexec/git-core/git-remote to git
+linking ./libexec/git-core/git-commit-tree to git
+linking ./libexec/git-core/git-symbolic-ref to git
+linking ./libexec/git-core/git-credential to git
+linking ./libexec/git-core/git-check-ignore to git
+linking ./libexec/git-core/git-shortlog to git
+linking ./libexec/git-core/git-fetch-pack to git
+linking ./libexec/git-core/git-clone to git
+linking ./libexec/git-core/git-mv to git
+linking ./libexec/git-core/git-read-tree to git
+linking ./libexec/git-core/git-merge-subtree to git
+linking ./libexec/git-core/git-ls-remote to git
+linking ./libexec/git-core/git-config to git
+linking ./libexec/git-core/git-cherry-pick to git
+linking ./libexec/git-core/git-merge to git
+linking ./libexec/git-core/git-prune-packed to git
+linking ./libexec/git-core/git-count-objects to git
+linking ./libexec/git-core/git-merge-base to git
+linking ./libexec/git-core/git-index-pack to git
+linking ./libexec/git-core/git-repack to git
+linking ./libexec/git-core/git-show to git
+linking ./libexec/git-core/git-fsck-objects to git
+linking ./libexec/git-core/git-format-patch to git
+linking ./libexec/git-core/git-bisect--helper to git
+linking ./libexec/git-core/git-upload-archive to git
+linking ./libexec/git-core/git-ls-files to git
+linking ./libexec/git-core/git-check-attr to git
+linking ./libexec/git-core/git-get-tar-commit-id to git
+linking ./libexec/git-core/git-remote-fd to git
+linking ./libexec/git-core/git-unpack-objects to git
+linking ./libexec/git-core/git-add to git
+linking ./libexec/git-core/git-check-ref-format to git
+linking ./libexec/git-core/git-merge-index to git
+linking ./libexec/git-core/git-pack-objects to git
+linking ./libexec/git-core/git-receive-pack to git
+linking ./libexec/git-core/git-pack-redundant to git
+linking ./libexec/git-core/git-shell to git-shell
+linking ./libexec/git-core/git-upload-pack to git-upload-pack
+Installation complete
+
+# End of transcript or log.
+"""]]
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/Android_fails_on_Google_Nexus_10_Jellybean/comment_1_b41666c032aeb2d0de35023328391edb._comment

@@ -0,0 +1,25 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="comment 1"
+ date="2014-07-03T20:10:41Z"
+ content="""
+This is not an installation problem; the /data/app-lib message is a red herring.
+
+Is /sdcard/mediashare a directory that already existed? If so, perhaps it's some \"mediashare\" thing that has a even more crippled filesystem than usual. Seems possible, but I don't know. Want to rule it out..
+
+The actual failure seems to be when git tries to write to its config.lock file, and changes its permissions. This is a recent change in git, commit daa22c6f8da466bd7a438f1bc27375fd737ffcf3, \"config: preserve config file permissions on edits\".
+
+[[!language C \"\"\"
++               if (fchmod(fd, st.st_mode & 07777) < 0) {
++                       error(\"fchmod on %s failed: %s\",
++                               lock->filename, strerror(errno));
++                       ret = CONFIG_NO_WRITE;
++                       goto out_free;
++               }
+\"\"\"]]
+
+This seems utterly innocuous; the config file has some mode, and this just sets that same mode back (excluding some high bit flags). But Android goes out of its way to make /sdcard the most craptacular filesystem in use on any Linux system, so I'm not really surprised that it might just refuse all fchmod even when it's a no-op. (This is the only fchmod call currently in git.)
+
+I've patched the bundled git to work around this. Will be a while until there is an updated autobuild..
+"""]]

doc/bugs/Android_fails_on_Google_Nexus_10_Jellybean/comment_2_95ebed938df3db2b6d4ebe4c666c08f8._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="comment 2"
+ date="2014-07-04T17:52:35Z"
+ content="""
+This problem should be fixed in the most recent daily build of git-annex for android. Testing appreciated.
+"""]]

doc/bugs/Assistant_doesn__39__t_check_if_it_can_drop_files.mdwn

@@ -0,0 +1,64 @@
+### Please describe the problem.
+
+The assistant/webapp doesn't drop files from the local (source) repository after transferring it to the 2 backup repositories (numcopies 2), but they are listed with:
+
+    git annex find --want-drop
+
+### What steps will reproduce the problem?
+
+#### mintcream ####
+
+    git init annex
+    cd ~/annex
+    git commit -m "create" --allow-empty
+    git annex init mintcream
+    git annex numcopies 2
+    git annex group here source
+    git config annex.autocommit false
+    git annex webapp
+
+#### liquorice ####
+
+    git init annex
+    cd ~/annex
+    git annex init liquorice
+    git annex group here backup
+
+#### candyfloss ####
+
+    git init annex
+    cd ~/annex
+    git annex init candyfloss
+    git annex group here backup
+
+#### mintcream ####
+
+    (add both backup repositories in webapp as "remote repositories")
+    (copy files into ~/annex directory)
+    git annex add
+    git commit -m "add some files"
+    (use "sync now" to prod assistant into noticing the commit)
+
+### What was I expecting to happen? ###
+
+The assistant to transfer the files to liquorice and candyfloss, then for the assistant to drop the files from mintcream.
+
+### What actually happened? ###
+
+The assistant transfers the files to liquorice and candyfloss. No files are dropped from mintcream.
+
+### What version of git-annex are you using? On what operating system?
+
+git-annex version: 5.20140707-g923b436
+
+Arch Linux (git-annex-bin from AUR)
+
+### Please provide any additional information below.
+
+I wish to retain control of the commits on "master" (annex.autocommit false) but want the assistant to handle moving/dropping the files as required in the background.
+
+    git annex drop --auto
+
+works as expected.
+
+> [[done]]; user misconfiguration. --[[Joey]]

doc/bugs/Assistant_doesn__39__t_check_if_it_can_drop_files/comment_1_f32fbae29e4db039804c0853256c238c._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.2"
+ subject="comment 1"
+ date="2014-07-10T18:48:17Z"
+ content="""
+Reproduced. `git annex sync --content` has the same problem.
+
+Of course, both it and the assistant *do* check if files can be dropped. For some reason, it is deciding it is not safe to drop the file.
+"""]]

doc/bugs/Assistant_doesn__39__t_check_if_it_can_drop_files/comment_2_405bfa00dfd433352c263afe75e94b2c._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.2"
+ subject="user misconfiguration"
+ date="2014-07-10T19:02:00Z"
+ content="""
+Reason is simple: You manually put the repository into the source group, but its preferred content is not set to \"standard\". No matter what group a repository is in, you have to set its preferred content to something, or git-annex will default to assuming you want the repo to retain all files.
+
+So, `git annex wanted mintcream standard` and away you go. You'll also want to set that for the other 2 repos probably..
+"""]]

doc/bugs/Assistant_doesn__39__t_check_if_it_can_drop_files/comment_3_c8cac8d800199ca4d8a65ba72abf678e._comment

@@ -0,0 +1,40 @@
+[[!comment format=mdwn
+ username="CandyAngel"
+ ip="81.111.193.130"
+ subject="comment 3"
+ date="2014-07-11T10:41:23Z"
+ content="""
+Ohhh I see!
+
+I was expecting \"standard\" to be the default because of what vicfg shows..
+
+    # Repository preferred contents
+    # (for web)
+    #wanted 00000000-0000-0000-0000-000000000001 = standard
+    # (for test)
+    #wanted 025d4d21-7648-426c-a406-bb7f27688afe = standard
+
+    # Group preferred contents
+    # (Used by repositories with \"groupwanted\" in their preferred contents)
+    #groupwanted archive = standard
+    #groupwanted backup = standard
+    #groupwanted client = standard
+    #groupwanted incrementalbackup = standard
+    #groupwanted manual = standard
+    #groupwanted public = standard
+    #groupwanted smallarchive = standard
+    #groupwanted source = standard
+    #groupwanted transfer = standard
+
+In my experience with configuration files, a commented out line like this:
+
+    #wanted 025d4d21-7648-426c-a406-bb7f27688afe = standard
+
+without any \"this is an example\" text above it means \"this is the default setting\". Everything in vicfg looks like it is the current settings, rather than just placeholders..
+
+I understand why you need to set the wanted explicitly (at least from the command line), but the way information is shown in vicfg led me to interact with it incorrectly. Would it be worth adding a disclaimer that commented lines are examples, not defaults? As far as I am aware, the logic I explained above (commented line == default) is the \"norm\" in *nix configuration files, which would make vicfg non-intuitive.
+
+All I need to do now is not be so bothered by how messy the git-annex branch looks when the assistant is running things! :D
+
+Thankies
+"""]]

doc/bugs/Assistant_doesn__39__t_check_if_it_can_drop_files/comment_4_ee5fa8a22d1571b0040aa97c4979ef92._comment

@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="CandyAngel"
+ ip="81.111.193.130"
+ subject="comment 4"
+ date="2014-07-11T10:57:58Z"
+ content="""
+Actually, I'm still a little confused.
+
+If git-annex was presuming I wanted to keep all the files as you say, why were they listed in `git annex find --want-drop` and dropped by `git annex drop --auto`?
+
+Shouldn't they have been empty and a no-op respectively?
+
+There seems to be a difference in the behaviour between the command line (wanting to and actually dropping the files) and the assistant (wanting to keep them) for the same settings.
+"""]]

doc/bugs/Assistant_doesn__39__t_check_if_it_can_drop_files/comment_5_eef448b9e3dd1a717430a60d1001a7ee._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.2"
+ subject="comment 5"
+ date="2014-07-11T18:27:44Z"
+ content="""
+The assistant defaults to assuming all files are wanted if there's no preferred content settings, while command-line dropping stuff defaults to assuming no files are wanted (or more accurately, that you'll drop anything you don't want and get anything you do) when there's no preferred content settings. So the default differs, but this only matters when not setting preferred contents.
+
+I agree that the vicfg could be misread, so have changed it.
+"""]]

doc/bugs/Assistant_merge_loop.mdwn

@@ -0,0 +1,19 @@
+The assistant appears to be in a merge loop with at least two of my repos. It's creating thousands of merge commits without any changes. One repository that contains around 600 files that change very very rarely now has 63528 commits.
+
+Here's a screenshot from tig: [[https://ssl.zerodogg.org/~zerodogg/private/tmp/Skjermdump_fra_2014-07-05_07:09:22-2014-07-05.png]]
+
+I can privately provide a copy of the git repo itself if needed.
+
+Using the standalone build, 64bit, on ArchLinux, Fedora 20 and Ubuntu 14.04.
+
+    $ git annex version
+    git-annex version: 5.20140610-g5ec8bcf
+    build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash
+    key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL
+    remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier ddar hook external
+    local repository version: 5
+    supported repository version: 5
+    upgrade supported from repository versions: 0 1 2 4
+
+> [[fixed|done]]. Note that 5.20140708 contained an incomplete fix for this
+> bug. --[[Joey]]

doc/bugs/Assistant_merge_loop/comment_10_8fe176691f0f61c15085d3c38f0ea50f._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawk9nck8WX8-ADF3Fdh5vFo4Qrw1I_bJcR8"
+ nickname="Jon Ander"
+ subject="comment 10"
+ date="2014-07-16T20:32:57Z"
+ content="""
+I have two computers with Debian testing (5.20140529) that aren't having the issue, and one with Debian Sid (5.20140709) that is still creating the empty merge commits
+"""]]

doc/bugs/Assistant_merge_loop/comment_11_6e3a78327c0b813415ebf85e298813d4._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.2"
+ subject="comment 11"
+ date="2014-07-16T20:36:32Z"
+ content="""
+Has the assistant been restarted since git-annex was upgraded to the fixed version?
+
+Can you post a debug.log?
+"""]]

doc/bugs/Assistant_merge_loop/comment_1_ccf46511b924f86b488dba25060baa06._comment

@@ -0,0 +1,14 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="comment 1"
+ date="2014-07-05T20:34:39Z"
+ content="""
+I am seeing some evidence of this in my own family's repo, where one node updated to 5.20140613 and started making series of empty commits with message \"merge refs/heads/synced/master\" and only 1 parent (so not really a merge).
+
+Quite likely [[!commit d6711800ad261fb4c37fc361bc84918d1e296bc4]] is at fault. Probably the fastForwardable check isn't quite right.
+
+This should only affect direct mode repositories. When only one node has the problem, it won't be bad, but if multiple nodes are doing this, their repos never converge and keep growing.
+
+Hmm, I think I have partially reproduced it with 2 direct mode repos, each having the other as a remote. `git annex sync` repeatedly in each does not add unncessary commits, but running the assistant in each does. In this particular case, it manages to converge eventually after several commits.
+"""]]

doc/bugs/Assistant_merge_loop/comment_2_afcbf3f8575e1a967c79693b94ef055c._comment

@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="comment 2"
+ date="2014-07-05T21:17:17Z"
+ content="""
+Well, it looks like this is as simple as the assistant trying to merge refs/remotes/$foo/synced/master into the current branch, when that ref is behind or the same as the current branch. Nothing to merge, so it does some pointless work and then the fastForwardable check runs -- and that check looks for refs between the \"old\" and \"new\" refs. Since the \"new\" is behind the \"old\", there are no such commits, and the unnecessary empty commit results.
+
+The reason only the assistant is affected is because `git-annex sync` already checked Git.Branch.changed before trying to do any merging, which avoids the problem.
+
+Fix committed.
+"""]]

doc/bugs/Assistant_merge_loop/comment_3_07341221b2839fdc1c43634e011451d2._comment

@@ -0,0 +1,62 @@
+[[!comment format=mdwn
+ username="EskildHustvedt"
+ ip="80.202.103.55"
+ subject="comment 3"
+ date="2014-07-08T08:13:40Z"
+ content="""
+I'm still seeing this problem in 5.20140707-g923b436
+
+    [0 zerodogg@firefly annexed]$ git annex version
+    git-annex version: 5.20140707-g923b436
+    build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash
+    key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL
+    remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier ddar hook external
+    local repository version: 5
+    supported repository version: 5
+    upgrade supported from repository versions: 0 1 2 4
+    [0 zerodogg@firefly annexed]$ git graph | head -n20
+    *   d4bf68f - (HEAD, annex/direct/master) merge refs/remotes/serenity/synced/master (3 minutes ago) <Eskild Hustvedt>
+    |\  
+    * | d03f280 - merge refs/remotes/browncoats/synced/master (3 minutes ago) <Eskild Hustvedt>
+    |/  
+    *   e6863b8 - (serenity/synced/master, browncoats/synced/master) merge refs/remotes/serenity/synced/master (3 minutes ago) <Eskild Hustvedt>
+    |\  
+    * \   616d985 - merge refs/remotes/browncoats/synced/master (3 minutes ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * |   3b39706 - merge refs/remotes/serenity/synced/master (3 minutes ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * |   6d354cc - merge refs/remotes/browncoats/synced/master (4 minutes ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * |   710c3c1 - merge refs/remotes/serenity/synced/master (4 minutes ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * | 763930f - merge refs/remotes/browncoats/synced/master (4 minutes ago) <Eskild Hustvedt>
+    |/  
+    [0 zerodogg@firefly annexed]$ git annex assistant --stop
+    [0 zerodogg@firefly annexed]$ git annex assistant
+    [0 zerodogg@firefly annexed]$ git graph | head -n20     
+    *   947f1a2 - (HEAD, annex/direct/master) merge refs/remotes/serenity/synced/master (15 seconds ago) <Eskild Hustvedt>
+    |\  
+    * | 19c6043 - merge refs/remotes/browncoats/synced/master (18 seconds ago) <Eskild Hustvedt>
+    |/  
+    *   b453741 - (serenity/synced/master, browncoats/synced/master) merge refs/remotes/serenity/synced/master (18 seconds ago) <Eskild Hustvedt>
+    |\  
+    * \   6baaebd - merge refs/remotes/browncoats/synced/master (18 seconds ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * |   03e4fa2 - merge refs/remotes/serenity/synced/master (24 seconds ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * |   33302d8 - merge refs/remotes/browncoats/synced/master (24 seconds ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * |   d4bf68f - merge refs/remotes/serenity/synced/master (4 minutes ago) <Eskild Hustvedt>
+    |\ \  
+    | |/  
+    * | d03f280 - merge refs/remotes/browncoats/synced/master (4 minutes ago) <Eskild Hustvedt>
+    |/  
+    [0 zerodogg@firefly annexed]$ 
+"""]]

doc/bugs/Assistant_merge_loop/comment_4_7ae215b478843d2a8c705cac385fcf22._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="EskildHustvedt"
+ ip="80.202.103.55"
+ subject="comment 4"
+ date="2014-07-09T00:24:36Z"
+ content="""
+As far as I can see in my repo, the empty merges started on 2014-05-27, but then appear to resolve themselves after 40-50 commits on that day. They reappear again on 2014-06-03, and appears to have kept going daily ever since.
+"""]]

doc/bugs/Assistant_merge_loop/comment_5_11873461f093a266f0bb7e129bc21cde._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="comment 5"
+ date="2014-07-09T19:00:35Z"
+ content="""
+I have confirmed this is still happening, though I had certianly thought I had reproduced and fixed it.
+"""]]

doc/bugs/Assistant_merge_loop/comment_6_e7b6ecdd7e2b0222ea0baa0ed770e66d._comment

@@ -0,0 +1,80 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawmN5jDf53oRJZsTo8Ahj2uXzCzq6HcvEro"
+ nickname="Gregory"
+ subject="confirmed?"
+ date="2014-07-15T01:29:00Z"
+ content="""
+I seem to be getting this behavior, in tandem with the [bad merge commit deleting all files](http://git-annex.branchable.com/bugs/bad_merge_commit_deleting_all_files/) on 
+
+    git-annex version: 5.20140709-gf15d2aa
+    build flags: Assistant Webapp Webapp-secure Pairing Testsuite S3 WebDAV Inotify DBus DesktopNotify XMPP DNS Feeds Quvi TDFA CryptoHash
+    key/value backends: SHA256E SHA1E SHA512E SHA224E SHA384E SKEIN256E SKEIN512E SHA256 SHA1 SHA512 SHA224 SHA384 SKEIN256 SKEIN512 WORM URL
+    remote types: git gcrypt S3 bup directory rsync web webdav tahoe glacier ddar hook external
+    local repository version: unknown
+    supported repository version: 5
+    upgrade supported from repository versions: 0 1 2 4
+
+Here is my log over the past couple weeks when I basically made no changes to the filesystem.
+
+git log --oneline --decorate --color --graph
+
+<pre>
+* b304ad7 (HEAD, origin/synced/master, origin/master, origin/HEAD, master) 
+* 568cf6c merge refs/remotes/diskb/synced/master
+* 5e426d0 merge refs/remotes/diskb/synced/master
+* b2fa076 merge refs/remotes/diskb/synced/master
+*   b66a37d merge refs/remotes/diskb/synced/master
+|\  
+* | 910cba5 merge refs/remotes/diskb/synced/master
+|/  
+* 60736c3 merge refs/remotes/diskb/synced/master
+*   a957439 merge refs/remotes/diskb/synced/master
+|\  
+* \   5c135c0 merge refs/remotes/diskb/synced/master
+|\ \  
+| |/  
+* |   52d8b66 merge refs/heads/synced/master
+|\ \  
+* | | d77f3a2 merge refs/remotes/diskb/synced/master
+| |/  
+|/|   
+* |   03bb56a merge refs/remotes/diskb/synced/master
+|\ \  
+* \ \   bb000db merge refs/heads/synced/master
+|\ \ \  
+| |/ /  
+|/| /   
+| |/    
+* | 3bc8520 merge refs/heads/synced/master
+|/  
+* 1c3ee7e 
+*   d3b096a merge refs/remotes/diskb/synced/master
+|\  
+* \   0fa0f6d merge refs/heads/synced/master
+|\ \  
+| |/  
+* |   173592c merge refs/remotes/diskb/synced/master
+|\ \  
+| |/  
+* |   3dd8086 merge refs/remotes/diskb/synced/master
+|\ \  
+| |/  
+* |   68be2a1 merge refs/heads/synced/master
+|\ \  
+| |/  
+* |   bb304f4 merge refs/remotes/diskb/synced/master
+|\ \  
+| |/  
+|/|   
+* | 1c9a2cd 
+* | 298b362 merge refs/heads/synced/master
+|/  
+*   4c23257 merge refs/remotes/diskb/synced/master
+|\  
+* | b709997 merge refs/remotes/diskb/synced/master
+|/  
+*   215f061 merge refs/remotes/diskb/synced/master
+|\  
+* \   e0f75b4 merge refs/heads/synced/master
+</pre>
+"""]]

doc/bugs/Assistant_merge_loop/comment_7_7717d074611943b831f00ad10918b515._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.2"
+ subject="comment 7"
+ date="2014-07-15T19:15:13Z"
+ content="""
+This bug and the other one are fixed in 5.20140709. I assume that your `git log` dates from an earlier version.
+"""]]

doc/bugs/Assistant_merge_loop/comment_8_5ce91ac76498539ada344d1639984302._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="https://www.google.com/accounts/o8/id?id=AItOawk9nck8WX8-ADF3Fdh5vFo4Qrw1I_bJcR8"
+ nickname="Jon Ander"
+ subject="comment 8"
+ date="2014-07-16T13:42:16Z"
+ content="""
+I'm still having this issue in 5.20140709
+"""]]

doc/bugs/Assistant_merge_loop/comment_9_b09a5eaa2588559e19b3549bd3c8b496._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.2"
+ subject="comment 9"
+ date="2014-07-16T18:08:26Z"
+ content="""
+Are you sure that you have upgraded git-annex on every machine that uses that repository? You could have one old un-upgraded one still causing commits that would of course be visible on the rest.
+
+Also, what version exactly does `git-annex version` show?
+"""]]

doc/bugs/Git_annex_add_._dies_when_you_add_too_much.mdwn

@@ -54,3 +54,5 @@ Linux quad 3.8.0-34-generic #49~precise1-Ubuntu SMP Wed Nov 13 18:05:00 UTC 2013
 """]]
 
 > Ancient git-annex version. Doubt it affects current version. [[!tag moreinfo]] --[[Joey]] 
+
+>> Actually, this is a dup of [[runs_of_of_memory_adding_2_million_files]] so [[done]] --[[Joey]]

doc/bugs/Installation_fails:___34__Duplicate_instance_declarations__34__.mdwn

@@ -0,0 +1,35 @@
+### Please describe the problem.
+
+[380 of 462] Compiling Assistant.WebApp.Types ( Assistant/WebApp/Types.hs, dist/build/git-annex/git-annex-tmp/Assistant/WebApp/Types.o )
+
+Assistant/WebApp/Types.hs:157:10:
+    Duplicate instance declarations:
+      instance PathPiece Bool
+        -- Defined at Assistant/WebApp/Types.hs:157:10
+      instance PathPiece Bool
+        -- Defined in `path-pieces-0.1.4:Web.PathPieces'
+cabal: Error: some packages failed to install:
+git-annex-5.20140709 failed during the building phase. The exception was:
+ExitFailure 1
+
+
+### What steps will reproduce the problem?
+
+cabal install git-annex --bindir=$HOME/bin
+
+
+### What version of git-annex are you using? On what operating system?
+git-annex-5.20140709, Fedora 20
+
+
+### Please provide any additional information below.
+
+[[!format sh """
+# If you can, paste a complete transcript of the problem occurring here.
+# If the problem is with the git-annex assistant, paste in .git/annex/daemon.log
+
+
+# End of transcript or log.
+"""]]
+
+> Already fixed in git yesterday. [[done]] --[[Joey]]

doc/bugs/Merge_involving_symlink_yields_unexpected_results.mdwn

@@ -0,0 +1,51 @@
+### Please describe the problem.
+When creating a symlink in repository A, and creating a regular file under the same name in repository B, syncing B will yield the result that the symlink is lost, and both the original filename and the .variant file will point to the same annex object containing the original content from B.
+
+Both A and B are indirect mode repos.
+
+### What steps will reproduce the problem?
+
+[[!format  sh """
+
+#Initial state:
+
+repo-A$ echo file1
+This is file 1.
+repo-B$ echo file1
+This is file 1.
+
+#Make conflicting changes:
+
+repo-A$ ln -s file1 file2; git add file2; git commit -m "Add file2 as symlink."
+repo-B$ echo "This is file 2." > file2; git annex add file2; git commit -m "Add file2 as regular file."
+
+#Sync it:
+
+repo-A$ git annex sync
+repo-B$ git annex sync
+
+#Strange result in repo-B:
+
+repo-B$ ls -l file2*
+file2 -> .git/annex/objects/$HASH1
+file2.variant1234 -> .git/annex/objects/$HASH1
+repo-B$ cat file2 file2.variantXXXX
+This is file 2.
+This is file 2.
+
+#Repo-A leaves the symlink change untouched and adds a .variant containing the new regular file data.
+
+repo-A$ ls -l file*
+file2 -> file1
+file2.variant1234 -> .git/annex/objects/$HASH1
+repo-A$ cat file.variant1234
+This is file 2.
+"""]]
+### What version of git-annex are you using? On what operating system?
+Linux 3.15.3
+git-annex  5.20140613
+
+
+[[!tag confirmed]]
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/Merge_involving_symlink_yields_unexpected_results/comment_1_e8a2ea1b8573bee45b70bcc7ef7e3bed._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="zardoz"
+ ip="134.147.14.84"
+ subject="comment 1"
+ date="2014-07-07T14:09:33Z"
+ content="""
+Sorry, the initial «echos» should have been «cat» of course.
+"""]]

doc/bugs/Merge_involving_symlink_yields_unexpected_results/comment_2_b6182038292bd72dc4711e4575510172._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="comment 2"
+ date="2014-07-07T17:17:49Z"
+ content="""
+Drat, so many bug fixes and test cases and this still got through?
+"""]]

doc/bugs/Merge_involving_symlink_yields_unexpected_results/comment_3_c6ca13d475b3f846c95606c20e1a3052._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="comment 3"
+ date="2014-07-07T17:19:03Z"
+ content="""
+Ah, I see, it's explicitly because the non-git-annex symlink is involved. Whew!
+"""]]

doc/bugs/Merge_involving_symlink_yields_unexpected_results/comment_4_13179e0f72026092e48c13082818ce68._comment

@@ -0,0 +1,15 @@
+[[!comment format=mdwn
+ username="http://joeyh.name/"
+ ip="209.250.56.55"
+ subject="analysis"
+ date="2014-07-08T17:52:59Z"
+ content="""
+When resolveMerge' calls graftin to add A's file2 symlink to B's tree, it actually stages the right symlink (the non-annexed one).
+
+However, the work tree is left as-is, so it still has the annexed symlink in it. So git status shows file2 as modified. Later syncs will commit that.
+
+This is why the sync in A doesn't have the problem, as there things are the other way around, and git-annex makes the git-annex symlink, leaving the non-annexed symlink as-is in the work tree.
+
+So, graftin needs to update the work tree. But it's tricky because graftin is called in 3 situations: non-symlink file, directory, and non-annexed symlink.
+Interestingly, in the other 2 cases, git-merge already takes care of updating the work tree -- it deletes the annexed symlink and puts in place either the non-symlink file or the directory. It's only the the case of a merge conflict involving 2 symlinks that git merge doesn't update the tree in this way. It's nice to be able to rely on git-merge in the other 2 cases, especially the directory case (avoids having to manually check out the directory).
+"""]]

doc/bugs/Merge_involving_symlink_yields_unexpected_results/comment_5_585c8a5a13bb17032bfe30818345f936._comment

@@ -0,0 +1,10 @@
+[[!comment format=mdwn
+ username="zardoz"
+ ip="78.49.247.112"
+ subject="comment 5"
+ date="2014-07-08T19:17:29Z"
+ content="""
+Thanks for the swift fix + analysis! If I’m ever around, I’ll lend you a hand on your next truckload of firewood! ;>
+
+Cheers!
+"""]]