packages feed

git-annex 8.20201116 → 8.20201127

raw patch · 90 files changed

+1540/−1113 lines, 90 files

Files

Annex.hs view
@@ -143,6 +143,7 @@ 	, sentinalstatus :: Maybe SentinalStatus 	, useragent :: Maybe String 	, errcounter :: Integer+	, adjustedbranchrefreshcounter :: Integer 	, unusedkeys :: Maybe (S.Set Key) 	, tempurls :: M.Map Key URLString 	, existinghooks :: M.Map Git.Hook.Hook Bool@@ -203,6 +204,7 @@ 		, sentinalstatus = Nothing 		, useragent = Nothing 		, errcounter = 0+		, adjustedbranchrefreshcounter = 0 		, unusedkeys = Nothing 		, tempurls = M.empty 		, existinghooks = M.empty@@ -399,8 +401,8 @@  incError :: Annex () incError = changeState $ \s -> -	let ! c = errcounter s + 1 -	    ! s' = s { errcounter = c }+	let !c = errcounter s + 1 +	    !s' = s { errcounter = c } 	in s'  getGitRemotes :: Annex [Git.Repo]
Annex/AdjustedBranch.hs view
@@ -11,7 +11,9 @@ 	Adjustment(..), 	LinkAdjustment(..), 	PresenceAdjustment(..),+	LinkPresentAdjustment(..), 	adjustmentHidesFiles,+	adjustmentIsStable, 	OrigBranch, 	AdjBranch(..), 	originalToAdjusted,@@ -19,11 +21,20 @@ 	fromAdjustedBranch, 	getAdjustment, 	enterAdjustedBranch,-	updateAdjustedBranch,+	adjustedBranchRefresh,+	adjustedBranchRefreshFull, 	adjustBranch,+	adjustTree, 	adjustToCrippledFileSystem,-	mergeToAdjustedBranch,+	commitForAdjustedBranch, 	propigateAdjustedCommits,+	propigateAdjustedCommits',+	commitAdjustedTree,+	commitAdjustedTree',+	BasisBranch(..),+	basisBranch,+	setBasisBranch,+	preventCommits, 	AdjustedClone(..), 	checkAdjustedClone, 	checkVersionSupported,@@ -34,6 +45,7 @@ import Types.AdjustedBranch import Annex.AdjustedBranch.Name import qualified Annex+import qualified Annex.Queue import Git import Git.Types import qualified Git.Branch@@ -41,7 +53,6 @@ import qualified Git.Command import qualified Git.Tree import qualified Git.DiffTree-import qualified Git.Merge import Git.Tree (TreeItem(..)) import Git.Sha import Git.Env@@ -51,23 +62,19 @@ import qualified Git.Version import Annex.CatFile import Annex.Link-import Annex.AutoMerge-import Annex.Content-import Annex.Tmp-import Annex.GitOverlay-import Utility.Tmp.Dir-import Utility.CopyFile-import Utility.Directory.Create+import Annex.Content.Presence+import Annex.CurrentBranch+import Types.CleanupActions import qualified Database.Keys import Config  import qualified Data.Map as M-import qualified Data.ByteString as S-import qualified System.FilePath.ByteString as P --- How to perform various adjustments to a TreeItem. class AdjustTreeItem t where+	-- How to perform various adjustments to a TreeItem. 	adjustTreeItem :: t -> TreeItem -> Annex (Maybe TreeItem)+	-- Will adjusting a given tree always yield the same adjusted tree?+	adjustmentIsStable :: t -> Bool  instance AdjustTreeItem Adjustment where 	adjustTreeItem (LinkAdjustment l) t = adjustTreeItem l t@@ -76,31 +83,72 @@ 		adjustTreeItem p t >>= \case 			Nothing -> return Nothing 			Just t' -> adjustTreeItem l t'+	adjustTreeItem (LinkPresentAdjustment l) t = adjustTreeItem l t +	adjustmentIsStable (LinkAdjustment l) = adjustmentIsStable l+	adjustmentIsStable (PresenceAdjustment p _) = adjustmentIsStable p+	adjustmentIsStable (LinkPresentAdjustment l) = adjustmentIsStable l+ instance AdjustTreeItem LinkAdjustment where-	adjustTreeItem UnlockAdjustment = ifSymlink adjustToPointer noAdjust-	adjustTreeItem LockAdjustment = ifSymlink noAdjust adjustToSymlink-	adjustTreeItem FixAdjustment = ifSymlink adjustToSymlink noAdjust-	adjustTreeItem UnFixAdjustment = ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust+	adjustTreeItem UnlockAdjustment =+		ifSymlink adjustToPointer noAdjust+	adjustTreeItem LockAdjustment =+		ifSymlink noAdjust adjustToSymlink+	adjustTreeItem FixAdjustment =+		ifSymlink adjustToSymlink noAdjust+	adjustTreeItem UnFixAdjustment =+		ifSymlink (adjustToSymlink' gitAnnexLinkCanonical) noAdjust+	+	adjustmentIsStable _ = True  instance AdjustTreeItem PresenceAdjustment where-	adjustTreeItem HideMissingAdjustment = \ti@(TreeItem _ _ s) ->-		catKey s >>= \case-			Just k -> ifM (inAnnex k)-				( return (Just ti)-				, return Nothing-				)-			Nothing -> return (Just ti)-	adjustTreeItem ShowMissingAdjustment = noAdjust+	adjustTreeItem HideMissingAdjustment = +		ifPresent noAdjust hideAdjust+	adjustTreeItem ShowMissingAdjustment =+		noAdjust -ifSymlink :: (TreeItem -> Annex a) -> (TreeItem -> Annex a) -> TreeItem -> Annex a+	adjustmentIsStable HideMissingAdjustment = False+	adjustmentIsStable ShowMissingAdjustment = True++instance AdjustTreeItem LinkPresentAdjustment where+	adjustTreeItem UnlockPresentAdjustment = +		ifPresent adjustToPointer adjustToSymlink+	adjustTreeItem LockPresentAdjustment =+		-- Turn all pointers back to symlinks, whether the content+		-- is present or not. This is done because the content+		-- availability may have changed and the branch not been+		-- re-adjusted to keep up, so there may be pointers whose+		-- content is not present.+		ifSymlink noAdjust adjustToSymlink++	adjustmentIsStable UnlockPresentAdjustment = False+	adjustmentIsStable LockPresentAdjustment = True++ifSymlink+	:: (TreeItem -> Annex a)+	-> (TreeItem -> Annex a)+	-> TreeItem+	-> Annex a ifSymlink issymlink notsymlink ti@(TreeItem _f m _s) 	| toTreeItemType m == Just TreeSymlink = issymlink ti 	| otherwise = notsymlink ti +ifPresent+	:: (TreeItem -> Annex (Maybe TreeItem))+	-> (TreeItem -> Annex (Maybe TreeItem))+	-> TreeItem+	-> Annex (Maybe TreeItem)+ifPresent ispresent notpresent ti@(TreeItem _ _ s) =+	catKey s >>= \case+		Just k -> ifM (inAnnex k) (ispresent ti, notpresent ti)+		Nothing -> return (Just ti)+ noAdjust :: TreeItem -> Annex (Maybe TreeItem) noAdjust = return . Just +hideAdjust :: TreeItem -> Annex (Maybe TreeItem)+hideAdjust _ = return Nothing+ adjustToPointer :: TreeItem -> Annex (Maybe TreeItem) adjustToPointer ti@(TreeItem f _m s) = catKey s >>= \case 	Just k -> do@@ -177,70 +225,125 @@ 			, do 				b <- preventCommits $ const $  					adjustBranch adj origbranch-				checkoutAdjustedBranch b []+				checkoutAdjustedBranch b False 			) -checkoutAdjustedBranch :: AdjBranch -> [CommandParam] -> Annex Bool-checkoutAdjustedBranch (AdjBranch b) checkoutparams = do-	showOutput -- checkout can have output in large repos+checkoutAdjustedBranch :: AdjBranch -> Bool -> Annex Bool+checkoutAdjustedBranch (AdjBranch b) quietcheckout = do+	-- checkout can have output in large repos+	unless quietcheckout+		showOutput 	inRepo $ Git.Command.runBool $ 		[ Param "checkout" 		, Param $ fromRef $ Git.Ref.base b-		-- always show checkout progress, even if --quiet is used-		-- to suppress other messages-		, Param "--progress"-		] ++ checkoutparams+		, if quietcheckout then Param "--quiet" else Param "--progress"+		]  {- Already in a branch with this adjustment, but the user asked to enter it- - again. This should have the same result as checking out the original branch,- - deleting and rebuilding the adjusted branch, and then checking it out.+ - again. This should have the same result as propagating any commits+ - back to the original branch, checking out the original branch, deleting+ - and rebuilding the adjusted branch, and then checking it out.  - But, it can be implemented more efficiently than that.  -} updateAdjustedBranch :: Adjustment -> AdjBranch -> OrigBranch -> Annex Bool-updateAdjustedBranch adj@(PresenceAdjustment _ _) (AdjBranch currbranch) origbranch = do-	b <- preventCommits $ \commitlck -> do-		-- Avoid losing any commits that the adjusted branch has that-		-- have not yet been propigated back to the origbranch.-		_ <- propigateAdjustedCommits' origbranch adj commitlck+updateAdjustedBranch adj (AdjBranch currbranch) origbranch+	| not (adjustmentIsStable adj) = do+		b <- preventCommits $ \commitlck -> do+			-- Avoid losing any commits that the adjusted branch+			-- has that have not yet been propigated back to the+			-- origbranch.+			_ <- propigateAdjustedCommits' origbranch adj commitlck -		-- Git normally won't do anything when asked to check out the-		-- currently checked out branch, even when its ref has-		-- changed. Work around this by writing a raw sha to .git/HEAD.-		inRepo (Git.Ref.sha currbranch) >>= \case-			Just headsha -> inRepo $ \r ->-				writeFile (Git.Ref.headFile r) (fromRef headsha)-			_ -> noop+			-- Git normally won't do anything when asked to check+			-- out the currently checked out branch, even when its+			-- ref has changed. Work around this by writing a raw+			-- sha to .git/HEAD.+			inRepo (Git.Ref.sha currbranch) >>= \case+				Just headsha -> inRepo $ \r ->+					writeFile (Git.Ref.headFile r) (fromRef headsha)+				_ -> noop 	-		adjustBranch adj origbranch+			adjustBranch adj origbranch 	-	-- Make git checkout quiet to avoid warnings about disconnected-	-- branch tips being lost.-	checkoutAdjustedBranch b [Param "--quiet"]-updateAdjustedBranch adj@(LinkAdjustment _) _ origbranch = preventCommits $ \commitlck -> do-	-- Not really needed here, but done for consistency.-	_ <- propigateAdjustedCommits' origbranch adj commitlck-	-- No need to do anything else, because link adjustments are stable.-	return True+		-- Make git checkout quiet to avoid warnings about+		-- disconnected branch tips being lost.+		checkoutAdjustedBranch b True+	| otherwise = preventCommits $ \commitlck -> do+		-- Done for consistency.+		_ <- propigateAdjustedCommits' origbranch adj commitlck+		-- No need to actually update the branch because the+		-- adjustment is stable.+		return True +{- Passed an action that, if it succeeds may get or drop the Key associated+ - with the file. When the adjusted branch needs to be refreshed to reflect+ - those changes, it's handled here.+ -+ - Note that the AssociatedFile must be verified by this to point to the+ - Key. In some cases, the value was provided by the user and might not+ - really be an associated file.+ -}+adjustedBranchRefresh :: AssociatedFile -> Annex a -> Annex a+adjustedBranchRefresh _af a = do+	r <- a+	annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case+		0 -> return ()+		n -> go n+	return r+  where+	go n = getCurrentBranch >>= \case+		(Just origbranch, Just adj) ->+			unless (adjustmentIsStable adj) $+				ifM (checkcounter n)+					( update adj origbranch+					, Annex.addCleanup AdjustedBranchUpdate $+						adjustedBranchRefreshFull adj origbranch+					)+		_ -> return ()+	+	checkcounter n+		-- Special case, 1 (or true) refreshes only at shutdown.+		| n == 1 = pure False+		| otherwise = Annex.withState $ \s -> +			let !c = Annex.adjustedbranchrefreshcounter s + 1+			    !enough = c >= pred n+			    !c' = if enough then 0 else c+			    !s' = s { Annex.adjustedbranchrefreshcounter = c' }+			    in pure (s', enough)++	update adj origbranch = do+		-- Flush the queue, to make any pending changes be written+		-- out to disk. But mostly so any pointer files+		-- restagePointerFile was called on get updated so git+		-- checkout won't fall over.+		Annex.Queue.flush+		-- This is slow, it would be better to incrementally+		-- adjust the AssociatedFile, and only call this once+		-- at shutdown to handle cases where not all+		-- AssociatedFiles are known.+		adjustedBranchRefreshFull adj origbranch++{- Slow, but more dependable version of adjustedBranchRefresh that+ - does not rely on all AssociatedFiles being known. -}+adjustedBranchRefreshFull :: Adjustment -> OrigBranch -> Annex ()+adjustedBranchRefreshFull adj origbranch = do+	let adjbranch = originalToAdjusted origbranch adj+	unlessM (updateAdjustedBranch adj adjbranch origbranch) $+		warning $ unwords [ "Updating adjusted branch failed." ]+ adjustToCrippledFileSystem :: Annex () adjustToCrippledFileSystem = do 	warning "Entering an adjusted branch where files are unlocked as this filesystem does not support locked files." 	checkVersionSupported-	whenM (isNothing <$> inRepo Git.Branch.current) $ do-		cmode <- annexCommitMode <$> Annex.getGitConfig-		void $ inRepo $ Git.Branch.commitCommand cmode-			[ Param "--quiet"-			, Param "--allow-empty"-			, Param "-m"-			, Param "commit before entering adjusted unlocked branch"-			]+	whenM (isNothing <$> inRepo Git.Branch.current) $+		commitForAdjustedBranch [] 	inRepo Git.Branch.current >>= \case 		Just currbranch -> case getAdjustment currbranch of 			Just curradj | curradj == adj -> return () 			_ -> do 				let adjbranch = originalToAdjusted currbranch adj 				ifM (inRepo (Git.Ref.exists $ adjBranch adjbranch))-					( unlessM (checkoutAdjustedBranch adjbranch []) $+					( unlessM (checkoutAdjustedBranch adjbranch False) $ 						failedenter 					, unlessM (enterAdjustedBranch adj) $ 						failedenter@@ -250,6 +353,22 @@ 	adj = LinkAdjustment UnlockAdjustment 	failedenter = warning "Failed to enter adjusted branch!" +{- Commit before entering adjusted branch. Only needs to be done+ - when the current branch does not have any commits yet.+ -+ - If something is already staged, it will be committed, but otherwise+ - an empty commit will be made.+ -}+commitForAdjustedBranch :: [CommandParam] -> Annex ()+commitForAdjustedBranch ps = do+	cmode <- annexCommitMode <$> Annex.getGitConfig+	void $ inRepo $ Git.Branch.commitCommand cmode $+		[ Param "--quiet"+		, Param "--allow-empty"+		, Param "-m"+		, Param "commit before entering adjusted branch"+		] ++ ps+ setBasisBranch :: BasisBranch -> Ref -> Annex () setBasisBranch (BasisBranch basis) new =  	inRepo $ Git.Branch.update' basis new@@ -338,137 +457,6 @@ 		| otherwise = case commitParent c of 			[p] -> go =<< catCommit p 			_ -> return Nothing--{- Update the currently checked out adjusted branch, merging the provided- - branch into it. Note that the provided branch should be a non-adjusted- - branch. -}-mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Bool -> Git.Branch.CommitMode -> Annex Bool-mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commitmode = catchBoolIO $-	join $ preventCommits go-  where-	adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj-	basis = basisBranch adjbranch--	go commitsprevented =-		ifM (inRepo $ Git.Branch.changed currbranch tomerge)-			( do-				(updatedorig, _) <- propigateAdjustedCommits'-					origbranch adj commitsprevented-				changestomerge updatedorig-			, nochangestomerge-			)--	nochangestomerge = return $ return True--	{- Since the adjusted branch changes files, merging tomerge-	 - directly into it would likely result in unncessary merge-	 - conflicts. To avoid those conflicts, instead merge tomerge into-	 - updatedorig. The result of the merge can the be-	 - adjusted to yield the final adjusted branch.-	 --	 - In order to do a merge into a ref that is not checked out,-	 - set the work tree to a temp directory, and set GIT_DIR-	 - to another temp directory, in which HEAD contains the-	 - updatedorig sha. GIT_COMMON_DIR is set to point to the real-	 - git directory, and so git can read and write objects from there,-	 - but will use GIT_DIR for HEAD and index.-	 --	 - (Doing the merge this way also lets it run even though the main-	 - index file is currently locked.)-	 -}-	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do-		git_dir <- fromRepo Git.localGitDir-		let git_dir' = fromRawFilePath git_dir-		tmpwt <- fromRepo gitAnnexMergeDir-		withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $-			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do-				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)-				-- Copy in refs and packed-refs, to work-				-- around bug in git 2.13.0, which-				-- causes it not to look in GIT_DIR for refs.-				refs <- liftIO $ dirContentsRecursive $-					git_dir' </> "refs"-				let refs' = (git_dir' </> "packed-refs") : refs-				liftIO $ forM_ refs' $ \src ->-					whenM (doesFileExist src) $ do-						dest <- relPathDirToFile git_dir-							(toRawFilePath src)-						let dest' = toRawFilePath tmpgit P.</> dest-						createDirectoryUnder git_dir-							(P.takeDirectory dest')-						void $ createLinkOrCopy src-							(fromRawFilePath dest')-				-- This reset makes git merge not care-				-- that the work tree is empty; otherwise-				-- it will think that all the files have-				-- been staged for deletion, and sometimes-				-- the merge includes these deletions-				-- (for an unknown reason).-				-- http://thread.gmane.org/gmane.comp.version-control.git/297237-				inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"]-				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)-				merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode True-					(const $ resolveMerge (Just updatedorig) tomerge True)-				if merged-					then do-						!mergecommit <- liftIO $ extractSha-							<$> S.readFile (tmpgit </> "HEAD")-						-- This is run after the commit lock is dropped.-						return $ postmerge mergecommit-					else return $ return False-	changestomerge Nothing = return $ return False-	-	withemptydir git_dir d a = bracketIO setup cleanup (const a)-	  where-		setup = do-			whenM (doesDirectoryExist d) $-				removeDirectoryRecursive d-			createDirectoryUnder git_dir (toRawFilePath d)-		cleanup _ = removeDirectoryRecursive d--	{- A merge commit has been made between the basisbranch and -	 - tomerge. Update the basisbranch and origbranch to point-	 - to that commit, adjust it to get the new adjusted branch,-	 - and check it out.-	 --	 - But, there may be unstaged work tree changes that conflict, -	 - so the check out is done by making a normal merge of-	 - the new adjusted branch.-	 -}-	postmerge (Just mergecommit) = do-		setBasisBranch basis mergecommit-		inRepo $ Git.Branch.update' origbranch mergecommit-		adjtree <- adjustTree adj (BasisBranch mergecommit)-		adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)-		-- Make currbranch be the parent, so that merging-		-- this commit will be a fast-forward.-		adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]-		showAction "Merging into adjusted branch"-		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode canresolvemerge)-			( reparent adjtree adjmergecommit =<< getcurrentcommit-			, return False-			)-	postmerge Nothing = return False--	-- Now that the merge into the adjusted branch is complete,-	-- take the tree from that merge, and attach it on top of the-	-- adjmergecommit, if it's different.-	reparent adjtree adjmergecommit (Just currentcommit) = do-		if (commitTree currentcommit /= adjtree)-			then do-				cmode <- annexCommitMode <$> Annex.getGitConfig-				c <- inRepo $ Git.Branch.commitTree cmode-					("Merged " ++ fromRef tomerge) [adjmergecommit]-					(commitTree currentcommit)-				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c-				propigateAdjustedCommits origbranch adj-			else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit-		return True-	reparent _ _ Nothing = return False--	getcurrentcommit = inRepo Git.Branch.currentUnsafe >>= \case-		Nothing -> return Nothing-		Just c -> catCommit c  {- Check for any commits present on the adjusted branch that have not yet  - been propigated to the basis branch, and propigate them to the basis
+ Annex/AdjustedBranch/Merge.hs view
@@ -0,0 +1,164 @@+{- adjusted branch merging+ -+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE BangPatterns, OverloadedStrings #-}++module Annex.AdjustedBranch.Merge (+	mergeToAdjustedBranch,+) where++import Annex.Common+import Annex.AdjustedBranch+import qualified Annex+import Git+import Git.Types+import qualified Git.Branch+import qualified Git.Ref+import qualified Git.Command+import qualified Git.Merge+import Git.Sha+import Annex.CatFile+import Annex.AutoMerge+import Annex.Tmp+import Annex.GitOverlay+import Utility.Tmp.Dir+import Utility.CopyFile+import Utility.Directory.Create++import qualified Data.ByteString as S+import qualified System.FilePath.ByteString as P++{- Update the currently checked out adjusted branch, merging the provided+ - branch into it. Note that the provided branch should be a non-adjusted+ - branch. -}+mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Bool -> Git.Branch.CommitMode -> Annex Bool+mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commitmode = catchBoolIO $+	join $ preventCommits go+  where+	adjbranch@(AdjBranch currbranch) = originalToAdjusted origbranch adj+	basis = basisBranch adjbranch++	go commitsprevented =+		ifM (inRepo $ Git.Branch.changed currbranch tomerge)+			( do+				(updatedorig, _) <- propigateAdjustedCommits'+					origbranch adj commitsprevented+				changestomerge updatedorig+			, nochangestomerge+			)++	nochangestomerge = return $ return True++	{- Since the adjusted branch changes files, merging tomerge+	 - directly into it would likely result in unncessary merge+	 - conflicts. To avoid those conflicts, instead merge tomerge into+	 - updatedorig. The result of the merge can the be+	 - adjusted to yield the final adjusted branch.+	 -+	 - In order to do a merge into a ref that is not checked out,+	 - set the work tree to a temp directory, and set GIT_DIR+	 - to another temp directory, in which HEAD contains the+	 - updatedorig sha. GIT_COMMON_DIR is set to point to the real+	 - git directory, and so git can read and write objects from there,+	 - but will use GIT_DIR for HEAD and index.+	 -+	 - (Doing the merge this way also lets it run even though the main+	 - index file is currently locked.)+	 -}+	changestomerge (Just updatedorig) = withOtherTmp $ \othertmpdir -> do+		git_dir <- fromRepo Git.localGitDir+		let git_dir' = fromRawFilePath git_dir+		tmpwt <- fromRepo gitAnnexMergeDir+		withTmpDirIn (fromRawFilePath othertmpdir) "git" $ \tmpgit -> withWorkTreeRelated tmpgit $+			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do+				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)+				-- Copy in refs and packed-refs, to work+				-- around bug in git 2.13.0, which+				-- causes it not to look in GIT_DIR for refs.+				refs <- liftIO $ dirContentsRecursive $+					git_dir' </> "refs"+				let refs' = (git_dir' </> "packed-refs") : refs+				liftIO $ forM_ refs' $ \src ->+					whenM (doesFileExist src) $ do+						dest <- relPathDirToFile git_dir+							(toRawFilePath src)+						let dest' = toRawFilePath tmpgit P.</> dest+						createDirectoryUnder git_dir+							(P.takeDirectory dest')+						void $ createLinkOrCopy src+							(fromRawFilePath dest')+				-- This reset makes git merge not care+				-- that the work tree is empty; otherwise+				-- it will think that all the files have+				-- been staged for deletion, and sometimes+				-- the merge includes these deletions+				-- (for an unknown reason).+				-- http://thread.gmane.org/gmane.comp.version-control.git/297237+				inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"]+				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)+				merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode True+					(const $ resolveMerge (Just updatedorig) tomerge True)+				if merged+					then do+						!mergecommit <- liftIO $ extractSha+							<$> S.readFile (tmpgit </> "HEAD")+						-- This is run after the commit lock is dropped.+						return $ postmerge mergecommit+					else return $ return False+	changestomerge Nothing = return $ return False+	+	withemptydir git_dir d a = bracketIO setup cleanup (const a)+	  where+		setup = do+			whenM (doesDirectoryExist d) $+				removeDirectoryRecursive d+			createDirectoryUnder git_dir (toRawFilePath d)+		cleanup _ = removeDirectoryRecursive d++	{- A merge commit has been made between the basisbranch and +	 - tomerge. Update the basisbranch and origbranch to point+	 - to that commit, adjust it to get the new adjusted branch,+	 - and check it out.+	 -+	 - But, there may be unstaged work tree changes that conflict, +	 - so the check out is done by making a normal merge of+	 - the new adjusted branch.+	 -}+	postmerge (Just mergecommit) = do+		setBasisBranch basis mergecommit+		inRepo $ Git.Branch.update' origbranch mergecommit+		adjtree <- adjustTree adj (BasisBranch mergecommit)+		adjmergecommit <- commitAdjustedTree adjtree (BasisBranch mergecommit)+		-- Make currbranch be the parent, so that merging+		-- this commit will be a fast-forward.+		adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]+		showAction "Merging into adjusted branch"+		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode canresolvemerge)+			( reparent adjtree adjmergecommit =<< getcurrentcommit+			, return False+			)+	postmerge Nothing = return False++	-- Now that the merge into the adjusted branch is complete,+	-- take the tree from that merge, and attach it on top of the+	-- adjmergecommit, if it's different.+	reparent adjtree adjmergecommit (Just currentcommit) = do+		if (commitTree currentcommit /= adjtree)+			then do+				cmode <- annexCommitMode <$> Annex.getGitConfig+				c <- inRepo $ Git.Branch.commitTree cmode+					("Merged " ++ fromRef tomerge) [adjmergecommit]+					(commitTree currentcommit)+				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c+				propigateAdjustedCommits origbranch adj+			else inRepo $ Git.Branch.update "updating adjusted branch" currbranch adjmergecommit+		return True+	reparent _ _ Nothing = return False++	getcurrentcommit = inRepo Git.Branch.currentUnsafe >>= \case+		Nothing -> return Nothing+		Just c -> catCommit c
Annex/AdjustedBranch/Name.hs view
@@ -1,6 +1,6 @@ {- adjusted branch names  -- - Copyright 2016-2018 Joey Hess <id@joeyh.name>+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -37,12 +37,16 @@ 		serializeAdjustment p 	serializeAdjustment (PresenceAdjustment p (Just l)) =  		serializeAdjustment p <> "-" <> serializeAdjustment l+	serializeAdjustment (LinkPresentAdjustment l) =+		serializeAdjustment l 	deserializeAdjustment s =  		(LinkAdjustment <$> deserializeAdjustment s) 			<|> 		(PresenceAdjustment <$> deserializeAdjustment s1 <*> pure (deserializeAdjustment s2)) 			<|> 		(PresenceAdjustment <$> deserializeAdjustment s <*> pure Nothing)+			<|>+		(LinkPresentAdjustment <$> deserializeAdjustment s) 	  where 		(s1, s2) = separate' (== (fromIntegral (ord '-'))) s @@ -62,6 +66,13 @@ 	serializeAdjustment ShowMissingAdjustment = "showmissing" 	deserializeAdjustment "hidemissing" = Just HideMissingAdjustment 	deserializeAdjustment "showmissing" = Just ShowMissingAdjustment+	deserializeAdjustment _ = Nothing++instance SerializeAdjustment LinkPresentAdjustment where+	serializeAdjustment UnlockPresentAdjustment = "unlockpresent"+	serializeAdjustment LockPresentAdjustment = "lockpresent"+	deserializeAdjustment "unlockpresent" = Just UnlockPresentAdjustment+	deserializeAdjustment "lockpresent" = Just LockPresentAdjustment 	deserializeAdjustment _ = Nothing  newtype AdjBranch = AdjBranch { adjBranch :: Branch }
Annex/AutoMerge.hs view
@@ -34,11 +34,11 @@ import Annex.InodeSentinal import Utility.InodeCache import Utility.FileMode+import qualified Utility.RawFilePath as R  import qualified Data.Set as S import qualified Data.Map as M import qualified Data.ByteString.Lazy as L-import qualified Utility.RawFilePath as R  {- Merges from a branch into the current branch (which may not exist yet),  - with automatic merge conflict resolution.@@ -176,7 +176,7 @@ 				-- files, so delete here. 				unless inoverlay $ 					unless (islocked LsFiles.valUs) $-						liftIO $ removeWhenExistsWith removeLink file+						liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath file) 			| otherwise -> do 				-- Only resolve using symlink when both 				-- were locked, otherwise use unlocked@@ -309,7 +309,7 @@ 		<$> mapM Database.Keys.getInodeCaches resolvedks 	forM_ (M.toList unstagedmap) $ \(i, f) -> 		whenM (matchesresolved is i f) $-			liftIO $ removeWhenExistsWith removeLink f+			liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f)   where 	fs = S.fromList resolvedfs 	ks = S.fromList resolvedks
Annex/Branch.hs view
@@ -535,7 +535,7 @@ 		stagedfs <- lines <$> hGetContents jlogh 		mapM_ (removeFile . (dir </>)) stagedfs 		hClose jlogh-		removeWhenExistsWith removeLink jlogf+		removeWhenExistsWith (R.removeLink) (toRawFilePath jlogf) 	openjlog tmpdir = liftIO $ openTempFile tmpdir "jlog"  {- This is run after the refs have been merged into the index,
Annex/Content.hs view
@@ -60,132 +60,37 @@ import qualified Data.Set as S  import Annex.Common-import Logs.Location-import Types.Transfer-import Logs.Transfer+import Annex.Content.Presence+import Annex.Content.LowLevel+import Annex.Content.PointerFile import qualified Git import qualified Annex import qualified Annex.Queue import qualified Annex.Branch-import Utility.FileMode import qualified Annex.Url as Url-import Utility.CopyFile-import Utility.Metered+import qualified Backend+import qualified Database.Keys import Git.FilePath import Annex.Perms import Annex.Link import Annex.LockPool-import Annex.WorkerPool+import Annex.UUID+import Annex.InodeSentinal+import Annex.AdjustedBranch (adjustedBranchRefresh) import Messages.Progress-import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))-import qualified Types.Remote-import qualified Types.Backend-import qualified Backend-import qualified Database.Keys+import Types.Remote (RetrievalSecurityPolicy(..)) import Types.NumCopies import Types.Key-import Annex.UUID-import Annex.InodeSentinal+import Types.Transfer+import Logs.Transfer+import Logs.Location import Utility.InodeCache-import Annex.Content.LowLevel-import Annex.Content.PointerFile-import Types.WorkerPool+import Utility.CopyFile+import Utility.Metered import qualified Utility.RawFilePath as R  import qualified System.FilePath.ByteString as P -{- Checks if a given key's content is currently present. -}-inAnnex :: Key -> Annex Bool-inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist--{- Runs an arbitrary check on a key's content. -}-inAnnexCheck :: Key -> (RawFilePath -> Annex Bool) -> Annex Bool-inAnnexCheck key check = inAnnex' id False check key--{- inAnnex that performs an arbitrary check of the key's content. -}-inAnnex' :: (a -> Bool) -> a -> (RawFilePath -> Annex a) -> Key -> Annex a-inAnnex' isgood bad check key = withObjectLoc key $ \loc -> do-	r <- check loc-	if isgood r-		then ifM (annexThin <$> Annex.getGitConfig)-			-- When annex.thin is set, the object file-			-- could be modified; make sure it's not.-			-- (Suppress any messages about-			-- checksumming, to avoid them cluttering-			-- the display.)-			( ifM (doQuietAction $ isUnmodified key loc)-				( return r-				, return bad-				)-			, return r-			)-		else return bad--{- Like inAnnex, checks if the object file for a key exists,- - but there are no guarantees it has the right content. -}-objectFileExists :: Key -> Annex Bool-objectFileExists key =-	calcRepo (gitAnnexLocation key)-		>>= liftIO . R.doesPathExist--{- A safer check; the key's content must not only be present, but- - is not in the process of being removed. -}-inAnnexSafe :: Key -> Annex (Maybe Bool)-inAnnexSafe key = inAnnex' (fromMaybe True) (Just False) go key-  where-	is_locked = Nothing-	is_unlocked = Just True-	is_missing = Just False--	go contentfile = flip checklock contentfile =<< contentLockFile key--#ifndef mingw32_HOST_OS-	checklock Nothing contentfile = checkOr is_missing contentfile-	{- The content file must exist, but the lock file generally-	 - won't exist unless a removal is in process. -}-	checklock (Just lockfile) contentfile =-		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))-			( checkOr is_unlocked lockfile-			, return is_missing-			)-	checkOr d lockfile = checkLocked lockfile >>= return . \case-		Nothing -> d-		Just True -> is_locked-		Just False -> is_unlocked-#else-	checklock Nothing contentfile = liftIO $ ifM (doesFileExist (fromRawFilePath contentfile))-		( lockShared contentfile >>= \case-			Nothing -> return is_locked-			Just lockhandle -> do-				dropLock lockhandle-				return is_unlocked-		, return is_missing-		)-	{- In Windows, see if we can take a shared lock. If so, -	 - remove the lock file to clean up after ourselves. -}-	checklock (Just lockfile) contentfile =-		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))-			( modifyContent lockfile $ liftIO $-				lockShared lockfile >>= \case-					Nothing -> return is_locked-					Just lockhandle -> do-						dropLock lockhandle-						void $ tryIO $ removeWhenExistsWith removeLink lockfile-						return is_unlocked-			, return is_missing-			)-#endif--{- Windows has to use a separate lock file from the content, since- - locking the actual content file would interfere with the user's- - use of it. -}-contentLockFile :: Key -> Annex (Maybe RawFilePath)-#ifndef mingw32_HOST_OS-contentLockFile _ = pure Nothing-#else-contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)-#endif- {- Prevents the content from being removed while the action is running.  - Uses a shared lock.  -@@ -249,7 +154,7 @@ winLocker takelock _ (Just lockfile) = do 	modifyContent lockfile $ 		void $ liftIO $ tryIO $-			writeFile lockfile ""+			writeFile (fromRawFilePath lockfile) "" 	liftIO $ takelock lockfile -- never reached; windows always uses a separate lock file winLocker _ _ Nothing = return Nothing@@ -299,15 +204,15 @@ {- Runs an action, passing it the temp file to get,  - and if the action succeeds, verifies the file matches  - the key and moves the file into the annex as a key's content. -}-getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool-getViaTmp rsp v key action = checkDiskSpaceToGet key False $-	getViaTmpFromDisk rsp v key action+getViaTmp :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool+getViaTmp rsp v key af action = checkDiskSpaceToGet key False $+	getViaTmpFromDisk rsp v key af action  {- Like getViaTmp, but does not check that there is enough disk space  - for the incoming key. For use when the key content is already on disk  - and not being copied into place. -}-getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool-getViaTmpFromDisk rsp v key action = checkallowed $ do+getViaTmpFromDisk :: RetrievalSecurityPolicy -> VerifyConfig -> Key -> AssociatedFile -> (RawFilePath -> Annex (Bool, Verification)) -> Annex Bool+getViaTmpFromDisk rsp v key af action = checkallowed $ do 	tmpfile <- prepTmp key 	resuming <- liftIO $ R.doesPathExist tmpfile 	(ok, verification) <- action tmpfile@@ -322,7 +227,7 @@ 		else verification 	if ok 		then ifM (verifyKeyContent rsp v verification' key tmpfile)-			( ifM (pruneTmpWorkDirBefore tmpfile (moveAnnex key))+			( ifM (pruneTmpWorkDirBefore tmpfile (moveAnnex key af)) 				( do 					logStatus key InfoPresent 					return True@@ -357,71 +262,6 @@ 				) 			) -{- Verifies that a file is the expected content of a key.- -- - Configuration can prevent verification, for either a- - particular remote or always, unless the RetrievalSecurityPolicy- - requires verification.- -- - Most keys have a known size, and if so, the file size is checked.- -- - When the key's backend allows verifying the content (via checksum),- - it is checked. - -- - If the RetrievalSecurityPolicy requires verification and the key's- - backend doesn't support it, the verification will fail.- -}-verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool-verifyKeyContent rsp v verification k f = case (rsp, verification) of-	(_, Verified) -> return True-	(RetrievalVerifiableKeysSecure, _) -> ifM (Backend.isVerifiable k)-		( verify-		, ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)-			( verify-			, warnUnverifiableInsecure k >> return False-			)-		)-	(_, UnVerified) -> ifM (shouldVerify v)-		( verify-		, return True-		)-	(_, MustVerify) -> verify-  where-	verify = enteringStage VerifyStage $ verifysize <&&> verifycontent-	verifysize = case fromKey keySize k of-		Nothing -> return True-		Just size -> do-			size' <- liftIO $ catchDefaultIO 0 $ getFileSize f-			return (size' == size)-	verifycontent = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case-		Nothing -> return True-		Just b -> case Types.Backend.verifyKeyContent b of-			Nothing -> return True-			Just verifier -> verifier k f--warnUnverifiableInsecure :: Key -> Annex ()-warnUnverifiableInsecure k = warning $ unwords-	[ "Getting " ++ kv ++ " keys with this remote is not secure;"-	, "the content cannot be verified to be correct."-	, "(Use annex.security.allow-unverified-downloads to bypass"-	, "this safety check.)"-	]-  where-	kv = decodeBS (formatKeyVariety (fromKey keyVariety k))--data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify--shouldVerify :: VerifyConfig -> Annex Bool-shouldVerify AlwaysVerify = return True-shouldVerify NoVerify = return False-shouldVerify DefaultVerify = annexVerify <$> Annex.getGitConfig-shouldVerify (RemoteVerify r) = -	(shouldVerify DefaultVerify-			<&&> pure (remoteAnnexVerify (Types.Remote.gitconfig r)))-	-- Export remotes are not key/value stores, so always verify-	-- content from them even when verification is disabled.-	<||> Types.Remote.isExportSupported r- {- Checks if there is enough free disk space to download a key  - to its temp file.  -@@ -490,8 +330,8 @@  - accepted into the repository. Will display a warning message in this  - case. May also throw exceptions in some cases.  -}-moveAnnex :: Key -> RawFilePath -> Annex Bool-moveAnnex key src = ifM (checkSecureHashes' key)+moveAnnex :: Key -> AssociatedFile -> RawFilePath -> Annex Bool+moveAnnex key af src = ifM (checkSecureHashes' key) 	( do 		withObjectLoc key storeobject 		return True@@ -500,7 +340,7 @@   where 	storeobject dest = ifM (liftIO $ R.doesPathExist dest) 		( alreadyhave-		, modifyContent dest $ do+		, adjustedBranchRefresh af $ modifyContent dest $ do 			freezeContent src 			liftIO $ moveFile 				(fromRawFilePath src)@@ -648,10 +488,6 @@ 		then Nothing 		else Just (fromRawFilePath f, sameInodeCache f cache') -{- Performs an action, passing it the location to use for a key's content. -}-withObjectLoc :: Key -> (RawFilePath -> Annex a) -> Annex a-withObjectLoc key a = a =<< calcRepo (gitAnnexLocation key)- cleanObjectLoc :: Key -> Annex () -> Annex () cleanObjectLoc key cleaner = do 	file <- calcRepo (gitAnnexLocation key)@@ -665,8 +501,7 @@ 		maybe noop (const $ removeparents dir (n-1)) 			<=< catchMaybeIO $ removeDirectory (fromRawFilePath dir) -{- Removes a key's file from .git/annex/objects/- -}+{- Removes a key's file from .git/annex/objects/ -} removeAnnex :: ContentRemovalLock -> Annex () removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file -> 	cleanObjectLoc key $ do@@ -680,54 +515,14 @@ 	-- Check associated pointer file for modifications, and reset if 	-- it's unmodified. 	resetpointer file = ifM (isUnmodified key file)-		( depopulatePointerFile key file+		( adjustedBranchRefresh (AssociatedFile (Just file)) $+			depopulatePointerFile key file 		-- Modified file, so leave it alone. 		-- If it was a hard link to the annex object, 		-- that object might have been frozen as part of the 		-- removal process, so thaw it. 		, void $ tryIO $ thawContent file 		)--{- Check if a file contains the unmodified content of the key.- -- - The expensive way to tell is to do a verification of its content.- - The cheaper way is to see if the InodeCache for the key matches the- - file. -}-isUnmodified :: Key -> RawFilePath -> Annex Bool-isUnmodified key f = go =<< geti-  where-	go Nothing = return False-	go (Just fc) = isUnmodifiedCheap' key fc <||> expensivecheck fc-	expensivecheck fc = ifM (verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified key f)-		( do-			-- The file could have been modified while it was-			-- being verified. Detect that.-			ifM (geti >>= maybe (return False) (compareInodeCaches fc))-				( do-					-- Update the InodeCache to avoid-					-- performing this expensive check again.-					Database.Keys.addInodeCaches key [fc]-					return True-				, return False-				)-		, return False-		)-	geti = withTSDelta (liftIO . genInodeCache f)--{- Cheap check if a file contains the unmodified content of the key,- - only checking the InodeCache of the key.- -- - Note that, on systems not supporting high-resolution mtimes,- - this may report a false positive when repeated edits are made to a file- - within a small time window (eg 1 second).- -}-isUnmodifiedCheap :: Key -> RawFilePath -> Annex Bool-isUnmodifiedCheap key f = maybe (return False) (isUnmodifiedCheap' key) -	=<< withTSDelta (liftIO . genInodeCache f)--isUnmodifiedCheap' :: Key -> InodeCache -> Annex Bool-isUnmodifiedCheap' key fc = -	anyM (compareInodeCaches fc) =<< Database.Keys.getInodeCaches key  {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and  - returns the file it was moved to. -}
Annex/Content/LowLevel.hs view
@@ -18,7 +18,6 @@ import Utility.CopyFile import qualified Utility.RawFilePath as R -import System.PosixCompat.Files import qualified System.FilePath.ByteString as P  {- Runs the secure erase command if set, otherwise does nothing.@@ -75,8 +74,9 @@ 		=<< liftIO (R.getFileStatus src)  checkedCopyFile' :: Key -> RawFilePath -> RawFilePath -> Maybe FileMode -> FileStatus -> Annex Bool-checkedCopyFile' key src dest destmode s = catchBoolIO $-	ifM (checkDiskSpace' (fromIntegral $ fileSize s) (Just $ P.takeDirectory dest) key 0 True)+checkedCopyFile' key src dest destmode s = catchBoolIO $ do+	sz <- liftIO $ getFileSize' src s+	ifM (checkDiskSpace' sz (Just $ P.takeDirectory dest) key 0 True) 		( liftIO $ 			copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest) 				<&&> preserveGitMode dest destmode
Annex/Content/PointerFile.hs view
@@ -9,12 +9,6 @@  module Annex.Content.PointerFile where -#if ! defined(mingw32_HOST_OS)-import System.Posix.Files-#else-import System.PosixCompat.Files-#endif- import Annex.Common import Annex.Perms import Annex.Link@@ -22,10 +16,11 @@ import Annex.InodeSentinal import Annex.Content.LowLevel import Utility.InodeCache+import qualified Utility.RawFilePath as R #if ! defined(mingw32_HOST_OS) import Utility.Touch+import System.Posix.Files (modificationTimeHiRes) #endif-import qualified Utility.RawFilePath as R  {- Populates a pointer file with the content of a key.   -
+ Annex/Content/Presence.hs view
@@ -0,0 +1,246 @@+{- git-annex object content presence+ -+ - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE CPP #-}++module Annex.Content.Presence (+	inAnnex,+	inAnnex',+	inAnnexSafe,+	inAnnexCheck,+	objectFileExists,+	withObjectLoc,+	isUnmodified,+	isUnmodifiedCheap,+	verifyKeyContent,+	VerifyConfig(..),+	Verification(..),+	unVerified,+	warnUnverifiableInsecure,+	contentLockFile,+) where++import Annex.Common+import qualified Annex+import Annex.LockPool+import Annex.WorkerPool+import Types.Remote (unVerified, Verification(..), RetrievalSecurityPolicy(..))+import qualified Types.Remote+import qualified Types.Backend+import qualified Backend+import qualified Database.Keys+import Types.Key+import Annex.InodeSentinal+import Utility.InodeCache+import Types.WorkerPool+import qualified Utility.RawFilePath as R++#ifdef mingw32_HOST_OS+import Annex.Perms+#endif++{- Checks if a given key's content is currently present. -}+inAnnex :: Key -> Annex Bool+inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist++{- Runs an arbitrary check on a key's content. -}+inAnnexCheck :: Key -> (RawFilePath -> Annex Bool) -> Annex Bool+inAnnexCheck key check = inAnnex' id False check key++{- inAnnex that performs an arbitrary check of the key's content. -}+inAnnex' :: (a -> Bool) -> a -> (RawFilePath -> Annex a) -> Key -> Annex a+inAnnex' isgood bad check key = withObjectLoc key $ \loc -> do+	r <- check loc+	if isgood r+		then ifM (annexThin <$> Annex.getGitConfig)+			-- When annex.thin is set, the object file+			-- could be modified; make sure it's not.+			-- (Suppress any messages about+			-- checksumming, to avoid them cluttering+			-- the display.)+			( ifM (doQuietAction $ isUnmodified key loc)+				( return r+				, return bad+				)+			, return r+			)+		else return bad++{- Like inAnnex, checks if the object file for a key exists,+ - but there are no guarantees it has the right content. -}+objectFileExists :: Key -> Annex Bool+objectFileExists key =+	calcRepo (gitAnnexLocation key)+		>>= liftIO . R.doesPathExist++{- A safer check; the key's content must not only be present, but+ - is not in the process of being removed. -}+inAnnexSafe :: Key -> Annex (Maybe Bool)+inAnnexSafe key = inAnnex' (fromMaybe True) (Just False) go key+  where+	is_locked = Nothing+	is_unlocked = Just True+	is_missing = Just False++	go contentfile = flip checklock contentfile =<< contentLockFile key++#ifndef mingw32_HOST_OS+	checklock Nothing contentfile = checkOr is_missing contentfile+	{- The content file must exist, but the lock file generally+	 - won't exist unless a removal is in process. -}+	checklock (Just lockfile) contentfile =+		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))+			( checkOr is_unlocked lockfile+			, return is_missing+			)+	checkOr d lockfile = checkLocked lockfile >>= return . \case+		Nothing -> d+		Just True -> is_locked+		Just False -> is_unlocked+#else+	checklock Nothing contentfile = liftIO $ ifM (doesFileExist (fromRawFilePath contentfile))+		( lockShared contentfile >>= \case+			Nothing -> return is_locked+			Just lockhandle -> do+				dropLock lockhandle+				return is_unlocked+		, return is_missing+		)+	{- In Windows, see if we can take a shared lock. If so, +	 - remove the lock file to clean up after ourselves. -}+	checklock (Just lockfile) contentfile =+		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))+			( modifyContent lockfile $ liftIO $+				lockShared lockfile >>= \case+					Nothing -> return is_locked+					Just lockhandle -> do+						dropLock lockhandle+						void $ tryIO $ removeWhenExistsWith R.removeLink lockfile+						return is_unlocked+			, return is_missing+			)+#endif++{- Windows has to use a separate lock file from the content, since+ - locking the actual content file would interfere with the user's+ - use of it. -}+contentLockFile :: Key -> Annex (Maybe RawFilePath)+#ifndef mingw32_HOST_OS+contentLockFile _ = pure Nothing+#else+contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)+#endif++{- Performs an action, passing it the location to use for a key's content. -}+withObjectLoc :: Key -> (RawFilePath -> Annex a) -> Annex a+withObjectLoc key a = a =<< calcRepo (gitAnnexLocation key)++{- Check if a file contains the unmodified content of the key.+ -+ - The expensive way to tell is to do a verification of its content.+ - The cheaper way is to see if the InodeCache for the key matches the+ - file. -}+isUnmodified :: Key -> RawFilePath -> Annex Bool+isUnmodified key f = go =<< geti+  where+	go Nothing = return False+	go (Just fc) = isUnmodifiedCheap' key fc <||> expensivecheck fc+	expensivecheck fc = ifM (verifyKeyContent RetrievalAllKeysSecure AlwaysVerify UnVerified key f)+		( do+			-- The file could have been modified while it was+			-- being verified. Detect that.+			ifM (geti >>= maybe (return False) (compareInodeCaches fc))+				( do+					-- Update the InodeCache to avoid+					-- performing this expensive check again.+					Database.Keys.addInodeCaches key [fc]+					return True+				, return False+				)+		, return False+		)+	geti = withTSDelta (liftIO . genInodeCache f)++{- Cheap check if a file contains the unmodified content of the key,+ - only checking the InodeCache of the key.+ -+ - Note that, on systems not supporting high-resolution mtimes,+ - this may report a false positive when repeated edits are made to a file+ - within a small time window (eg 1 second).+ -}+isUnmodifiedCheap :: Key -> RawFilePath -> Annex Bool+isUnmodifiedCheap key f = maybe (return False) (isUnmodifiedCheap' key) +	=<< withTSDelta (liftIO . genInodeCache f)++isUnmodifiedCheap' :: Key -> InodeCache -> Annex Bool+isUnmodifiedCheap' key fc = +	anyM (compareInodeCaches fc) =<< Database.Keys.getInodeCaches key++{- Verifies that a file is the expected content of a key.+ -+ - Configuration can prevent verification, for either a+ - particular remote or always, unless the RetrievalSecurityPolicy+ - requires verification.+ -+ - Most keys have a known size, and if so, the file size is checked.+ -+ - When the key's backend allows verifying the content (via checksum),+ - it is checked. + -+ - If the RetrievalSecurityPolicy requires verification and the key's+ - backend doesn't support it, the verification will fail.+ -}+verifyKeyContent :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> RawFilePath -> Annex Bool+verifyKeyContent rsp v verification k f = case (rsp, verification) of+	(_, Verified) -> return True+	(RetrievalVerifiableKeysSecure, _) -> ifM (Backend.isVerifiable k)+		( verify+		, ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)+			( verify+			, warnUnverifiableInsecure k >> return False+			)+		)+	(_, UnVerified) -> ifM (shouldVerify v)+		( verify+		, return True+		)+	(_, MustVerify) -> verify+  where+	verify = enteringStage VerifyStage $ verifysize <&&> verifycontent+	verifysize = case fromKey keySize k of+		Nothing -> return True+		Just size -> do+			size' <- liftIO $ catchDefaultIO 0 $ getFileSize f+			return (size' == size)+	verifycontent = Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case+		Nothing -> return True+		Just b -> case Types.Backend.verifyKeyContent b of+			Nothing -> return True+			Just verifier -> verifier k f++warnUnverifiableInsecure :: Key -> Annex ()+warnUnverifiableInsecure k = warning $ unwords+	[ "Getting " ++ kv ++ " keys with this remote is not secure;"+	, "the content cannot be verified to be correct."+	, "(Use annex.security.allow-unverified-downloads to bypass"+	, "this safety check.)"+	]+  where+	kv = decodeBS (formatKeyVariety (fromKey keyVariety k))++data VerifyConfig = AlwaysVerify | NoVerify | RemoteVerify Remote | DefaultVerify++shouldVerify :: VerifyConfig -> Annex Bool+shouldVerify AlwaysVerify = return True+shouldVerify NoVerify = return False+shouldVerify DefaultVerify = annexVerify <$> Annex.getGitConfig+shouldVerify (RemoteVerify r) = +	(shouldVerify DefaultVerify+			<&&> pure (remoteAnnexVerify (Types.Remote.gitconfig r)))+	-- Export remotes are not key/value stores, so always verify+	-- content from them even when verification is disabled.+	<||> Types.Remote.isExportSupported r
Annex/ExternalAddonProcess.hs view
@@ -53,7 +53,7 @@ 			Left _ -> runerr cmdpath 	 	started cmd errrelayer pall@(Just hin, Just hout, Just herr, ph) = do-		stderrelay <- async $ errrelayer herr+		stderrelay <- async $ errrelayer ph herr 		let shutdown forcestop = do 			-- Close the process's stdin, to let it know there 			-- are no more requests, so it will exit.
Annex/Import.hs view
@@ -460,7 +460,7 @@ 					ia loc cid (fromRawFilePath tmpfile) 					(pure k) 					(combineMeterUpdate p' p)-				ok <- moveAnnex k' tmpfile+				ok <- moveAnnex k' af tmpfile 				when ok $ 					logStatus k InfoPresent 				return (Just (k', ok))@@ -503,7 +503,7 @@ 				p 			case keyGitSha k of 				Nothing -> do-					ok <- moveAnnex k tmpfile+					ok <- moveAnnex k af tmpfile 					when ok $ do 						recordcidkey cidmap db cid k 						logStatus k InfoPresent
Annex/Ingest.hs view
@@ -49,9 +49,9 @@ import Annex.InodeSentinal import Annex.AdjustedBranch import Annex.FileMatcher+import qualified Utility.RawFilePath as R  import Control.Exception (IOException)-import qualified Utility.RawFilePath as R  data LockedDown = LockedDown 	{ lockDownConfig :: LockDownConfig@@ -113,7 +113,7 @@ 			(tmpfile, h) <- openTempFile (fromRawFilePath tmpdir) $ 				relatedTemplate $ "ingest-" ++ takeFileName file 			hClose h-			removeWhenExistsWith removeLink tmpfile+			removeWhenExistsWith R.removeLink (toRawFilePath tmpfile) 			withhardlink' delta tmpfile 				`catchIO` const (nohardlink' delta) @@ -177,13 +177,19 @@ 	go _ _ Nothing = failure "failed to generate a key"  	golocked key mcache s =-		tryNonAsync (moveAnnex key $ contentLocation source) >>= \case+		tryNonAsync (moveAnnex key naf (contentLocation source)) >>= \case 			Right True -> do 				populateAssociatedFiles key source restage 				success key mcache s		 			Right False -> giveup "failed to add content to annex" 			Left e -> restoreFile (keyFilename source) key e +	-- moveAnnex uses the AssociatedFile provided to it to unlock+	-- locked files when getting a file in an adjusted branch.+	-- That case does not apply here, where we're adding an unlocked+	-- file, so provide it nothing.+	naf = AssociatedFile Nothing+ 	gounlocked key (Just cache) s = do 		-- Remove temp directory hard link first because 		-- linkToAnnex falls back to copying if a file@@ -352,7 +358,7 @@ 		stagePointerFile file mode =<< hashPointerFile key 		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) 		case mtmp of-			Just tmp -> ifM (moveAnnex key tmp)+			Just tmp -> ifM (moveAnnex key af tmp) 				( linkunlocked mode >> return True 				, writepointer mode >> return False 				)@@ -363,10 +369,11 @@ 	, do 		addLink ci file key Nothing 		case mtmp of-			Just tmp -> moveAnnex key tmp+			Just tmp -> moveAnnex key af tmp 			Nothing -> return True 	)   where+	af = AssociatedFile (Just file) 	mi = case mtmp of 		Just tmp -> MatchingFile $ FileInfo 			{ contentFile = Just tmp
Annex/Init.hs view
@@ -49,19 +49,21 @@ import Upgrade import Annex.Tmp import Utility.UserInfo-import Utility.ThreadScheduler import qualified Utility.RawFilePath as R #ifndef mingw32_HOST_OS+import Utility.ThreadScheduler import Annex.Perms import Utility.FileMode import System.Posix.User import qualified Utility.LockFile.Posix as Posix-import Data.Either #endif  import qualified Data.Map as M+#ifndef mingw32_HOST_OS+import Data.Either import qualified System.FilePath.ByteString as P import Control.Concurrent.Async+#endif  checkCanInitialize :: Annex a -> Annex a checkCanInitialize a = canInitialize' >>= \case@@ -210,9 +212,9 @@   where 	probe f = catchDefaultIO (True, []) $ do 		let f2 = f ++ "2"-		removeWhenExistsWith removeLink f2+		removeWhenExistsWith R.removeLink (toRawFilePath f2) 		createSymbolicLink f f2-		removeWhenExistsWith removeLink f2+		removeWhenExistsWith R.removeLink (toRawFilePath f2) 		preventWrite (toRawFilePath f) 		-- Should be unable to write to the file, unless 		-- running as root, but some crippled
Annex/PidLock.hs view
@@ -10,10 +10,10 @@ module Annex.PidLock where  import Annex.Common-import Annex.GitOverlay import Git-import Git.Env #ifndef mingw32_HOST_OS+import Git.Env+import Annex.GitOverlay import qualified Utility.LockFile.PidLock as PidF import qualified Utility.LockPool.PidLock as PidP import Utility.LockPool (dropLock)
Annex/Ssh.hs view
@@ -337,7 +337,7 @@ 		} 	void $ liftIO $ catchMaybeIO $ withCreateProcess p $ \_ _ _ pid -> 		forceSuccessProcess p pid-	liftIO $ removeWhenExistsWith removeLink socketfile+	liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath socketfile)  {- This needs to be as short as possible, due to limitations on the length  - of the path to a socket file. At the same time, it needs to be unique
Annex/Tmp.hs view
@@ -12,6 +12,7 @@ import Annex.LockFile import Annex.Perms import Types.CleanupActions+import qualified Utility.RawFilePath as R  import Data.Time.Clock.POSIX @@ -67,5 +68,5 @@ 		let oldenough = now - (60 * 60 * 24 * 7) 		catchMaybeIO (modificationTime <$> getSymbolicLinkStatus f) >>= \case 			Just mtime | realToFrac mtime <= oldenough -> -				void $ tryIO $ removeWhenExistsWith removeLink f+				void $ tryIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) 			_ -> return ()
Annex/View/ViewedFile.hs view
@@ -83,7 +83,7 @@ prop_viewedFile_roundtrips tf 	-- Relative filenames wanted, not directories. 	| any (isPathSeparator) (end f ++ beginning f) = True-	| isAbsolute f = True+	| isAbsolute f || isDrive f = True 	| otherwise = dir == dirFromViewedFile (viewedFileFromReference f)   where 	f = fromTestableFilePath tf
Annex/YoutubeDl.hs view
@@ -225,15 +225,18 @@ 		liftIO $ withCreateProcess p waitproc 	 	waitproc Nothing (Just o) (Just e) pid = do-		output <- fmap fst $ -			hGetContentsStrict o-				`concurrently`-			hGetContentsStrict e+		errt <- async $ discardstderr pid e+		output <- hGetContentsStrict o 		ok <- liftIO $ checkSuccessProcess pid+		wait errt 		return $ case (ok, lines output) of 			(True, (f:_)) | not (null f) -> Right f 			_ -> nomedia 	waitproc _ _ _ _ = error "internal"++	discardstderr pid e = hGetLineUntilExitOrEOF pid e >>= \case+		Nothing -> return ()+		Just _ -> discardstderr pid e  	nomedia = Left "no media in url"
Assistant.hs view
@@ -102,7 +102,7 @@ 		createAnnexDirectory (parentDir logfile) 		ifM (liftIO $ isNothing <$> getEnv flag) 			( liftIO $ withNullHandle $ \nullh -> do-				loghandle <- openLog logfile+				loghandle <- openLog (fromRawFilePath logfile) 				e <- getEnvironment 				cmd <- programPath 				ps <- getArgs@@ -115,7 +115,7 @@ 				exitcode <- withCreateProcess p $ \_ _ _ pid -> 					waitForProcess pid 				exitWith exitcode-			, start (Utility.Daemon.foreground (Just pidfile)) $+			, start (Utility.Daemon.foreground (Just (fromRawFilePath pidfile))) $ 				case startbrowser of 					Nothing -> Nothing 					Just a -> Just $ a Nothing Nothing
Assistant/Repair.hs view
@@ -30,6 +30,7 @@ #endif import qualified Utility.Lsof as Lsof import Utility.ThreadScheduler+import qualified Utility.RawFilePath as R  import Control.Concurrent.Async @@ -149,7 +150,7 @@ 			waitforit "to check stale git lock file" 			l' <- getsizes 			if l' == l-				then liftIO $ mapM_ (removeWhenExistsWith removeLink . fst) l+				then liftIO $ mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath . fst) l 				else go l' 		, do 			waitforit "for git lock file writer"
Assistant/Threads/Upgrader.hs view
@@ -31,7 +31,7 @@  upgraderThread :: UrlRenderer -> NamedThread upgraderThread urlrenderer = namedThread "Upgrader" $-	when (isJust BuildInfo.upgradelocation) $ do+	when upgradeSupported $ do 		{- Check for upgrade on startup, unless it was just 		 - upgraded. -} 		unlessM (liftIO checkSuccessfulUpgrade) $
Assistant/Upgrade.hs view
@@ -41,6 +41,7 @@ import qualified Utility.Url as Url import qualified Annex.Url as Url hiding (download) import Utility.Tuple+import qualified Utility.RawFilePath as R  import Data.Either import qualified Data.Map as M@@ -220,7 +221,7 @@ 			error $ "did not find " ++ dir ++ " in " ++ distributionfile 	makeorigsymlink olddir = do 		let origdir = fromRawFilePath (parentDir (toRawFilePath olddir)) </> installBase-		removeWhenExistsWith removeLink origdir+		removeWhenExistsWith R.removeLink (toRawFilePath origdir) 		createSymbolicLink newdir origdir  {- Finds where the old version was installed. -}@@ -278,8 +279,8 @@ deleteFromManifest :: FilePath -> IO () deleteFromManifest dir = do 	fs <- map (dir </>) . lines <$> catchDefaultIO "" (readFile manifest)-	mapM_ (removeWhenExistsWith removeLink) fs-	removeWhenExistsWith removeLink manifest+	mapM_ (removeWhenExistsWith R.removeLink . toRawFilePath) fs+	removeWhenExistsWith R.removeLink (toRawFilePath manifest) 	removeEmptyRecursive dir   where 	manifest = dir </> "git-annex.MANIFEST"@@ -337,6 +338,18 @@  distributionInfoSigUrl :: String distributionInfoSigUrl = distributionInfoUrl ++ ".sig"++{- Upgrade only supported on linux and OSX. -}+upgradeSupported :: Bool+#ifdef linux_HOST_OS+upgradeSupported = isJust BuildInfo.upgradelocation+#else+#ifdef darwin_HOST_OS+upgradeSupported = isJust BuildInfo.upgradelocation+#else+upgradeSupported = False+#endif+#endif  {- Verifies that a file from the git-annex distribution has a valid  - signature. Pass the detached .sig file; the file to be verified should
Assistant/WebApp/Configurators/Preferences.hs view
@@ -21,7 +21,7 @@ import Utility.DataUnits import Git.Config import Types.Distribution-import qualified BuildInfo+import Assistant.Upgrade  import qualified Data.Text as T import qualified System.FilePath.ByteString as P@@ -59,7 +59,7 @@ 		, ("disabled", NoAutoUpgrade) 		] 	autoUpgradeLabel-		| isJust BuildInfo.upgradelocation = "Auto upgrade"+		| upgradeSupported = "Auto upgrade" 		| otherwise = "Auto restart on upgrade"  	positiveIntField = check isPositive intField
CHANGELOG view
@@ -1,3 +1,32 @@+git-annex (8.20201127) upstream; urgency=medium++  * adjust: New --unlock-present mode which locks files whose content is not+    present (so the broken symlink is visible), while unlocking files whose+    content is present.+  * Added annex.adjustedbranchrefresh git config to update adjusted+    branches set up by git-annex adjust --unlock-present/--hide-missing.+  * Fix hang when an external special remote program exited but+    the stderr pipe to it was left open, due to a daemon having inherited+    the file descriptor.+  * Fix a bug that could make resuming a download from the web fail+    when the entire content of the file is actually already present+    locally.+  * examinekey: Added a "file" format variable for consistency with find,+    and for easier scripting.+  * init: When writing hook scripts, set all execute bits, not only+    the user execute bit.+  * upgrade: Support an edge case upgrading a v5 direct mode repo+    where nothing had ever been committed to the head branch.+  * Made the test suite significantly less noisy, only displaying command+    output when something failed.+  * Fix building without the torrent library.+    Thanks, Kyle Meyer.+  * Fix build on Windows.+  * Prevent windows assistant from trying (and failing) to upgrade+    itself, which has never been supported on windows.++ -- Joey Hess <id@joeyh.name>  Fri, 27 Nov 2020 12:54:11 -0400+ git-annex (8.20201116) upstream; urgency=medium    * move: Fix a regression in the last release that made move --to not
Command/Adjust.hs view
@@ -19,6 +19,7 @@ optParser _ = 	(LinkAdjustment <$> linkAdjustmentParser) 	<|> (PresenceAdjustment <$> presenceAdjustmentParser <*> maybeLinkAdjustmentParser)+	<|> (LinkPresentAdjustment <$> linkPresentAdjustmentParser)  linkAdjustmentParser :: Parser LinkAdjustment linkAdjustmentParser =@@ -43,6 +44,13 @@ 	flag' HideMissingAdjustment 		( long "hide-missing" 		<> help "hide annexed files whose content is not present"+		)++linkPresentAdjustmentParser :: Parser LinkPresentAdjustment+linkPresentAdjustmentParser =+	flag' UnlockPresentAdjustment+		( long "unlock-present"+		<> help "unlock files whose content is present; lock rest" 		)  seek :: Adjustment -> CommandSeek
Command/ExamineKey.hs view
@@ -9,7 +9,7 @@  import Command import qualified Utility.Format-import Command.Find (parseFormatOption, showFormatted, keyVars)+import Command.Find (parseFormatOption, showFormatted, formatVars) import Annex.Link import Backend import Types.Backend@@ -57,7 +57,7 @@ 	showFormatted (format o) (serializeKey' k) $ 		[ ("objectpath", fromRawFilePath objectpath) 		, ("objectpointer", fromRawFilePath objectpointer)-		] ++ keyVars k+		] ++ formatVars k af 	return True   where 	-- Parse the input, which is either a key, or in batch mode
Command/Find.hs view
@@ -75,7 +75,8 @@  start :: FindOptions -> SeekInput -> RawFilePath -> Key -> CommandStart start o _ file key = startingCustomOutput key $ do-	showFormatted (formatOption o) file $ ("file", fromRawFilePath file) : keyVars key+	showFormatted (formatOption o) file +		(formatVars key (AssociatedFile (Just file))) 	next $ return True  startKeys :: FindOptions -> (SeekInput, Key, ActionItem) -> CommandStart@@ -92,8 +93,9 @@ 				Utility.Format.format formatter $ 					M.fromList vars -keyVars :: Key -> [(String, String)]-keyVars key =+formatVars :: Key -> AssociatedFile -> [(String, String)]+formatVars key (AssociatedFile af) =+	(maybe id (\f l -> (("file", fromRawFilePath f) : l)) af) 	[ ("key", serializeKey key) 	, ("backend", decodeBS $ formatKeyVariety $ fromKey keyVariety key) 	, ("bytesize", size show)
Command/FuzzTest.hs view
@@ -17,6 +17,7 @@ import Utility.ThreadScheduler import Utility.DiskFree import Git.Types (fromConfigKey)+import qualified Utility.RawFilePath as R  import Data.Time.Clock import System.Random (getStdRandom, random, randomR)@@ -178,7 +179,7 @@ 	n <- liftIO (getStdRandom random :: IO Int) 	liftIO $ writeFile f $ show n ++ "\n" runFuzzAction (FuzzDelete (FuzzFile f)) = liftIO $-	removeWhenExistsWith removeLink f+	removeWhenExistsWith R.removeLink (toRawFilePath f) runFuzzAction (FuzzMove (FuzzFile src) (FuzzFile dest)) = liftIO $ 	rename src dest runFuzzAction (FuzzDeleteDir (FuzzDir d)) = liftIO $
Command/Get.hs view
@@ -114,7 +114,7 @@ 		| Remote.hasKeyCheap r = 			either (const False) id <$> Remote.hasKey r key 		| otherwise = return True-	docopy r witness = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key $ \dest ->+	docopy r witness = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) key afile $ \dest -> 		download (Remote.uuid r) key afile stdRetry 			(\p -> do 				showAction $ "from " ++ Remote.name r
Command/Move.hs view
@@ -225,7 +225,7 @@   where 	get = notifyTransfer Download afile $  		download (Remote.uuid src) key afile stdRetry $ \p ->-			getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key $ \t ->+			getViaTmp (Remote.retrievalSecurityPolicy src) (RemoteVerify src) key afile $ \t -> 				Remote.verifiedAction $ Remote.retrieveKeyFile src key afile (fromRawFilePath t) p 	 	dispatch _ _ False = stop -- failed
Command/Multicast.hs view
@@ -27,6 +27,7 @@ import Utility.Tmp import Utility.Tmp.Dir import Utility.Process.Transcript+import qualified Utility.RawFilePath as R  import Data.Char import qualified Data.ByteString.Lazy.UTF8 as B8@@ -84,7 +85,7 @@ 		KeyContainer s -> liftIO $ genkey (Param s) 		KeyFile f -> do 			createAnnexDirectory (toRawFilePath (takeDirectory f))-			liftIO $ removeWhenExistsWith removeLink f+			liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) 			liftIO $ protectedOutput $ genkey (File f) 	case (ok, parseFingerprint s) of 		(False, _) -> giveup $ "uftp_keymgt failed: " ++ s@@ -210,9 +211,9 @@ 	case deserializeKey (takeFileName f) of 		Nothing -> do 			warning $ "Received a file " ++ f ++ " that is not a git-annex key. Deleting this file."-			liftIO $ removeWhenExistsWith removeLink f+			liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) 		Just k -> void $-			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k $ \dest -> unVerified $+			getViaTmpFromDisk RetrievalVerifiableKeysSecure AlwaysVerify k (AssociatedFile Nothing) $ \dest -> unVerified $ 				liftIO $ catchBoolIO $ do 					rename f (fromRawFilePath dest) 					return True
Command/P2P.hs view
@@ -24,6 +24,7 @@ import Utility.Tmp.Dir import Utility.FileMode import Utility.ThreadScheduler+import qualified Utility.RawFilePath as R import qualified Utility.MagicWormhole as Wormhole  import Control.Concurrent.Async@@ -256,7 +257,7 @@ 			Wormhole.sendFile sendf observer wormholeparams 				`concurrently` 			Wormhole.receiveFile recvf producer wormholeparams-		liftIO $ removeWhenExistsWith removeLink sendf+		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath sendf) 		if sendres /= True 			then return SendFailed 			else if recvres /= True
Command/ReKey.hs view
@@ -90,7 +90,7 @@ 	 - This avoids hard linking to content linked to an 	 - unlocked file, which would leave the new key unlocked 	 - and vulnerable to corruption. -}-	( getViaTmpFromDisk RetrievalAllKeysSecure DefaultVerify newkey $ \tmp -> unVerified $ do+	( getViaTmpFromDisk RetrievalAllKeysSecure DefaultVerify newkey (AssociatedFile Nothing) $ \tmp -> unVerified $ do 		oldobj <- calcRepo (gitAnnexLocation oldkey) 		isJust <$> linkOrCopy' (return True) newkey oldobj tmp Nothing 	, do
Command/RecvKey.hs view
@@ -33,7 +33,7 @@ 	let verify = if fromunlocked then AlwaysVerify else DefaultVerify 	-- This matches the retrievalSecurityPolicy of Remote.Git 	let rsp = RetrievalAllKeysSecure-	ifM (getViaTmp rsp verify key go)+	ifM (getViaTmp rsp verify key (AssociatedFile Nothing) go) 		( do 			-- forcibly quit after receiving one key, 			-- and shutdown cleanly
Command/Reinject.hs view
@@ -88,7 +88,7 @@ 	)   where 	move = checkDiskSpaceToGet key False $-		moveAnnex key src+		moveAnnex key (AssociatedFile Nothing) src  cleanup :: Key -> CommandCleanup cleanup key = do
Command/SetKey.hs view
@@ -35,7 +35,7 @@ 	-- the file might be on a different filesystem, so moveFile is used 	-- rather than simply calling moveAnnex; disk space is also 	-- checked this way.-	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key $ \dest -> unVerified $+	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) $ \dest -> unVerified $ 		if dest /= file 			then liftIO $ catchBoolIO $ do 				moveFile (fromRawFilePath file) (fromRawFilePath dest)
Command/Sync.hs view
@@ -60,6 +60,7 @@ import Logs.PreferredContent import Annex.AutoMerge import Annex.AdjustedBranch+import Annex.AdjustedBranch.Merge import Annex.Ssh import Annex.BloomFilter import Annex.UpdateInstead@@ -406,17 +407,17 @@ updateBranches (Just branch, madj) = do 	-- When in an adjusted branch, propigate any changes made to it 	-- back to the original branch. The adjusted branch may also need-	-- to be updated to hide/expose files.+	-- to be updated, if the adjustment is not stable, and the usual+	-- configuration does not update it. 	case madj of 		Nothing -> noop 		Just adj -> do 			let origbranch = branch 			propigateAdjustedCommits origbranch adj-			when (adjustmentHidesFiles adj) $ do-				showSideAction "updating adjusted branch"-				let adjbranch = originalToAdjusted origbranch adj-				unlessM (updateAdjustedBranch adj adjbranch origbranch) $-					warning $ unwords [ "Updating adjusted branch failed." ]+			unless (adjustmentIsStable adj) $+				annexAdjustedBranchRefresh <$> Annex.getGitConfig >>= \case+					0 -> adjustedBranchRefreshFull adj origbranch+					_ -> return () 					 	-- Update the sync branch to match the new state of the branch 	inRepo $ updateBranch (syncBranch branch) branch
Command/TestRemote.hs view
@@ -294,7 +294,7 @@ 		Just b -> case Types.Backend.verifyKeyContent b of 			Nothing -> return True 			Just verifier -> verifier k (serializeKey' k)-	get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->+	get r k = getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest -> 		tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case 			Right v -> return (True, v) 			Left _ -> return (False, UnVerified)@@ -368,13 +368,13 @@ 	, check (`notElem` [Right True, Right False]) "checkPresent" $ \r k -> 		Remote.checkPresent r k 	, check (== Right False) "retrieveKeyFile" $ \r k ->-		getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest ->+		getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest -> 			tryNonAsync (Remote.retrieveKeyFile r k (AssociatedFile Nothing) (fromRawFilePath dest) nullMeterUpdate) >>= \case 				Right v -> return (True, v) 				Left _ -> return (False, UnVerified) 	, check (== Right False) "retrieveKeyFileCheap" $ \r k -> case Remote.retrieveKeyFileCheap r of 		Nothing -> return False-		Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k $ \dest -> +		Just a -> getViaTmp (Remote.retrievalSecurityPolicy r) (RemoteVerify r) k (AssociatedFile Nothing) $ \dest ->  			unVerified $ isRight 				<$> tryNonAsync (a k (AssociatedFile Nothing) (fromRawFilePath dest)) 	]@@ -436,7 +436,7 @@ 	k <- case Types.Backend.genKey Backend.Hash.testKeyBackend of 		Just a -> a ks nullMeterUpdate 		Nothing -> giveup "failed to generate random key (backend problem)"-	_ <- moveAnnex k (toRawFilePath f)+	_ <- moveAnnex k (AssociatedFile Nothing) (toRawFilePath f) 	return k  getReadonlyKey :: Remote -> FilePath -> Annex Key
Command/TransferKey.hs view
@@ -63,7 +63,7 @@ fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform fromPerform key file remote = go Upload file $ 	download (uuid remote) key file stdRetry $ \p ->-		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t ->+		getViaTmp (retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> 			tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case 				Right v -> return (True, v)	 				Left e -> do
Command/TransferKeys.hs view
@@ -47,7 +47,7 @@ 						return True 		| otherwise = notifyTransfer direction file $ 			download (Remote.uuid remote) key file stdRetry $ \p ->-				getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key $ \t -> do+				getViaTmp (Remote.retrievalSecurityPolicy remote) (RemoteVerify remote) key file $ \t -> do 					r <- tryNonAsync (Remote.retrieveKeyFile remote key file (fromRawFilePath t) p) >>= \case 						Left e -> do 							warning (show e)
Command/Vicfg.hs view
@@ -32,6 +32,7 @@ import Types.NumCopies import Remote import Git.Types (fromConfigKey, fromConfigValue)+import qualified Utility.RawFilePath as R  cmd :: Command cmd = command "vicfg" SectionSetup "edit configuration in git-annex branch"@@ -58,7 +59,7 @@ 	unlessM (liftIO $ boolSystem "sh" [Param "-c", Param $ unwords [vi, shellEscape f]]) $ 		giveup $ vi ++ " exited nonzero; aborting" 	r <- parseCfg (defCfg curcfg) <$> liftIO (readFileStrict f)-	liftIO $ removeWhenExistsWith removeLink f+	liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) 	case r of 		Left s -> do 			liftIO $ writeFile f s
Command/Whereis.hs view
@@ -95,10 +95,8 @@ 		 			mapM_ (showRemoteUrls remotemap) urls 		Just formatter -> liftIO $ do-			let vs = catMaybes-				[ fmap (("file",) . fromRawFilePath)-					(actionItemWorkTreeFile ai)-				] ++ Command.Find.keyVars key+			let vs = Command.Find.formatVars key+				(AssociatedFile (actionItemWorkTreeFile ai)) 			let showformatted muuid murl = putStr $ 				Utility.Format.format formatter $ 					M.fromList $ vs ++ catMaybes
Common.hs view
@@ -13,7 +13,7 @@ import System.FilePath as X import System.IO as X hiding (FilePath) import System.Exit as X-import System.PosixCompat.Files as X hiding (fileSize)+import System.PosixCompat.Files as X hiding (fileSize, removeLink)  import Utility.Misc as X import Utility.Exception as X
Creds.hs view
@@ -32,12 +32,13 @@ import Types.ProposedAccepted import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Utility.Env (getEnv)+import Utility.Base64+import qualified Utility.RawFilePath as R  import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.ByteString.Char8 as S import qualified Data.Map as M import qualified System.FilePath.ByteString as P-import Utility.Base64  {- A CredPair can be stored in a file, or in the environment, or  - in a remote's configuration. -}@@ -211,9 +212,8 @@  removeCreds :: FilePath -> Annex () removeCreds file = do-	d <- fromRawFilePath <$> fromRepo gitAnnexCredsDir-	let f = d </> file-	liftIO $ removeWhenExistsWith removeLink f+	d <- fromRepo gitAnnexCredsDir+	liftIO $ removeWhenExistsWith R.removeLink (d P.</> toRawFilePath file)  includeCredsInfo :: ParsedRemoteConfig -> CredPairStorage -> [(String, String)] -> Annex [(String, String)] includeCredsInfo pc@(ParsedRemoteConfig cm _) storage info = do
Git/Config.hs view
@@ -22,7 +22,6 @@ import qualified Git.Command import qualified Git.Construct import Utility.UserInfo-import Utility.ThreadScheduler  {- Returns a single git config setting, or a fallback value if not set. -} get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue@@ -186,6 +185,10 @@ 	| s' == "0" = Just False 	| s' == "" = Just False +	-- Git treats any number other than 0 as true,+	-- including negative numbers.+	| S8.all (\c -> isDigit c || c == '-') s' = Just True+ 	| otherwise = Nothing   where 	s' = S8.map toLower s@@ -207,8 +210,8 @@  {- Runs a command to get the configuration of a repo,  - and returns a repo populated with the configuration, as well as the raw- - output and standard error of the command. -}-fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))+ - output and the standard error of the command. -}+fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, String)) fromPipe r cmd params st = tryNonAsync $ withCreateProcess p go   where 	p = (proc cmd $ toCommand params)@@ -216,24 +219,21 @@ 		, std_err = CreatePipe 		} 	go _ (Just hout) (Just herr) pid =-		withAsync (S.hGetContents herr) $ \errreader -> do+		withAsync (getstderr pid herr []) $ \errreader -> do 			val <- S.hGetContents hout-			-- In case the process exits while something else,-			-- like a background process, keeps the stderr handle-			-- open, don't block forever waiting for stderr.-			-- A few seconds after finishing reading stdout-			-- should get any error message.-			err <- either id id <$> -				wait errreader-					`race` (threadDelaySeconds (Seconds 2) >> return mempty)+			err <- wait errreader 			forceSuccessProcess p pid 			r' <- store val st r 			return (r', val, err) 	go _ _ _ _ = error "internal" +	getstderr pid herr c = hGetLineUntilExitOrEOF pid herr >>= \case+		Just l -> getstderr pid herr (l:c)+		Nothing -> return (unlines (reverse c))+ {- Reads git config from a specified file and returns the repo populated  - with the configuration. -}-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))+fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, String)) fromFile r f = fromPipe r "git" 	[ Param "config" 	, Param "--file"
Git/Fsck.hs view
@@ -85,8 +85,8 @@   where 	go _ (Just outh) (Just errh) pid = do 		(o1, o2) <- concurrently-			(parseFsckOutput maxobjs r outh)-			(parseFsckOutput maxobjs r errh)+			(parseFsckOutput maxobjs r outh pid)+			(parseFsckOutput maxobjs r errh pid) 		fsckok <- checkSuccessProcess pid 		case mappend o1 o2 of 			FsckOutput badobjs truncated@@ -121,9 +121,9 @@ findMissing :: [Sha] -> Repo -> IO MissingObjects findMissing objs r = S.fromList <$> filterM (`isMissing` r) objs -parseFsckOutput :: Int -> Repo -> Handle -> IO FsckOutput-parseFsckOutput maxobjs r h = do-	ls <- lines <$> hGetContents h+parseFsckOutput :: Int -> Repo -> Handle -> ProcessHandle -> IO FsckOutput+parseFsckOutput maxobjs r h pid = do+	ls <- getlines [] 	if null ls 		then return NoFsckOutput 		else if all ("duplicateEntries" `isInfixOf`) ls@@ -133,6 +133,10 @@ 				let !truncated = length shas > maxobjs 				missingobjs <- findMissing (take maxobjs shas) r 				return $ FsckOutput missingobjs truncated+  where+	getlines c = hGetLineUntilExitOrEOF pid h >>= \case+		Nothing -> return (reverse c)+		Just l -> getlines (l:c)  isMissing :: Sha -> Repo -> IO Bool isMissing s r = either (const True) (const False) <$> tryIO dump
Git/Hook.hs view
@@ -13,9 +13,7 @@ import Git import Utility.Tmp import Utility.Shell-#ifndef mingw32_HOST_OS import Utility.FileMode-#endif  data Hook = Hook 	{ hookName :: FilePath@@ -55,8 +53,9 @@ 	f = hookFile h r 	go = do 		viaTmp writeFile f (hookScript h)-		p <- getPermissions f-		void $ tryIO $ setPermissions f $ p {executable = True}+		void $ tryIO $ modifyFileMode+			(toRawFilePath f)+			(addModes executeModes) 		return True  {- Removes a hook. Returns False if the hook contained something else, and
Git/Queue.hs view
@@ -207,11 +207,13 @@   where 	gitparams = gitCommandLine 		(Param (getSubcommand action):getParams action) repo+#ifndef mingw32_HOST_OS 	go p (Just h) _ _ pid = do 		hPutStr h $ intercalate "\0" $ toCommand $ getFiles action 		hClose h 		forceSuccessProcess p pid 	go _ _ _ _ _ = error "internal"+#endif runAction repo action@(InternalAction {}) = 	let InternalActionRunner _ runner = getRunner action 	in runner repo (getInternalFiles action)
Git/Repair.hs view
@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Git.Repair ( 	runRepair, 	runRepairOf,@@ -243,11 +245,12 @@ explodePackedRefsFile :: Repo -> IO () explodePackedRefsFile r = do 	let f = packedRefsFile r+	let f' = toRawFilePath f 	whenM (doesFileExist f) $ do 		rs <- mapMaybe parsePacked . lines-			<$> catchDefaultIO "" (safeReadFile f)+			<$> catchDefaultIO "" (safeReadFile f') 		forM_ rs makeref-		removeWhenExistsWith removeLink f+		removeWhenExistsWith R.removeLink f'   where 	makeref (sha, ref) = do 		let gitd = localGitDir r@@ -444,13 +447,13 @@ preRepair :: Repo -> IO () preRepair g = do 	unlessM (validhead <$> catchDefaultIO "" (safeReadFile headfile)) $ do-		removeWhenExistsWith removeLink headfile-		writeFile headfile "ref: refs/heads/master"+		removeWhenExistsWith R.removeLink headfile+		writeFile (fromRawFilePath headfile) "ref: refs/heads/master" 	explodePackedRefsFile g 	unless (repoIsLocalBare g) $ 		void $ tryIO $ allowWrite $ indexFile g   where-	headfile = fromRawFilePath (localGitDir g) </> "HEAD"+	headfile = localGitDir g P.</> "HEAD" 	validhead s = "ref: refs/" `isPrefixOf` s 		|| isJust (extractSha (encodeBS' s)) @@ -616,7 +619,7 @@ successfulRepair :: (Bool, [Branch]) -> Bool successfulRepair = fst -safeReadFile :: FilePath -> IO String+safeReadFile :: RawFilePath -> IO String safeReadFile f = do-	allowRead (toRawFilePath f)-	readFileStrict f+	allowRead f+	readFileStrict (fromRawFilePath f)
Logs/Transfer.hs view
@@ -131,7 +131,7 @@ 	v <- liftIO $ lockShared lck 	liftIO $ case v of 		Nothing -> catchDefaultIO Nothing $-			readTransferInfoFile Nothing tfile+			readTransferInfoFile Nothing (fromRawFilePath tfile) 		Just lockhandle -> do 			dropLock lockhandle 			cleanstale
Messages/Progress.hs view
@@ -140,11 +140,11 @@ 	<$> pure True 	<*> mkStderrEmitter -mkStderrRelayer :: Annex (Handle -> IO ())+mkStderrRelayer :: Annex (ProcessHandle -> Handle -> IO ()) mkStderrRelayer = do 	quiet <- commandProgressDisabled 	emitter <- mkStderrEmitter-	return $ \h -> avoidProgress quiet h emitter+	return $ \ph h -> avoidProgress quiet ph h emitter  {- Generates an IO action that can be used to emit stderr.  -
P2P/Annex.hs view
@@ -76,7 +76,7 @@ 		v <- tryNonAsync $ do 			let runtransfer ti =  				Right <$> transfer download k af (\p ->-					getViaTmp rsp DefaultVerify k $ \tmp ->+					getViaTmp rsp DefaultVerify k af $ \tmp -> 						storefile (fromRawFilePath tmp) o l getb validitycheck p ti) 			let fallback = return $ Left $ 				ProtoFailureMessage "transfer already in progress, or unable to take transfer lock"
P2P/IO.hs view
@@ -37,6 +37,7 @@ import Utility.FileMode import Types.UUID import Annex.ChangedRefs+import qualified Utility.RawFilePath as R  import Control.Monad.Free import Control.Monad.IO.Class@@ -124,7 +125,7 @@ -- the callback. serveUnixSocket :: FilePath -> (Handle -> IO ()) -> IO () serveUnixSocket unixsocket serveconn = do-	removeWhenExistsWith removeLink unixsocket+	removeWhenExistsWith R.removeLink (toRawFilePath unixsocket) 	soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol 	S.bind soc (S.SockAddrUnix unixsocket) 	-- Allow everyone to read and write to the socket,
Remote/BitTorrent.hs view
@@ -382,7 +382,7 @@ 				(d:[]) -> return $ map (splitsize d) files 				_ -> parsefailed (show v)   where-	getfield = btshowmetainfo torrent+	getfield = btshowmetainfo (fromRawFilePath torrent) 	parsefailed s = giveup $ "failed to parse btshowmetainfo output for torrent file: " ++ show s  	-- btshowmetainfo outputs a list of "filename (size)"
Remote/Directory.hs view
@@ -258,7 +258,7 @@ #ifdef mingw32_HOST_OS 	{- Windows needs the files inside the directory to be writable 	 - before it can delete them. -}-	void $ tryIO $ mapM_ allowWrite =<< dirContents dir+	void $ tryIO $ mapM_ (allowWrite . toRawFilePath) =<< dirContents dir #endif 	tryNonAsync (removeDirectoryRecursive dir) >>= \case 		Right () -> return ()@@ -301,10 +301,10 @@  removeExportM :: RawFilePath -> Key -> ExportLocation -> Annex () removeExportM d _k loc = liftIO $ do-	removeWhenExistsWith removeLink src+	removeWhenExistsWith R.removeLink src 	removeExportLocation d loc   where-	src = fromRawFilePath $ exportPath d loc+	src = exportPath d loc  checkPresentExportM :: RawFilePath -> Key -> ExportLocation -> Annex Bool checkPresentExportM d _k loc =@@ -446,7 +446,7 @@ #ifndef mingw32_HOST_OS 			=<< getFdStatus fd #else-			=<< getFileStatus f+			=<< R.getFileStatus f #endif 		guardSameContentIdentifiers cont cid currcid
Remote/Directory/LegacyChunked.hs view
@@ -22,6 +22,7 @@ import Annex.Tmp import Utility.Metered import Utility.Directory.Create+import qualified Utility.RawFilePath as R  withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool withCheckedFiles _ [] _locations _ _ = return False@@ -98,15 +99,15 @@ retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever retrieve locations d basek p c = withOtherTmp $ \tmpdir -> do 	showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."-	let tmp = fromRawFilePath $ -		tmpdir P.</> keyFile basek <> ".directorylegacy.tmp"+	let tmp = tmpdir P.</> keyFile basek <> ".directorylegacy.tmp"+	let tmp' = fromRawFilePath tmp 	let go = \k sink -> do 		liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do 			forM_ fs $-				S.appendFile tmp <=< S.readFile+				S.appendFile tmp' <=< S.readFile 			return True-		b <- liftIO $ L.readFile tmp-		liftIO $ removeWhenExistsWith removeLink tmp+		b <- liftIO $ L.readFile tmp'+		liftIO $ removeWhenExistsWith R.removeLink tmp 		sink b 	byteRetriever go basek p c
Remote/GCrypt.hs view
@@ -487,7 +487,7 @@ 	extract Nothing = (Nothing, r) 	extract (Just r') = (fromConfigValue <$> Git.Config.getMaybe coreGCryptId r', r') -getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString, S.ByteString))+getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString, String)) getConfigViaRsync r gc = do 	(rsynctransport, rsyncurl, _) <- rsyncTransport r gc 	opts <- rsynctransport
Remote/Git.hs view
@@ -690,7 +690,7 @@ 				copier <- mkCopier hardlink st params 				let verify = Annex.Content.RemoteVerify r 				let rsp = RetrievalAllKeysSecure-				res <- Annex.Content.getViaTmp rsp verify key $ \dest ->+				res <- Annex.Content.getViaTmp rsp verify key file $ \dest -> 					metered (Just (combineMeterUpdate meterupdate p)) key $ \_ p' ->  						copier object (fromRawFilePath dest) p' (liftIO checksuccessio) 				Annex.Content.saveState True
Remote/Helper/Special.hs view
@@ -51,6 +51,7 @@ import qualified Git import qualified Git.Construct import Git.Types+import qualified Utility.RawFilePath as R  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -284,10 +285,10 @@ 		withBytes content $ \b -> 			decrypt cmd c cipher (feedBytes b) $ 				readBytes write-		liftIO $ removeWhenExistsWith removeLink f+		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) 	(Nothing, _, FileContent f) -> do 		withBytes content write-		liftIO $ removeWhenExistsWith removeLink f+		liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f) 	(Nothing, _, ByteContent b) -> write b   where 	write b = case mh of
Remote/Helper/Ssh.hs view
@@ -28,7 +28,6 @@  import Control.Concurrent.STM import Control.Concurrent.Async-import qualified Data.ByteString as B  toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam]) toRepo cs r gc remotecmd = do@@ -272,7 +271,7 @@ 			, P2P.connIdent = P2P.ConnIdent $ 				Just $ "ssh connection " ++ show pidnum 			}-		stderrhandlerst <- newStderrHandler err+		stderrhandlerst <- newStderrHandler err pid 		runst <- P2P.mkRunState P2P.Client 		let c = P2P.OpenConnection (runst, conn, pid, stderrhandlerst) 		-- When the connection is successful, the remote@@ -301,32 +300,24 @@ 		modifyTVar' connpool $ 			maybe (Just P2PSshUnsupported) Just -newStderrHandler :: Handle -> IO (TVar StderrHandlerState)-newStderrHandler errh = do+newStderrHandler :: Handle -> ProcessHandle -> IO (TVar StderrHandlerState)+newStderrHandler errh ph = do 	-- stderr from git-annex-shell p2pstdio is initially discarded 	-- because old versions don't support the command. Once it's known 	-- to be running, this is changed to DisplayStderr. 	v <- newTVarIO DiscardStderr-	p <- async $ go v-	void $ async $ ender p v+	void $ async $ go v 	return v   where 	go v = do-		l <- B.hGetLine errh-		atomically (readTVar v) >>= \case-			DiscardStderr -> go v-			DisplayStderr -> do-				B.hPut stderr l-				go v-			EndStderrHandler -> return ()-	-	ender p v = do-		atomically $ do-			readTVar v >>= \case-				EndStderrHandler -> return ()-				_ -> retry-		hClose errh-		cancel p+		hGetLineUntilExitOrEOF ph errh >>= \case+			Nothing -> hClose errh+			Just l -> atomically (readTVar v) >>= \case+				DiscardStderr -> go v+				DisplayStderr -> do+					hPutStrLn stderr l+					go v+				EndStderrHandler -> hClose errh  -- Runs a P2P Proto action on a remote when it supports that, -- otherwise the fallback action.
Test.hs view
@@ -247,15 +247,14 @@ 		d <- newmainrepodir 		setmainrepodir d 		innewrepo $ do-			git_annex "init" [reponame, "--quiet"]-				@? "init failed"+			git_annex "init" [reponame, "--quiet"] "init" 			preinitremote 			git_annex "initremote" 				([ remotename 				, "type=" ++ remotetype 				, "--quiet" 				] ++ config)-				@? "init failed"+				"init" 			r <- annexeval $ either error return  				=<< Remote.byName' remotename 			cache <- Command.TestRemote.newRemoteVariantCache@@ -368,7 +367,7 @@ test_init :: Assertion test_init = innewrepo $ do 	ver <- annexVersion <$> getTestMode-	git_annex "init" [reponame, "--version", show (fromRepoVersion ver)] @? "init failed"+	git_annex "init" [reponame, "--version", show (fromRepoVersion ver)] "init" 	setupTestMode   where 	reponame = "test repo"@@ -378,62 +377,62 @@ test_add :: Assertion test_add = inmainrepo $ do 	writecontent annexedfile $ content annexedfile-	add_annex annexedfile @? "add failed"+	add_annex annexedfile "add" 	annexed_present annexedfile 	writecontent sha1annexedfile $ content sha1annexedfile-	git_annex "add" [sha1annexedfile, "--backend=SHA1"] @? "add with SHA1 failed"+	git_annex "add" [sha1annexedfile, "--backend=SHA1"] "add with SHA1" 	whenM (unlockedFiles <$> getTestMode) $-		git_annex "unlock" [sha1annexedfile] @? "unlock failed"+		git_annex "unlock" [sha1annexedfile] "unlock" 	annexed_present sha1annexedfile 	checkbackend sha1annexedfile backendSHA1 	writecontent ingitfile $ content ingitfile-	boolSystem "git" [Param "add", File ingitfile] @? "git add failed"-	boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "commit"] @? "git commit failed"-	git_annex "add" [ingitfile] @? "add ingitfile should be no-op"+	git "add" [ingitfile] "git add"+	git "commit" ["-q", "-m", "commit"] "git commit"+	git_annex "add" [ingitfile] "add ingitfile should be no-op" 	unannexed ingitfile  test_add_dup :: Assertion test_add_dup = intmpclonerepo $ do 	writecontent annexedfiledup $ content annexedfiledup-	add_annex annexedfiledup @? "add of second file with same content failed"+	add_annex annexedfiledup "add of second file with same content failed" 	annexed_present annexedfiledup 	annexed_present annexedfile  test_add_extras :: Assertion test_add_extras = intmpclonerepo $ do 	writecontent wormannexedfile $ content wormannexedfile-	git_annex "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed"+	git_annex "add" [wormannexedfile, "--backend=WORM"] "add with WORM" 	whenM (unlockedFiles <$> getTestMode) $-		git_annex "unlock" [wormannexedfile] @? "unlock failed"+		git_annex "unlock" [wormannexedfile] "unlock" 	annexed_present wormannexedfile 	checkbackend wormannexedfile backendWORM  test_ignore_deleted_files :: Assertion test_ignore_deleted_files = intmpclonerepo $ do-	git_annex "get" [annexedfile] @? "get failed"+	git_annex "get" [annexedfile] "get" 	git_annex_expectoutput "find" [] [annexedfile]-	removeWhenExistsWith removeLink annexedfile+	removeWhenExistsWith R.removeLink (toRawFilePath annexedfile) 	-- A file that has been deleted, but the deletion not staged, 	-- is a special case; make sure git-annex skips these. 	git_annex_expectoutput "find" [] []  test_metadata :: Assertion test_metadata = intmpclonerepo $ do-	git_annex "metadata" ["-s", "foo=bar", annexedfile] @? "set metadata"+	git_annex "metadata" ["-s", "foo=bar", annexedfile] "set metadata" 	git_annex_expectoutput "find" ["--metadata", "foo=bar"] [annexedfile] 	git_annex_expectoutput "find" ["--metadata", "foo=other"] [] 	writecontent annexedfiledup $ content annexedfiledup-	add_annex annexedfiledup @? "add of second file with same content failed"+	add_annex annexedfiledup "add of second file with same content failed" 	annexed_present annexedfiledup 	git_annex_expectoutput "find" ["--metadata", "foo=bar"] 		[annexedfile, annexedfiledup] 	git_annex_shouldfail "metadata" ["--remove", "foo", "."]-		@? "removing metadata from dir with multiple files failed to fail"+		"removing metadata from dir with multiple files not allowed" 	git_annex "metadata" ["--remove", "foo", annexedfile]-		@? "removing metadata failed"+		"removing metadata" 	git_annex_expectoutput "find" ["--metadata", "foo=bar"] [] 	git_annex "metadata" ["--force", "-s", "foo=bar", "."]-		@? "recursively set metadata force"+		"recursively set metadata force"  test_shared_clone :: Assertion test_shared_clone = intmpsharedclonerepo $ do@@ -448,30 +447,27 @@  test_log :: Assertion test_log = intmpclonerepo $ do-	git_annex "log" [annexedfile] @? "log failed"+	git_annex "log" [annexedfile] "log"  test_view :: Assertion test_view = intmpclonerepo $ do-	git_annex "metadata" ["-s", "test=test1", annexedfile]  @? "metadata failed"-	git_annex "metadata" ["-s", "test=test2", sha1annexedfile]  @? "metadata failed"-	git_annex "view" ["test=test1"] @? "entering view failed"+	git_annex "metadata" ["-s", "test=test1", annexedfile]  "metadata"+	git_annex "metadata" ["-s", "test=test2", sha1annexedfile] "metadata"+	git_annex "view" ["test=test1"] "entering view" 	checkexists annexedfile 	checkdoesnotexist sha1annexedfile  test_magic :: Assertion test_magic = intmpclonerepo $ do #ifdef WITH_MAGICMIME-	boolSystem "git"-		[ Param "config"-		, Param "annex.largefiles"-		, Param "mimeencoding=binary"-		] @? "git config annex.largefiles failed"+	git "config" ["annex.largefiles", "mimeencoding=binary"]+		"git config annex.largefiles" 	writeFile "binary" "\127" 	writeFile "text" "test\n"  	git_annex "add" ["binary", "text"]-		@? "git-annex add failed with mimeencoding in largefiles"+		"git-annex add with mimeencoding in largefiles" 	git_annex "sync" []-		@? "git-annex sync failed"+		"git-annex sync" 	(isJust <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "binary"))) 		@? "binary file not added to annex despite mimeencoding config" 	(isNothing <$> annexeval (Annex.CatFile.catKeyFile (encodeBS "text")))@@ -483,40 +479,40 @@ test_import :: Assertion test_import = intmpclonerepo $ Utility.Tmp.Dir.withTmpDir "importtest" $ \importdir -> do 	(toimport1, importf1, imported1) <- mktoimport importdir "import1"-	git_annex "import" [toimport1] @? "import failed"+	git_annex "import" [toimport1] "import" 	annexed_present_imported imported1 	checkdoesnotexist importf1  	(toimport2, importf2, imported2) <- mktoimport importdir "import2"-	git_annex "import" [toimport2] @? "import of duplicate failed"+	git_annex "import" [toimport2] "import of duplicate" 	annexed_present_imported imported2 	checkdoesnotexist importf2  	(toimport3, importf3, imported3) <- mktoimport importdir "import3" 	git_annex "import" ["--skip-duplicates", toimport3]-		@? "import of duplicate with --skip-duplicates failed"+		"import of duplicate with --skip-duplicates" 	checkdoesnotexist imported3 	checkexists importf3 	git_annex "import" ["--clean-duplicates", toimport3]-		@? "import of duplicate with --clean-duplicates failed"+		"import of duplicate with --clean-duplicates" 	checkdoesnotexist imported3 	checkdoesnotexist importf3 	 	(toimport4, importf4, imported4) <- mktoimport importdir "import4"-	git_annex "import" ["--deduplicate", toimport4] @? "import --deduplicate failed"+	git_annex "import" ["--deduplicate", toimport4] "import --deduplicate" 	checkdoesnotexist imported4 	checkdoesnotexist importf4 	 	(toimport5, importf5, imported5) <- mktoimport importdir "import5"-	git_annex "import" ["--duplicate", toimport5] @? "import --duplicate failed"+	git_annex "import" ["--duplicate", toimport5] "import --duplicate" 	annexed_present_imported imported5 	checkexists importf5 	-	git_annex "drop" ["--force", imported1, imported2, imported5] @? "drop failed"+	git_annex "drop" ["--force", imported1, imported2, imported5] "drop" 	annexed_notpresent_imported imported2 	(toimportdup, importfdup, importeddup) <- mktoimport importdir "importdup" 	git_annex_shouldfail "import" ["--clean-duplicates", toimportdup] -		@? "import of missing duplicate with --clean-duplicates failed to fail"+		"import of missing duplicate with --clean-duplicates not allowed" 	checkdoesnotexist importeddup 	checkexists importfdup   where@@ -528,16 +524,16 @@  test_reinject :: Assertion test_reinject = intmpclonerepo $ do-	git_annex "drop" ["--force", sha1annexedfile] @? "drop failed"+	git_annex "drop" ["--force", sha1annexedfile] "drop" 	annexed_notpresent sha1annexedfile 	writecontent tmp $ content sha1annexedfile 	key <- Key.serializeKey <$> getKey backendSHA1 tmp-	git_annex "reinject" [tmp, sha1annexedfile] @? "reinject failed"+	git_annex "reinject" [tmp, sha1annexedfile] "reinject" 	annexed_present sha1annexedfile 	-- fromkey can't be used on a crippled filesystem, since it makes a 	-- symlink 	unlessM (annexeval Config.crippledFileSystem) $ do-		git_annex "fromkey" [key, sha1annexedfiledup] @? "fromkey failed for dup"+		git_annex "fromkey" [key, sha1annexedfiledup] "fromkey for dup" 		annexed_present_locked sha1annexedfiledup   where 	tmp = "tmpfile"@@ -545,41 +541,40 @@ test_unannex_nocopy :: Assertion test_unannex_nocopy = intmpclonerepo $ do 	annexed_notpresent annexedfile-	git_annex "unannex" [annexedfile] @? "unannex failed with no copy"+	git_annex "unannex" [annexedfile] "unannex with no copy" 	annexed_notpresent annexedfile  test_unannex_withcopy :: Assertion test_unannex_withcopy = intmpclonerepo $ do-	git_annex "get" [annexedfile] @? "get failed"+	git_annex "get" [annexedfile] "get" 	annexed_present annexedfile-	git_annex "unannex" [annexedfile, sha1annexedfile] @? "unannex failed"+	git_annex "unannex" [annexedfile, sha1annexedfile] "unannex" 	unannexed annexedfile-	git_annex "unannex" [annexedfile] @? "unannex failed on non-annexed file"+	git_annex "unannex" [annexedfile] "unannex on non-annexed file" 	unannexed annexedfile-	git_annex "unannex" [ingitfile] @? "unannex ingitfile should be no-op"+	git_annex "unannex" [ingitfile] "unannex ingitfile should be no-op" 	unannexed ingitfile  test_drop_noremote :: Assertion test_drop_noremote = intmpclonerepo $ do-	git_annex "get" [annexedfile] @? "get failed"-	boolSystem "git" [Param "remote", Param "rm", Param "origin"]-		@? "git remote rm origin failed"-	git_annex_shouldfail "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of file"+	git_annex "get" [annexedfile] "get"+	git "remote" ["rm", "origin"] "git remote rm origin"+	git_annex_shouldfail "drop" [annexedfile] "drop with no known copy of file not allowed" 	annexed_present annexedfile-	git_annex "drop" ["--force", annexedfile] @? "drop --force failed"+	git_annex "drop" ["--force", annexedfile] "drop --force" 	annexed_notpresent annexedfile-	git_annex "drop" [annexedfile] @? "drop of dropped file failed"-	git_annex "drop" [ingitfile] @? "drop ingitfile should be no-op"+	git_annex "drop" [annexedfile] "drop of dropped file"+	git_annex "drop" [ingitfile] "drop ingitfile should be no-op" 	unannexed ingitfile  test_drop_withremote :: Assertion test_drop_withremote = intmpclonerepo $ do-	git_annex "get" [annexedfile] @? "get failed"+	git_annex "get" [annexedfile] "get" 	annexed_present annexedfile-	git_annex "numcopies" ["2"] @? "numcopies config failed"-	git_annex_shouldfail "drop" [annexedfile] @? "drop succeeded although numcopies is not satisfied"-	git_annex "numcopies" ["1"] @? "numcopies config failed"-	git_annex "drop" [annexedfile] @? "drop failed though origin has copy"+	git_annex "numcopies" ["2"] "numcopies config"+	git_annex_shouldfail "drop" [annexedfile] "drop with numcopies not satisfied is not allowed"+	git_annex "numcopies" ["1"] "numcopies config"+	git_annex "drop" [annexedfile] "drop when origin has copy" 	annexed_notpresent annexedfile 	-- make sure that the correct symlink is staged for the file 	-- after drop@@ -588,10 +583,10 @@  test_drop_untrustedremote :: Assertion test_drop_untrustedremote = intmpclonerepo $ do-	git_annex "untrust" ["origin"] @? "untrust of origin failed"-	git_annex "get" [annexedfile] @? "get failed"+	git_annex "untrust" ["origin"] "untrust of origin"+	git_annex "get" [annexedfile] "get" 	annexed_present annexedfile-	git_annex_shouldfail "drop" [annexedfile] @? "drop wrongly succeeded with only an untrusted copy of the file"+	git_annex_shouldfail "drop" [annexedfile] "drop with only an untrusted copy of the file should fail" 	annexed_present annexedfile 	inmainrepo $ annexed_present annexedfile @@ -610,15 +605,15 @@ test_get' setup = setup $ do 	inmainrepo $ annexed_present annexedfile 	annexed_notpresent annexedfile-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "get" [annexedfile] "get of file" 	inmainrepo $ annexed_present annexedfile 	annexed_present annexedfile-	git_annex "get" [annexedfile] @? "get of file already here failed"+	git_annex "get" [annexedfile] "get of file already here" 	inmainrepo $ annexed_present annexedfile 	annexed_present annexedfile 	inmainrepo $ unannexed ingitfile 	unannexed ingitfile-	git_annex "get" [ingitfile] @? "get ingitfile should be no-op"+	git_annex "get" [ingitfile] "get ingitfile should be no-op" 	inmainrepo $ unannexed ingitfile 	unannexed ingitfile @@ -637,63 +632,63 @@ test_move' setup = setup $ do 	annexed_notpresent annexedfile 	inmainrepo $ annexed_present annexedfile-	git_annex "move" ["--from", "origin", annexedfile] @? "move --from of file failed"+	git_annex "move" ["--from", "origin", annexedfile] "move --from of file" 	annexed_present annexedfile 	inmainrepo $ annexed_notpresent annexedfile-	git_annex "move" ["--from", "origin", annexedfile] @? "move --from of file already here failed"+	git_annex "move" ["--from", "origin", annexedfile] "move --from of file already here" 	annexed_present annexedfile 	inmainrepo $ annexed_notpresent annexedfile-	git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file failed"+	git_annex "move" ["--to", "origin", annexedfile] "move --to of file" 	inmainrepo $ annexed_present annexedfile 	annexed_notpresent annexedfile-	git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"+	git_annex "move" ["--to", "origin", annexedfile] "move --to of file already there" 	inmainrepo $ annexed_present annexedfile 	annexed_notpresent annexedfile 	unannexed ingitfile 	inmainrepo $ unannexed ingitfile-	git_annex "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op"+	git_annex "move" ["--to", "origin", ingitfile] "move of ingitfile should be no-op" 	unannexed ingitfile 	inmainrepo $ unannexed ingitfile-	git_annex "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op"+	git_annex "move" ["--from", "origin", ingitfile] "move of ingitfile should be no-op" 	unannexed ingitfile 	inmainrepo $ unannexed ingitfile  test_move_numcopies :: Assertion test_move_numcopies = intmpclonerepo $ do 	inmainrepo $ annexed_present annexedfile-	git_annex "numcopies" ["2"] @? "setting numcopies failed"-	git_annex "move" ["--from", "origin", annexedfile] @? "move of file --from remote with numcopies unsatisfied but not made worse failed unexpectedly"+	git_annex "numcopies" ["2"] "setting numcopies"+	git_annex "move" ["--from", "origin", annexedfile] "move of file --from remote with numcopies unsatisfied but not made worse" 	annexed_present annexedfile 	inmainrepo $ annexed_notpresent annexedfile-	git_annex "move" ["--to", "origin", annexedfile] @? "move of file --to remote with numcopies unsatisfied but not made worse failed unexpectedly"+	git_annex "move" ["--to", "origin", annexedfile] "move of file --to remote with numcopies unsatisfied but not made worse" 	annexed_notpresent annexedfile 	inmainrepo $ annexed_present annexedfile-	git_annex "get" [annexedfile] @? "get of file failed"-	git_annex_shouldfail "move" ["--from", "origin", annexedfile] @? "move of file --from remote violated numcopies setting"-	git_annex_shouldfail "move" ["--to", "origin", annexedfile] @? "move of file --to remote violated numcopies setting"+	git_annex "get" [annexedfile] "get of file"+	git_annex_shouldfail "move" ["--from", "origin", annexedfile] "move of file --from remote that violates numcopies setting not allowd"+	git_annex_shouldfail "move" ["--to", "origin", annexedfile] "move of file --to remote that violates numcopies setting not allowed"  test_copy :: Assertion test_copy = intmpclonerepo $ do 	annexed_notpresent annexedfile 	inmainrepo $ annexed_present annexedfile-	git_annex "copy" ["--from", "origin", annexedfile] @? "copy --from of file failed"+	git_annex "copy" ["--from", "origin", annexedfile] "copy --from of file" 	annexed_present annexedfile 	inmainrepo $ annexed_present annexedfile-	git_annex "copy" ["--from", "origin", annexedfile] @? "copy --from of file already here failed"+	git_annex "copy" ["--from", "origin", annexedfile] "copy --from of file already here" 	annexed_present annexedfile 	inmainrepo $ annexed_present annexedfile-	git_annex "copy" ["--to", "origin", annexedfile] @? "copy --to of file already there failed"+	git_annex "copy" ["--to", "origin", annexedfile] "copy --to of file already there" 	annexed_present annexedfile 	inmainrepo $ annexed_present annexedfile-	git_annex "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed"+	git_annex "move" ["--to", "origin", annexedfile] "move --to of file already there" 	annexed_notpresent annexedfile 	inmainrepo $ annexed_present annexedfile 	unannexed ingitfile 	inmainrepo $ unannexed ingitfile-	git_annex "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op"+	git_annex "copy" ["--to", "origin", ingitfile] "copy of ingitfile should be no-op" 	unannexed ingitfile 	inmainrepo $ unannexed ingitfile-	git_annex "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op"+	git_annex "copy" ["--from", "origin", ingitfile] "copy of ingitfile should be no-op" 	checkregularfile ingitfile 	checkcontent ingitfile @@ -702,40 +697,40 @@ 	annexed_notpresent annexedfile 	-- get/copy --auto looks only at numcopies when preferred content is not 	-- set, and with 1 copy existing, does not get the file.-	git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed with default preferred content"+	git_annex "get" ["--auto", annexedfile] "get --auto of file with default preferred content" 	annexed_notpresent annexedfile-	git_annex "copy" ["--from", "origin", "--auto", annexedfile] @? "copy --auto --from of file failed with default preferred content"+	git_annex "copy" ["--from", "origin", "--auto", annexedfile] "copy --auto --from of file with default preferred content" 	annexed_notpresent annexedfile -	git_annex "wanted" [".", "standard"] @? "set expression to standard failed"-	git_annex "group" [".", "client"] @? "set group to standard failed"-	git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed for client"+	git_annex "wanted" [".", "standard"] "set expression to standard"+	git_annex "group" [".", "client"] "set group to standard"+	git_annex "get" ["--auto", annexedfile] "get --auto of file for client" 	annexed_present annexedfile-	git_annex "drop" [annexedfile] @? "drop of file failed"-	git_annex "copy" ["--from", "origin", "--auto", annexedfile] @? "copy --auto --from of file failed for client"+	git_annex "drop" [annexedfile] "drop of file"+	git_annex "copy" ["--from", "origin", "--auto", annexedfile] "copy --auto --from of file for client" 	annexed_present annexedfile-	git_annex "ungroup" [".", "client"] @? "ungroup failed"+	git_annex "ungroup" [".", "client"] "ungroup" -	git_annex "wanted" [".", "standard"] @? "set expression to standard failed"-	git_annex "group" [".", "manual"] @? "set group to manual failed"+	git_annex "wanted" [".", "standard"] "set expression to standard"+	git_annex "group" [".", "manual"] "set group to manual" 	-- drop --auto with manual leaves the file where it is-	git_annex "drop" ["--auto", annexedfile] @? "drop --auto of file failed with manual preferred content"+	git_annex "drop" ["--auto", annexedfile] "drop --auto of file with manual preferred content" 	annexed_present annexedfile-	git_annex "drop" [annexedfile] @? "drop of file failed"+	git_annex "drop" [annexedfile] "drop of file" 	annexed_notpresent annexedfile 	-- copy/get --auto with manual does not get the file-	git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed with manual preferred content"+	git_annex "get" ["--auto", annexedfile] "get --auto of file with manual preferred content" 	annexed_notpresent annexedfile-	git_annex "copy" ["--from", "origin", "--auto", annexedfile] @? "copy --auto --from of file failed with manual preferred content"+	git_annex "copy" ["--from", "origin", "--auto", annexedfile] "copy --auto --from of file with manual preferred content" 	annexed_notpresent annexedfile-	git_annex "ungroup" [".", "client"] @? "ungroup failed"+	git_annex "ungroup" [".", "client"] "ungroup" 	-	git_annex "wanted" [".", "exclude=*"] @? "set expression to exclude=* failed"-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "wanted" [".", "exclude=*"] "set expression to exclude=*"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "drop" ["--auto", annexedfile] @? "drop --auto of file failed with exclude=*"+	git_annex "drop" ["--auto", annexedfile] "drop --auto of file with exclude=*" 	annexed_notpresent annexedfile-	git_annex "get" ["--auto", annexedfile] @? "get --auto of file failed with exclude=*"+	git_annex "get" ["--auto", annexedfile] "get --auto of file with exclude=*" 	annexed_notpresent annexedfile  test_lock :: Assertion@@ -745,41 +740,41 @@ 	-- regression test: unlock of newly added, not committed file 	-- should not fail. 	writecontent "newfile" "foo"-	git_annex "add" ["newfile"] @? "add new file failed"-	git_annex "unlock" ["newfile"] @? "unlock failed on newly added, never committed file"+	git_annex "add" ["newfile"] "add new file"+	git_annex "unlock" ["newfile"] "unlock on newly added, never committed file" -	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "unlock" [annexedfile] @? "unlock failed"		+	git_annex "unlock" [annexedfile] "unlock" 	unannexed annexedfile 	-- write different content, to verify that lock 	-- throws it away 	changecontent annexedfile 	writecontent annexedfile $ content annexedfile ++ "foo"-	git_annex_shouldfail "lock" [annexedfile] @? "lock failed to fail without --force"-	git_annex "lock" ["--force", annexedfile] @? "lock --force failed"+	git_annex_shouldfail "lock" [annexedfile] "lock without --force should not be allowed"+	git_annex "lock" ["--force", annexedfile] "lock --force" 	-- The original content of an unlocked file is not always 	-- preserved after modification, so re-get it.-	git_annex "get" [annexedfile] @? "get of file failed after lock --force"+	git_annex "get" [annexedfile] "get of file after lock --force" 	annexed_present_locked annexedfile-	git_annex "unlock" [annexedfile] @? "unlock failed"		+	git_annex "unlock" [annexedfile] "unlock" 	unannexed annexedfile 	changecontent annexedfile-	boolSystem "git" [Param "add", Param annexedfile] @? "add of modified file failed"+	git "add" [annexedfile] "add of modified file" 	runchecks [checkregularfile, checkwritable] annexedfile 	c <- readFile annexedfile 	assertEqual "content of modified file" c (changedcontent annexedfile)-	r' <- git_annex "drop" [annexedfile]-	not r' @? "drop wrongly succeeded with no known copy of modified file"+	git_annex_shouldfail "drop" [annexedfile]+		"drop with no known copy of modified file should not be allowed"  -- Regression test: lock --force when work tree file -- was modified lost the (unmodified) annex object. -- (Only occurred when the keys database was out of sync.) test_lock_force :: Assertion test_lock_force = intmpclonerepo $ do-	git_annex "upgrade" [] @? "upgrade failed"-	git_annex "get" [annexedfile] @? "get of file failed"-	git_annex "unlock" [annexedfile] @? "unlock failed"+	git_annex "upgrade" [] "upgrade"+	git_annex "get" [annexedfile] "get of file"+	git_annex "unlock" [annexedfile] "unlock" 	annexeval $ do 		Just k <- Annex.WorkTree.lookupKey (toRawFilePath annexedfile) 		Database.Keys.removeInodeCaches k@@ -787,8 +782,8 @@ 		liftIO . removeWhenExistsWith R.removeLink 			=<< Annex.fromRepo Annex.Locations.gitAnnexKeysDbIndexCache 	writecontent annexedfile "test_lock_force content"-	git_annex_shouldfail "lock" [annexedfile] @? "lock of modified file failed to fail"-	git_annex "lock" ["--force", annexedfile] @? "lock --force of modified file failed"+	git_annex_shouldfail "lock" [annexedfile] "lock of modified file should not be allowed"+	git_annex "lock" ["--force", annexedfile] "lock --force of modified file" 	annexed_present_locked annexedfile  test_edit :: Assertion@@ -799,45 +794,41 @@  test_edit' :: Bool -> Assertion test_edit' precommit = intmpclonerepo $ do-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "edit" [annexedfile] @? "edit failed"+	git_annex "edit" [annexedfile] "edit" 	unannexed annexedfile 	changecontent annexedfile-	boolSystem "git" [Param "add", File annexedfile]-		@? "git add of edited file failed"+	git "add" [annexedfile] "git add of edited file" 	if precommit-		then git_annex "pre-commit" []-			@? "pre-commit failed"-		else boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "contentchanged"]-			@? "git commit of edited file failed"+		then git_annex "pre-commit" [] "pre-commit"+		else git "commit" ["-q", "-m", "contentchanged"] "git commit of edited file" 	runchecks [checkregularfile, checkwritable] annexedfile 	c <- readFile annexedfile 	assertEqual "content of modified file" c (changedcontent annexedfile)-	git_annex_shouldfail "drop" [annexedfile] @? "drop wrongly succeeded with no known copy of modified file"+	git_annex_shouldfail "drop" [annexedfile] "drop no known copy of modified file should not be allowed"  test_partial_commit :: Assertion test_partial_commit = intmpclonerepo $ do-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "unlock" [annexedfile] @? "unlock failed"+	git_annex "unlock" [annexedfile] "unlock" 	changecontent annexedfile-	boolSystem "git" [Param "commit", Param "-q", Param "-m", Param "test", File annexedfile]-		@? "partial commit of unlocked file should be allowed"+	git "commit" ["-q", "-m", "test", annexedfile]+		"partial commit of unlocked file should be allowed"  test_fix :: Assertion test_fix = intmpclonerepo $ unlessM (hasUnlockedFiles <$> getTestMode) $ do 	annexed_notpresent annexedfile-	git_annex "fix" [annexedfile] @? "fix of not present failed"+	git_annex "fix" [annexedfile] "fix of not present" 	annexed_notpresent annexedfile-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "fix" [annexedfile] @? "fix of present file failed"+	git_annex "fix" [annexedfile] "fix of present file" 	annexed_present annexedfile 	createDirectory subdir-	boolSystem "git" [Param "mv", File annexedfile, File subdir]-		@? "git mv failed"-	git_annex "fix" [newfile] @? "fix of moved file failed"+	git "mv" [annexedfile, subdir] "git mv"+	git_annex "fix" [newfile] "fix of moved file" 	runchecks [checklink, checkunwritable] newfile 	c <- readFile newfile 	assertEqual "content of moved file" c (content annexedfile)@@ -847,21 +838,21 @@  test_trust :: Assertion test_trust = intmpclonerepo $ do-	git_annex "trust" [repo] @? "trust failed"+	git_annex "trust" [repo] "trust" 	trustcheck Logs.Trust.Trusted "trusted 1"-	git_annex "trust" [repo] @? "trust of trusted failed"+	git_annex "trust" [repo] "trust of trusted" 	trustcheck Logs.Trust.Trusted "trusted 2"-	git_annex "untrust" [repo] @? "untrust failed"+	git_annex "untrust" [repo] "untrust" 	trustcheck Logs.Trust.UnTrusted "untrusted 1"-	git_annex "untrust" [repo] @? "untrust of untrusted failed"+	git_annex "untrust" [repo] "untrust of untrusted" 	trustcheck Logs.Trust.UnTrusted "untrusted 2"-	git_annex "dead" [repo] @? "dead failed"+	git_annex "dead" [repo] "dead" 	trustcheck Logs.Trust.DeadTrusted "deadtrusted 1"-	git_annex "dead" [repo] @? "dead of dead failed"+	git_annex "dead" [repo] "dead of dead" 	trustcheck Logs.Trust.DeadTrusted "deadtrusted 2"-	git_annex "semitrust" [repo] @? "semitrust failed"+	git_annex "semitrust" [repo] "semitrust" 	trustcheck Logs.Trust.SemiTrusted "semitrusted 1"-	git_annex "semitrust" [repo] @? "semitrust of semitrusted failed"+	git_annex "semitrust" [repo] "semitrust of semitrusted" 	trustcheck Logs.Trust.SemiTrusted "semitrusted 2"   where 	repo = "origin"@@ -874,52 +865,52 @@  test_fsck_basic :: Assertion test_fsck_basic = intmpclonerepo $ do-	git_annex "fsck" [] @? "fsck failed"-	git_annex "numcopies" ["2"] @? "numcopies config failed"+	git_annex "fsck" [] "fsck"+	git_annex "numcopies" ["2"] "numcopies config" 	fsck_should_fail "numcopies unsatisfied"-	git_annex "numcopies" ["1"] @? "numcopies config failed"+	git_annex "numcopies" ["1"] "numcopies config" 	corrupt annexedfile 	corrupt sha1annexedfile   where 	corrupt f = do-		git_annex "get" [f] @? "get of file failed"+		git_annex "get" [f] "get of file" 		Utility.FileMode.allowWrite (toRawFilePath f) 		writecontent f (changedcontent f) 		ifM (hasUnlockedFiles <$> getTestMode)-			( git_annex "fsck" [] @? "fsck failed on unlocked file with changed file content"-			, git_annex_shouldfail "fsck" [] @? "fsck failed to fail with corrupted file content"+			( git_annex "fsck" []"fsck on unlocked file with changed file content"+			, git_annex_shouldfail "fsck" [] "fsck with corrupted file content should error" 			)-		git_annex "fsck" [] @? "fsck unexpectedly failed again; previous one did not fix problem with " ++ f+		git_annex "fsck" [] "second fsck, after first fsck should have fixed problem"  test_fsck_bare :: Assertion test_fsck_bare = intmpbareclonerepo $-	git_annex "fsck" [] @? "fsck failed"+	git_annex "fsck" [] "fsck"  test_fsck_localuntrusted :: Assertion test_fsck_localuntrusted = intmpclonerepo $ do-	git_annex "get" [annexedfile] @? "get failed"-	git_annex "untrust" ["origin"] @? "untrust of origin repo failed"-	git_annex "untrust" ["."] @? "untrust of current repo failed"+	git_annex "get" [annexedfile] "get"+	git_annex "untrust" ["origin"] "untrust of origin repo"+	git_annex "untrust" ["."] "untrust of current repo" 	fsck_should_fail "content only available in untrusted (current) repository"-	git_annex "trust" ["."] @? "trust of current repo failed"-	git_annex "fsck" [annexedfile] @? "fsck failed on file present in trusted repo"+	git_annex "trust" ["."] "trust of current repo"+	git_annex "fsck" [annexedfile] "fsck on file present in trusted repo"  test_fsck_remoteuntrusted :: Assertion test_fsck_remoteuntrusted = intmpclonerepo $ do-	git_annex "numcopies" ["2"] @? "numcopies config failed"-	git_annex "get" [annexedfile] @? "get failed"-	git_annex "get" [sha1annexedfile] @? "get failed"-	git_annex "fsck" [] @? "fsck failed with numcopies=2 and 2 copies"-	git_annex "untrust" ["origin"] @? "untrust of origin failed"+	git_annex "numcopies" ["2"] "numcopies config"+	git_annex "get" [annexedfile] "get"+	git_annex "get" [sha1annexedfile] "get"+	git_annex "fsck" [] "fsck with numcopies=2 and 2 copies"+	git_annex "untrust" ["origin"] "untrust of origin" 	fsck_should_fail "content not replicated to enough non-untrusted repositories"  test_fsck_fromremote :: Assertion test_fsck_fromremote = intmpclonerepo $ do-	git_annex "fsck" ["--from", "origin"] @? "fsck --from origin failed"+	git_annex "fsck" ["--from", "origin"] "fsck --from origin"  fsck_should_fail :: String -> Assertion fsck_should_fail m = git_annex_shouldfail "fsck" []-	@? "fsck failed to fail with " ++ m+	("fsck should not succeed with " ++ m)  test_migrate :: Assertion test_migrate = test_migrate' False@@ -931,24 +922,24 @@ test_migrate' usegitattributes = intmpclonerepo $ do 	annexed_notpresent annexedfile 	annexed_notpresent sha1annexedfile-	git_annex "migrate" [annexedfile] @? "migrate of not present failed"-	git_annex "migrate" [sha1annexedfile] @? "migrate of not present failed"-	git_annex "get" [annexedfile] @? "get of file failed"-	git_annex "get" [sha1annexedfile] @? "get of file failed"+	git_annex "migrate" [annexedfile] "migrate of not present"+	git_annex "migrate" [sha1annexedfile] "migrate of not present"+	git_annex "get" [annexedfile] "get of file"+	git_annex "get" [sha1annexedfile] "get of file" 	annexed_present annexedfile 	annexed_present sha1annexedfile 	if usegitattributes 		then do 			writeFile ".gitattributes" "* annex.backend=SHA1" 			git_annex "migrate" [sha1annexedfile]-				@? "migrate sha1annexedfile failed"+				"migrate sha1annexedfile" 			git_annex "migrate" [annexedfile]-				@? "migrate annexedfile failed"+				"migrate annexedfile" 		else do 			git_annex "migrate" [sha1annexedfile, "--backend", "SHA1"]-				@? "migrate sha1annexedfile failed"+				"migrate sha1annexedfile" 			git_annex "migrate" [annexedfile, "--backend", "SHA1"]-				@? "migrate annexedfile failed"+				"migrate annexedfile" 	annexed_present annexedfile 	annexed_present sha1annexedfile 	checkbackend annexedfile backendSHA1@@ -956,10 +947,8 @@  	-- check that reversing a migration works 	writeFile ".gitattributes" "* annex.backend=SHA256"-	git_annex "migrate" [sha1annexedfile]-		@? "migrate sha1annexedfile failed"-	git_annex "migrate" [annexedfile]-		@? "migrate annexedfile failed"+	git_annex "migrate" [sha1annexedfile] "migrate sha1annexedfile"+	git_annex "migrate" [annexedfile] "migrate annexedfile" 	annexed_present annexedfile 	annexed_present sha1annexedfile 	checkbackend annexedfile backendSHA256@@ -968,33 +957,32 @@ test_unused :: Assertion test_unused = intmpclonerepo $ do 	checkunused [] "in new clone"-	git_annex "get" [annexedfile] @? "get of file failed"-	git_annex "get" [sha1annexedfile] @? "get of file failed"+	git_annex "get" [annexedfile] "get of file"+	git_annex "get" [sha1annexedfile] "get of file" 	annexedfilekey <- getKey backendSHA256E annexedfile 	sha1annexedfilekey <- getKey backendSHA1 sha1annexedfile 	checkunused [] "after get"-	boolSystem "git" [Param "rm", Param "-fq", File annexedfile] @? "git rm failed"+	git "rm" ["-fq", annexedfile] "git rm" 	checkunused [] "after rm" 	-- commit the rm, and when on an adjusted branch, sync it back to 	-- the master branch-	git_annex "sync" ["--no-push", "--no-pull"] @? "git-annex sync failed"+	git_annex "sync" ["--no-push", "--no-pull"] "git-annex sync" 	checkunused [] "after commit" 	-- unused checks origin/master; once it's gone it is really unused-	boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "git remote rm origin failed"+	git "remote" ["rm", "origin"] "git remote rm origin" 	checkunused [annexedfilekey] "after origin branches are gone"-	boolSystem "git" [Param "rm", Param "-fq", File sha1annexedfile] @? "git rm failed"-	git_annex "sync" ["--no-push", "--no-pull"] @? "git-annex sync failed"+	git "rm" ["-fq", sha1annexedfile] "git rm"+	git_annex "sync" ["--no-push", "--no-pull"] "git-annex sync" 	checkunused [annexedfilekey, sha1annexedfilekey] "after rm sha1annexedfile"  	-- good opportunity to test dropkey also-	git_annex "dropkey" ["--force", Key.serializeKey annexedfilekey]-		@? "dropkey failed"+	git_annex "dropkey" ["--force", Key.serializeKey annexedfilekey] "dropkey" 	checkunused [sha1annexedfilekey] ("after dropkey --force " ++ Key.serializeKey annexedfilekey) -	git_annex_shouldfail "dropunused" ["1"] @? "dropunused failed to fail without --force"-	git_annex "dropunused" ["--force", "1"] @? "dropunused failed"+	git_annex_shouldfail "dropunused" ["1"] "dropunused should not be allowed without --force"+	git_annex "dropunused" ["--force", "1"] "dropunused" 	checkunused [] "after dropunused"-	git_annex_shouldfail "dropunused" ["--force", "10", "501"] @? "dropunused failed to fail on bogus numbers"+	git_annex_shouldfail "dropunused" ["--force", "10", "501"] "dropunused on bogus numbers"  	-- Unused used to miss renamed symlinks that were not staged 	-- and pointed at annexed content, and think that content was unused.@@ -1003,10 +991,10 @@ 	-- to associate it with the key. 	unlessM (hasUnlockedFiles <$> getTestMode) $ do 		writecontent "unusedfile" "unusedcontent"-		git_annex "add" ["unusedfile"] @? "add of unusedfile failed"+		git_annex "add" ["unusedfile"] "add of unusedfile" 		unusedfilekey <- getKey backendSHA256E "unusedfile" 		renameFile "unusedfile" "unusedunstagedfile"-		boolSystem "git" [Param "rm", Param "-qf", File "unusedfile"] @? "git rm failed"+		git "rm" ["-qf", "unusedfile"] "git rm" 		checkunused [] "with unstaged link" 		removeFile "unusedunstagedfile" 		checkunused [unusedfilekey] "with renamed link deleted"@@ -1014,18 +1002,18 @@ 	-- unused used to miss symlinks that were deleted or modified 	-- manually 	writecontent "unusedfile" "unusedcontent"-	git_annex "add" ["unusedfile"] @? "add of unusedfile failed"-	boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed"+	git_annex "add" ["unusedfile"] "add of unusedfile"+	git "add" ["unusedfile"] "git add" 	unusedfilekey' <- getKey backendSHA256E "unusedfile" 	checkunused [] "with staged deleted link"-	boolSystem "git" [Param "rm", Param "-qf", File "unusedfile"] @? "git rm failed"+	git "rm" ["-qf", "unusedfile"] "git rm" 	checkunused [unusedfilekey'] "with staged link deleted"  	-- unused used to false positive on symlinks that were 	-- deleted or modified manually, but not staged as such 	writecontent "unusedfile" "unusedcontent"-	git_annex "add" ["unusedfile"] @? "add of unusedfile failed"-	boolSystem "git" [Param "add", File "unusedfile"] @? "git add failed"+	git_annex "add" ["unusedfile"] "add of unusedfile"+	git "add" ["unusedfile"] "git add" 	checkunused [] "with staged file" 	removeFile "unusedfile" 	checkunused [] "with staged deleted file"@@ -1036,17 +1024,17 @@ 	whenM (hasUnlockedFiles <$> getTestMode) $ do 		let f = "unlockedfile" 		writecontent f "unlockedcontent1"-		boolSystem "git" [Param "add", File "unlockedfile"] @? "git add failed"+		git "add" ["unlockedfile"] "git add" 		checkunused [] "with unlocked file before modification" 		writecontent f "unlockedcontent2" 		checkunused [] "with unlocked file after modification"-		not <$> boolSystem "git" [Param "diff", Param "--quiet", File f] @? "git diff did not show changes to unlocked file"+		git_shouldfail "diff" ["--quiet", f] "git diff should exit nonzero when unlocked file is modified" 		-- still nothing unused because one version is in the index 		-- and the other is in the work tree 		checkunused [] "with unlocked file after git diff"   where 	checkunused expectedkeys desc = do-		git_annex "unused" [] @? "unused failed"+		git_annex "unused" [] "unused" 		unusedmap <- annexeval $ Logs.Unused.readUnusedMap mempty 		let unusedkeys = M.elems unusedmap 		assertEqual ("unused keys differ " ++ desc)@@ -1054,14 +1042,14 @@  test_describe :: Assertion test_describe = intmpclonerepo $ do-	git_annex "describe" [".", "this repo"] @? "describe 1 failed"-	git_annex "describe" ["origin", "origin repo"] @? "describe 2 failed"+	git_annex "describe" [".", "this repo"] "describe 1"+	git_annex "describe" ["origin", "origin repo"] "describe 2"  test_find :: Assertion test_find = intmpclonerepo $ do 	annexed_notpresent annexedfile 	git_annex_expectoutput "find" [] []-	git_annex "get" [annexedfile] @? "get failed"+	git_annex "get" [annexedfile] "get" 	annexed_present annexedfile 	annexed_notpresent sha1annexedfile 	git_annex_expectoutput "find" [] [annexedfile]@@ -1076,13 +1064,13 @@ 	 - and --exclude=* should exclude them. -} 	createDirectory "dir" 	writecontent "dir/subfile" "subfile"-	git_annex "add" ["dir"] @? "add of subdir failed"+	git_annex "add" ["dir"] "add of subdir" 	git_annex_expectoutput "find" ["--include", "*", "--exclude", annexedfile, "--exclude", sha1annexedfile] ["dir/subfile"] 	git_annex_expectoutput "find" ["--exclude", "*"] []  test_merge :: Assertion test_merge = intmpclonerepo $-	git_annex "merge" [] @? "merge failed"+	git_annex "merge" [] "merge"  test_info :: Assertion test_info = intmpclonerepo $ do@@ -1093,22 +1081,22 @@  test_version :: Assertion test_version = intmpclonerepo $-	git_annex "version" [] @? "version failed"+	git_annex "version" [] "version"  test_sync :: Assertion test_sync = intmpclonerepo $ do-	git_annex "sync" [] @? "sync failed"+	git_annex "sync" [] "sync" 	{- Regression test for bug fixed in 	 - 039e83ed5d1a11fd562cce55b8429c840d72443e, where a present 	 - wanted file was dropped. -}-	git_annex "get" [annexedfile] @? "get failed"+	git_annex "get" [annexedfile] "get" 	git_annex_expectoutput "find" ["--in", "."] [annexedfile]-	git_annex "wanted" [".", "present"] @? "wanted failed"-	git_annex "sync" ["--content"] @? "sync failed"+	git_annex "wanted" [".", "present"] "wanted"+	git_annex "sync" ["--content"] "sync" 	git_annex_expectoutput "find" ["--in", "."] [annexedfile]-	git_annex "drop" [annexedfile] @? "drop failed"+	git_annex "drop" [annexedfile] "drop" 	git_annex_expectoutput "find" ["--in", "."] []-	git_annex "sync" ["--content"] @? "sync failed"+	git_annex "sync" ["--content"] "sync" 	git_annex_expectoutput "find" ["--in", "."] []  {- Regression test for the concurrency bug fixed in@@ -1118,23 +1106,22 @@ 	makedup dupfile 	-- This was sufficient currency to trigger the bug. 	git_annex "get" ["-J1", annexedfile, dupfile]-		@? "concurrent get -J1 with dup failed"+		"concurrent get -J1 with dup" 	git_annex "drop" ["-J1"]-		@? "drop with dup failed"+		"drop with dup" 	-- With -J2, one more dup file was needed to trigger the bug. 	makedup dupfile2 	git_annex "get" ["-J2", annexedfile, dupfile, dupfile2]-		@? "concurrent get -J2 with dup failed"+		"concurrent get -J2 with dup" 	git_annex "drop" ["-J2"]-		@? "drop with dup failed"+		"drop with dup"   where 	dupfile = annexedfile ++ "2" 	dupfile2 = annexedfile ++ "3" 	makedup f = do 		Utility.CopyFile.copyFileExternal Utility.CopyFile.CopyAllMetaData annexedfile f 			@? "copying annexed file failed"-		boolSystem "git" [Param "add", File f]-			@? "git add failed"	+		git "add" [f] "git add"  {- Regression test for union merge bug fixed in  - 0214e0fb175a608a49b812d81b4632c081f63027 -}@@ -1146,19 +1133,19 @@ 			withtmpclonerepo $ \r3 -> do 				forM_ [r1, r2, r3] $ \r -> indir r $ do 					when (r /= r1) $-						boolSystem "git" [Param "remote", Param "add", Param "r1", File ("../../" ++ r1)] @? "remote add"+						git "remote" ["add", "r1", "../../" ++ r1] "remote add" 					when (r /= r2) $-						boolSystem "git" [Param "remote", Param "add", Param "r2", File ("../../" ++ r2)] @? "remote add"+						git "remote" ["add", "r2", "../../" ++ r2] "remote add" 					when (r /= r3) $-						boolSystem "git" [Param "remote", Param "add", Param "r3", File ("../../" ++ r3)] @? "remote add"-					git_annex "get" [annexedfile] @? "get failed"-					boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "remote rm"+						git "remote" ["add", "r3", "../../" ++ r3] "remote add"+					git_annex "get" [annexedfile] "get"+					git "remote" ["rm", "origin"] "remote rm" 				forM_ [r3, r2, r1] $ \r -> indir r $-					git_annex "sync" [] @? ("sync failed in " ++ r)+					git_annex "sync" [] ("sync in " ++ r) 				forM_ [r3, r2] $ \r -> indir r $-					git_annex "drop" ["--force", annexedfile] @? ("drop failed in " ++ r)+					git_annex "drop" ["--force", annexedfile] ("drop in " ++ r) 				indir r1 $ do-					git_annex "sync" [] @? "sync failed in r1"+					git_annex "sync" [] "sync in r1" 					git_annex_expectoutput "find" ["--in", "r3"] [] 					{- This was the bug. The sync 					 - mangled location log data and it@@ -1173,18 +1160,18 @@ 		let rname r = if r == r1 then "r1" else "r2" 		forM_ [r1, r2] $ \r -> indir r $ do 			{- Get all files, see check below. -}-			git_annex "get" [] @? "get failed"+			git_annex "get" [] "get" 			disconnectOrigin 		pair r1 r2 		forM_ [r1, r2] $ \r -> indir r $ do 			{- Set up a conflict. -} 			let newcontent = content annexedfile ++ rname r-			git_annex "unlock" [annexedfile] @? "unlock failed"		+			git_annex "unlock" [annexedfile] "unlock" 			writecontent annexedfile newcontent 		{- Sync twice in r1 so it gets the conflict resolution 		 - update from r2 -} 		forM_ [r1, r2, r1] $ \r -> indir r $-			git_annex "sync" ["--force"] @? "sync failed in " ++ rname r+			git_annex "sync" ["--force"] ("sync in " ++ rname r) 		{- After the sync, it should be possible to get all 		 - files. This includes both sides of the conflict, 		 - although the filenames are not easily predictable.@@ -1192,7 +1179,7 @@ 		 - The bug caused one repo to be missing the content 		 - of the file that had been put in it. -} 		forM_ [r1, r2] $ \r -> indir r $ do-			git_annex "get" [] @? "unable to get all files after merge conflict resolution in " ++ rname r+			git_annex "get" [] ("get all files after merge conflict resolution in " ++ rname r)  {- Simple case of conflict resolution; 2 different versions of annexed  - file. -}@@ -1203,16 +1190,16 @@ 			indir r1 $ do 				disconnectOrigin 				writecontent conflictor "conflictor1"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r1"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r1" 			indir r2 $ do 				disconnectOrigin 				writecontent conflictor "conflictor2"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r2"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r2" 			pair r1 r2 			forM_ [r1,r2,r1] $ \r -> indir r $-				git_annex "sync" [] @? "sync failed"+				git_annex "sync" [] "sync" 			checkmerge "r1" r1 			checkmerge "r2" r2   where@@ -1225,7 +1212,7 @@ 			@? (what ++ " not exactly 2 variant files in: " ++ show l) 		conflictor `notElem` l @? ("conflictor still present after conflict resolution") 		indir d $ do-			git_annex "get" v @? "get failed"+			git_annex "get" v "get" 			git_annex_expectoutput "find" v v  {- Conflict resolution while in an adjusted branch. -}@@ -1236,20 +1223,20 @@ 			indir r1 $ do 				disconnectOrigin 				writecontent conflictor "conflictor1"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r1"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r1" 			indir r2 $ do 				disconnectOrigin 				writecontent conflictor "conflictor2"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r2"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r2" 				-- We might be in an adjusted branch 				-- already, when eg on a crippled 				-- filesystem. So, --force it.-				git_annex "adjust" ["--unlock", "--force"] @? "adjust failed"+				git_annex "adjust" ["--unlock", "--force"] "adjust" 			pair r1 r2 			forM_ [r1,r2,r1] $ \r -> indir r $-				git_annex "sync" [] @? "sync failed"+				git_annex "sync" [] "sync" 			checkmerge "r1" r1 			checkmerge "r2" r2   where@@ -1262,7 +1249,7 @@ 			@? (what ++ " not exactly 2 variant files in: " ++ show l) 		conflictor `notElem` l @? ("conflictor still present after conflict resolution") 		indir d $ do-			git_annex "get" v @? "get failed"+			git_annex "get" v "get" 			git_annex_expectoutput "find" v v  {- Check merge conflict resolution when one side is an annexed@@ -1277,25 +1264,26 @@ 			indir r1 $ do 				disconnectOrigin 				writecontent conflictor "conflictor"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r1"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r1" 			indir r2 $ do 				disconnectOrigin 				createDirectory conflictor 				writecontent subfile "subfile"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r2"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r2" 			pair r1 r2 			let l = if inr1 then [r1, r2] else [r2, r1] 			forM_ l $ \r -> indir r $-				git_annex "sync" [] @? "sync failed in mixed conflict"+				git_annex "sync" [] "sync in mixed conflict" 			checkmerge "r1" r1 			checkmerge "r2" r2 	conflictor = "conflictor" 	subfile = conflictor </> "subfile" 	variantprefix = conflictor ++ ".variant" 	checkmerge what d = do-		doesDirectoryExist (d </> conflictor) @? (d ++ " conflictor directory missing")+		doesDirectoryExist (d </> conflictor) +			@? (d ++ " conflictor directory missing") 		l <- getDirectoryContents d 		let v = filter (variantprefix `isPrefixOf`) l 		not (null v)@@ -1303,7 +1291,7 @@ 		length v == 1 			@? (what ++ " too many variant files in: " ++ show v) 		indir d $ do-			git_annex "get" (conflictor:v) @? ("get failed in " ++ what)+			git_annex "get" (conflictor:v) ("get  in " ++ what) 			git_annex_expectoutput "find" [conflictor] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath subfile))] 			git_annex_expectoutput "find" v v @@ -1319,23 +1307,21 @@ 			indir r1 $ do 				disconnectOrigin 				writecontent conflictor "conflictor"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r1"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r1" 			indir r2 $ 				disconnectOrigin 			pair r1 r2 			indir r2 $ do-				git_annex "sync" [] @? "sync failed in r2"-				git_annex "get" [conflictor]-					@? "get conflictor failed"-				git_annex "unlock" [conflictor]-					@? "unlock conflictor failed"+				git_annex "sync" [] "sync in r2"+				git_annex "get" [conflictor] "get conflictor"+				git_annex "unlock" [conflictor] "unlock conflictor" 				writecontent conflictor "newconflictor" 			indir r1 $-				removeWhenExistsWith removeLink conflictor+				removeWhenExistsWith R.removeLink (toRawFilePath conflictor) 			let l = if inr1 then [r1, r2, r1] else [r2, r1, r2] 			forM_ l $ \r -> indir r $-				git_annex "sync" [] @? "sync failed"+				git_annex "sync" [] "sync" 			checkmerge "r1" r1 			checkmerge "r2" r2 	conflictor = "conflictor"@@ -1361,22 +1347,21 @@ 			indir r1 $ do 				disconnectOrigin 				writecontent conflictor "conflictor"-				add_annex conflictor @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r1"+				add_annex conflictor "add conflicter"+				git_annex "sync" [] "sync in r1" 			indir r2 $ do 				disconnectOrigin 				writecontent conflictor nonannexed_content-				boolSystem "git"-					[ Param "config"-					, Param "annex.largefiles"-					, Param ("exclude=" ++ ingitfile ++ " and exclude=" ++ conflictor)-					] @? "git config annex.largefiles failed"-				boolSystem "git" [Param "add", File conflictor] @? "git add conflictor failed"-				git_annex "sync" [] @? "sync failed in r2"+				git "config"+					[ "annex.largefiles"+					, "exclude=" ++ ingitfile ++ " and exclude=" ++ conflictor+					] "git config annex.largefiles"+				git "add" [conflictor] "git add conflictor"+				git_annex "sync" [] "sync in r2" 			pair r1 r2 			let l = if inr1 then [r1, r2] else [r2, r1] 			forM_ l $ \r -> indir r $-				git_annex "sync" [] @? "sync failed"+				git_annex "sync" [] "sync" 			checkmerge "r1" r1 			checkmerge "r2" r2 	conflictor = "conflictor"@@ -1412,17 +1397,17 @@ 				indir r1 $ do 					disconnectOrigin 					writecontent conflictor "conflictor"-					add_annex conflictor @? "add conflicter failed"-					git_annex "sync" [] @? "sync failed in r1"+					add_annex conflictor "add conflicter"+					git_annex "sync" [] "sync in r1" 				indir r2 $ do 					disconnectOrigin 					createSymbolicLink symlinktarget "conflictor"-					boolSystem "git" [Param "add", File conflictor] @? "git add conflictor failed"-					git_annex "sync" [] @? "sync failed in r2"+					git "add" [conflictor] "git add conflictor"+					git_annex "sync" [] "sync in r2" 				pair r1 r2 				let l = if inr1 then [r1, r2] else [r2, r1] 				forM_ l $ \r -> indir r $-					git_annex "sync" [] @? "sync failed"+					git_annex "sync" [] "sync" 				checkmerge "r1" r1 				checkmerge "r2" r2 	conflictor = "conflictor"@@ -1460,16 +1445,15 @@ 				disconnectOrigin 				createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath remoteconflictor))) 				writecontent remoteconflictor annexedcontent-				add_annex conflictor @? "add remoteconflicter failed"-				git_annex "sync" [] @? "sync failed in r1"+				add_annex conflictor "add remoteconflicter"+				git_annex "sync" [] "sync in r1" 			indir r2 $ do 				disconnectOrigin 				writecontent conflictor localcontent 			pair r1 r2 			-- this case is intentionally not handled 			-- since the user can recover on their own easily-			indir r2 $ git_annex_shouldfail "sync" []-				@? "sync failed to fail"+			indir r2 $ git_annex_shouldfail "sync" [] "sync should not succeed" 	conflictor = "conflictor" 	localcontent = "local" 	annexedcontent = "annexed"@@ -1484,19 +1468,19 @@ 			withtmpclonerepo $ \r3 -> do 				indir r1 $ do 					writecontent conflictor "conflictor"-					git_annex "add" [conflictor] @? "add conflicter failed"-					git_annex "sync" [] @? "sync failed in r1"+					git_annex "add" [conflictor] "add conflicter"+					git_annex "sync" [] "sync in r1" 					check_is_link conflictor "r1" 				indir r2 $ do 					createDirectory conflictor 					writecontent (conflictor </> "subfile") "subfile"-					git_annex "add" [conflictor] @? "add conflicter failed"-					git_annex "sync" [] @? "sync failed in r2"+					git_annex "add" [conflictor] "add conflicter"+					git_annex "sync" [] "sync in r2" 					check_is_link (conflictor </> "subfile") "r2" 				indir r3 $ do 					writecontent conflictor "conflictor"-					git_annex "add" [conflictor] @? "add conflicter failed"-					git_annex "sync" [] @? "sync failed in r1"+					git_annex "add" [conflictor] "add conflicter"+					git_annex "sync" [] "sync in r1" 					check_is_link (conflictor </> "subfile") "r3"   where 	conflictor = "conflictor"@@ -1516,17 +1500,17 @@ 			indir r1 $ do 				disconnectOrigin 				writecontent conflictor "conflictor"-				git_annex "add" [conflictor] @? "add conflicter failed"-				git_annex "sync" [] @? "sync failed in r1"+				git_annex "add" [conflictor] "add conflicter"+				git_annex "sync" [] "sync in r1" 			indir r2 $ do 				disconnectOrigin 				writecontent conflictor "conflictor"-				git_annex "add" [conflictor] @? "add conflicter failed"-				git_annex "unlock" [conflictor] @? "unlock conflicter failed"-				git_annex "sync" [] @? "sync failed in r2"+				git_annex "add" [conflictor] "add conflicter"+				git_annex "unlock" [conflictor] "unlock conflicter"+				git_annex "sync" [] "sync in r2" 			pair r1 r2 			forM_ [r1,r2,r1] $ \r -> indir r $-				git_annex "sync" [] @? "sync failed"+				git_annex "sync" [] "sync" 			checkmerge "r1" r1 			checkmerge "r2" r2   where@@ -1538,7 +1522,7 @@ 		length v == 0 			@? (what ++ " not exactly 0 variant files in: " ++ show l) 		conflictor `elem` l @? ("conflictor not present after conflict resolution")-		git_annex "get" [conflictor] @? "get failed"+		git_annex "get" [conflictor] "get" 		git_annex_expectoutput "find" [conflictor] [conflictor] 		-- regular file because it's unlocked 		checkregularfile conflictor@@ -1559,13 +1543,13 @@ 	conflictor = "conflictor" 	setup r = indir r $ whensupported $ do 		disconnectOrigin-		git_annex "upgrade" [] @? "upgrade failed"-		git_annex "adjust" ["--unlock", "--force"] @? "adjust failed"+		git_annex "upgrade" [] "upgrade"+		git_annex "adjust" ["--unlock", "--force"] "adjust" 		writecontent conflictor "conflictor"-		git_annex "add" [conflictor] @? "add conflicter failed"-		git_annex "sync" [] @? "sync failed"+		git_annex "add" [conflictor] "add conflicter"+		git_annex "sync" [] "sync" 	checkmerge what d = indir d $ whensupported $ do-		git_annex "sync" [] @? ("sync failed in " ++ what)+		git_annex "sync" [] ("sync should not work in " ++ what) 		l <- getDirectoryContents "." 		conflictor `elem` l 			@? ("conflictor not present after merge in " ++ what)@@ -1581,66 +1565,67 @@ 		indir r $ do 			disconnectOrigin 			origbranch <- annexeval origBranch-			git_annex "upgrade" [] @? "upgrade failed"-			git_annex "adjust" ["--unlock", "--force"] @? "adjust failed"+			git_annex "upgrade" [] "upgrade"+			git_annex "adjust" ["--unlock", "--force"] "adjust" 			createDirectoryIfMissing True "a/b/c" 			writecontent "a/b/c/d" "foo"-			git_annex "add" ["a/b/c"] @? "add a/b/c failed"-			git_annex "sync" [] @? "sync failed"+			git_annex "add" ["a/b/c"] "add a/b/c"+			git_annex "sync" [] "sync" 			createDirectoryIfMissing True "a/b/x" 			writecontent "a/b/x/y" "foo"-			git_annex "add" ["a/b/x"] @? "add a/b/x failed"-			git_annex "sync" [] @? "sync failed"-			boolSystem "git" [Param "checkout", Param origbranch] @? "git checkout failed"+			git_annex "add" ["a/b/x"] "add a/b/x"+			git_annex "sync" [] "sync"+			git "checkout" [origbranch] "git checkout" 			doesFileExist "a/b/x/y" @? ("a/b/x/y missing from master after adjusted branch sync")  {- Set up repos as remotes of each other. -} pair :: FilePath -> FilePath -> Assertion pair r1 r2 = forM_ [r1, r2] $ \r -> indir r $ do 	when (r /= r1) $-		boolSystem "git" [Param "remote", Param "add", Param "r1", File ("../../" ++ r1)] @? "remote add"+		git "remote" ["add", "r1", "../../" ++ r1] "remote add" 	when (r /= r2) $-		boolSystem "git" [Param "remote", Param "add", Param "r2", File ("../../" ++ r2)] @? "remote add"+		git "remote" ["add", "r2", "../../" ++ r2] "remote add"  test_map :: Assertion test_map = intmpclonerepo $ do 	-- set descriptions, that will be looked for in the map-	git_annex "describe" [".", "this repo"] @? "describe 1 failed"-	git_annex "describe" ["origin", "origin repo"] @? "describe 2 failed"+	git_annex "describe" [".", "this repo"] "describe 1"+	git_annex "describe" ["origin", "origin repo"] "describe 2" 	-- --fast avoids it running graphviz, not a build dependency-	git_annex "map" ["--fast"] @? "map failed"+	git_annex "map" ["--fast"] "map"  test_uninit :: Assertion test_uninit = intmpclonerepo $ do-	git_annex "get" [] @? "get failed"+	git_annex "get" [] "get" 	annexed_present annexedfile-	_ <- git_annex "uninit" [] -- exit status not checked; does abnormal exit+	-- any exit status is accepted; does abnormal exit+	git_annex' (const True) "uninit" [] "uninit" 	checkregularfile annexedfile 	doesDirectoryExist ".git" @? ".git vanished in uninit"  test_uninit_inbranch :: Assertion test_uninit_inbranch = intmpclonerepo $ do-	boolSystem "git" [Param "checkout", Param "git-annex"] @? "git checkout git-annex"-	git_annex_shouldfail "uninit" [] @? "uninit failed to fail when git-annex branch was checked out"+	git "checkout" ["git-annex"] "git checkout git-annex"+	git_annex_shouldfail "uninit" [] "uninit should not succeed when git-annex branch is checked out"  test_upgrade :: Assertion test_upgrade = intmpclonerepo $-	git_annex "upgrade" [] @? "upgrade failed"+	git_annex "upgrade" [] "upgrade"  test_whereis :: Assertion test_whereis = intmpclonerepo $ do 	annexed_notpresent annexedfile-	git_annex "whereis" [annexedfile] @? "whereis on non-present file failed"-	git_annex "untrust" ["origin"] @? "untrust failed"-	git_annex_shouldfail "whereis" [annexedfile] @? "whereis on non-present file only present in untrusted repo failed to fail"-	git_annex "get" [annexedfile] @? "get failed"+	git_annex "whereis" [annexedfile] "whereis on non-present file"+	git_annex "untrust" ["origin"] "untrust"+	git_annex_shouldfail "whereis" [annexedfile] "whereis should exit nonzero on non-present file only present in untrusted repo"+	git_annex "get" [annexedfile] "get" 	annexed_present annexedfile-	git_annex "whereis" [annexedfile] @? "whereis on present file failed"+	git_annex "whereis" [annexedfile] "whereis on present file"  test_hook_remote :: Assertion test_hook_remote = intmpclonerepo $ do #ifndef mingw32_HOST_OS-	git_annex "initremote" (words "foo type=hook encryption=none hooktype=foo") @? "initremote failed"+	git_annex "initremote" (words "foo type=hook encryption=none hooktype=foo") "initremote" 	createDirectory dir 	git_config "annex.foo-store-hook" $ 		"cp $ANNEX_FILE " ++ loc@@ -1650,21 +1635,20 @@ 		"rm -f " ++ loc 	git_config "annex.foo-checkpresent-hook" $ 		"if [ -e " ++ loc ++ " ]; then echo $ANNEX_KEY; fi"-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to hook remote failed"+	git_annex "copy" [annexedfile, "--to", "foo"] "copy --to hook remote" 	annexed_present annexedfile-	git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex "drop" [annexedfile, "--numcopies=2"] "drop" 	annexed_notpresent annexedfile-	git_annex "move" [annexedfile, "--from", "foo"] @? "move --from hook remote failed"+	git_annex "move" [annexedfile, "--from", "foo"] "move --from hook remote" 	annexed_present annexedfile-	git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+	git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2" 	annexed_present annexedfile   where 	dir = "dir" 	loc = dir ++ "/$ANNEX_KEY"-	git_config k v = boolSystem "git" [Param "config", Param k, Param v]-		@? "git config failed"+	git_config k v = git "config" [k, v] "git config" #else 	-- this test doesn't work in Windows TODO 	noop@@ -1673,32 +1657,32 @@ test_directory_remote :: Assertion test_directory_remote = intmpclonerepo $ do 	createDirectory "dir"-	git_annex "initremote" (words "foo type=directory encryption=none directory=dir") @? "initremote failed"-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "initremote" (words "foo type=directory encryption=none directory=dir") "initremote"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to directory remote failed"+	git_annex "copy" [annexedfile, "--to", "foo"] "copy --to directory remote" 	annexed_present annexedfile-	git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex "drop" [annexedfile, "--numcopies=2"] "drop" 	annexed_notpresent annexedfile-	git_annex "move" [annexedfile, "--from", "foo"] @? "move --from directory remote failed"+	git_annex "move" [annexedfile, "--from", "foo"] "move --from directory remote" 	annexed_present annexedfile-	git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+	git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2" 	annexed_present annexedfile  test_rsync_remote :: Assertion test_rsync_remote = intmpclonerepo $ do #ifndef mingw32_HOST_OS 	createDirectory "dir"-	git_annex "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") @? "initremote failed"-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "initremote" (words "foo type=rsync encryption=none rsyncurl=dir") "initremote"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to rsync remote failed"+	git_annex "copy" [annexedfile, "--to", "foo"] "copy --to rsync remote" 	annexed_present annexedfile-	git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex "drop" [annexedfile, "--numcopies=2"] "drop" 	annexed_notpresent annexedfile-	git_annex "move" [annexedfile, "--from", "foo"] @? "move --from rsync remote failed"+	git_annex "move" [annexedfile, "--from", "foo"] "move --from rsync remote" 	annexed_present annexedfile-	git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+	git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2" 	annexed_present annexedfile #else 	noop@@ -1709,16 +1693,16 @@ 	-- bup special remote needs an absolute path 	dir <- fromRawFilePath <$> absPath (toRawFilePath "dir") 	createDirectory dir-	git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) @? "initremote failed"-	git_annex "get" [annexedfile] @? "get of file failed"+	git_annex "initremote" (words $ "foo type=bup encryption=none buprepo="++dir) "initremote"+	git_annex "get" [annexedfile] "get of file" 	annexed_present annexedfile-	git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to bup remote failed"+	git_annex "copy" [annexedfile, "--to", "foo"] "copy --to bup remote" 	annexed_present annexedfile-	git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+	git_annex "drop" [annexedfile, "--numcopies=2"] "drop" 	annexed_notpresent annexedfile-	git_annex "copy" [annexedfile, "--from", "foo"] @? "copy --from bup remote failed"+	git_annex "copy" [annexedfile, "--from", "foo"] "copy --from bup remote" 	annexed_present annexedfile-	git_annex "move" [annexedfile, "--from", "foo"] @? "move --from bup remote failed"+	git_annex "move" [annexedfile, "--from", "foo"] "move --from bup remote" 	annexed_present annexedfile  -- gpg is not a build dependency, so only test when it's available@@ -1741,7 +1725,7 @@ 			@? "test harness self-test failed" 		void $ Utility.Gpg.testHarness gpgtmp gpgcmd $ do 			createDirectory "dir"-			let a cmd = git_annex cmd $+			let initps = 				[ "foo" 				, "type=directory" 				, "encryption=" ++ scheme@@ -1750,13 +1734,13 @@ 				] ++ if scheme `elem` ["hybrid","pubkey"] 					then ["keyid=" ++ Utility.Gpg.testKeyId] 					else []-			a "initremote" @? "initremote failed"-			not <$> a "initremote" @? "initremote failed to fail when run twice in a row"-			a "enableremote" @? "enableremote failed"-			a "enableremote" @? "enableremote failed when run twice in a row"-			git_annex "get" [annexedfile] @? "get of file failed"+			git_annex "initremote" initps "initremote"+			git_annex_shouldfail "initremote" initps "initremote should not work when run twice in a row"+			git_annex "enableremote" initps "enableremote"+			git_annex "enableremote" initps "enableremote when run twice in a row"+			git_annex "get" [annexedfile] "get of file" 			annexed_present annexedfile-			git_annex "copy" [annexedfile, "--to", "foo"] @? "copy --to encrypted remote failed"+			git_annex "copy" [annexedfile, "--to", "foo"] "copy --to encrypted remote" 			(c,k) <- annexeval $ do 				uuid <- Remote.nameToUUID "foo" 				rs <- Logs.Remote.readRemoteLog@@ -1768,11 +1752,11 @@ 			testEncryptedRemote scheme key c [k] @? "invalid crypto setup" 	 			annexed_present annexedfile-			git_annex "drop" [annexedfile, "--numcopies=2"] @? "drop failed"+			git_annex "drop" [annexedfile, "--numcopies=2"] "drop" 			annexed_notpresent annexedfile-			git_annex "move" [annexedfile, "--from", "foo"] @? "move --from encrypted remote failed"+			git_annex "move" [annexedfile, "--from", "foo"] "move --from encrypted remote" 			annexed_present annexedfile-			git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] @? "drop failed to fail"+			git_annex_shouldfail "drop" [annexedfile, "--numcopies=2"] "drop should not be allowed with numcopies=2" 			annexed_present annexedfile 	{- Ensure the configuration complies with the encryption scheme, and 	 - that all keys are encrypted properly for the given directory remote. -}@@ -1813,12 +1797,12 @@ test_add_subdirs = intmpclonerepo $ do 	createDirectory "dir" 	writecontent ("dir" </> "foo") $ "dir/" ++ content annexedfile-	git_annex "add" ["dir"] @? "add of subdir failed"+	git_annex "add" ["dir"] "add of subdir"  	{- Regression test for Windows bug where symlinks were not 	 - calculated correctly for files in subdirs. -} 	unlessM (hasUnlockedFiles <$> getTestMode) $ do-		git_annex "sync" [] @? "sync failed"+		git_annex "sync" [] "sync" 		l <- annexeval $ Utility.FileSystemEncoding.decodeBL 			<$> Annex.CatFile.catObject (Git.Types.Ref (encodeBS "HEAD:dir/foo")) 		"../.git/annex/" `isPrefixOf` l @? ("symlink from subdir to .git/annex is wrong: " ++ l)@@ -1826,7 +1810,7 @@ 	createDirectory "dir2" 	writecontent ("dir2" </> "foo") $ content annexedfile 	setCurrentDirectory "dir"-	git_annex "add" [".." </> "dir2"] @? "add of ../subdir failed"+	git_annex "add" [".." </> "dir2"] "add of ../subdir"  test_addurl :: Assertion test_addurl = intmpclonerepo $ do@@ -1835,17 +1819,17 @@ 	f <- fromRawFilePath <$> absPath (toRawFilePath "myurl") 	let url = replace "\\" "/" ("file:///" ++ dropDrive f) 	writecontent f "foo"-	git_annex_shouldfail "addurl" [url] @? "addurl failed to fail on file url"-	filecmd "addurl" [url] @? ("addurl failed on " ++ url)+	git_annex_shouldfail "addurl" [url] "addurl should not work on file url"+	filecmd "addurl" [url] ("addurl on " ++ url) 	let dest = "addurlurldest"-	filecmd "addurl" ["--file", dest, url] @? ("addurl failed on " ++ url ++ "  with --file")+	filecmd "addurl" ["--file", dest, url] ("addurl on " ++ url ++ "  with --file") 	doesFileExist dest @? (dest ++ " missing after addurl --file")  test_export_import :: Assertion test_export_import = intmpclonerepo $ do 	createDirectory "dir"-	git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") @? "initremote failed"-	git_annex "get" [] @? "get of files failed"+	git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") "initremote"+	git_annex "get" [] "get of files" 	annexed_present annexedfile  	-- Nothing to commit, but this makes sure the master branch@@ -1853,38 +1837,38 @@ 	-- depending on how the repository was set up. 	commitchanges 	origbranch <- annexeval origBranch-	git_annex "export" [origbranch, "--to", "foo"] @? "export to dir failed"+	git_annex "export" [origbranch, "--to", "foo"] "export to dir" 	dircontains annexedfile (content annexedfile)  	writedir "import" (content "import")-	git_annex "import" [origbranch, "--from", "foo"] @? "import from dir failed"-	git_annex "merge" ["foo/" ++ origbranch] @? "git annex merge failed"+	git_annex "import" [origbranch, "--from", "foo"] "import from dir"+	git_annex "merge" ["foo/" ++ origbranch] "git annex merge" 	annexed_present_imported "import" -	removeWhenExistsWith removeLink "import"+	removeWhenExistsWith R.removeLink (toRawFilePath "import") 	writecontent "import" (content "newimport1")-	git_annex "add" ["import"] @? "add of import failed"+	git_annex "add" ["import"] "add of import" 	commitchanges-	git_annex "export" [origbranch, "--to", "foo"] @? "export modified file to dir failed"+	git_annex "export" [origbranch, "--to", "foo"] "export modified file to dir" 	dircontains "import" (content "newimport1")  	-- verify that export refuses to overwrite modified file 	writedir "import" (content "newimport2")-	removeWhenExistsWith removeLink "import"+	removeWhenExistsWith R.removeLink (toRawFilePath "import") 	writecontent "import" (content "newimport3")-	git_annex "add" ["import"] @? "add of import failed"+	git_annex "add" ["import"] "add of import" 	commitchanges-	git_annex_shouldfail "export" [origbranch, "--to", "foo"] @? "export failed to fail in conflict"+	git_annex_shouldfail "export" [origbranch, "--to", "foo"] "export should not work in conflict" 	dircontains "import" (content "newimport2")  	-- resolving import conflict-	git_annex "import" [origbranch, "--from", "foo"] @? "import from dir failed"-	not <$> boolSystem "git" [Param "merge", Param "foo/master", Param "-mmerge"] @? "git merge of conflict failed to exit nonzero"-	removeWhenExistsWith removeLink "import"+	git_annex "import" [origbranch, "--from", "foo"] "import from dir"+	git_shouldfail "merge" ["foo/master", "-mmerge"] "git merge of conflict should exit nonzero"+	removeWhenExistsWith R.removeLink (toRawFilePath "import") 	writecontent "import" (content "newimport3")-	git_annex "add" ["import"] @? "add of import failed"+	git_annex "add" ["import"] "add of import" 	commitchanges-	git_annex "export" [origbranch, "--to", "foo"] @? "export failed after import conflict"+	git_annex "export" [origbranch, "--to", "foo"] "export after import conflict" 	dircontains "import" (content "newimport3")   where 	dircontains f v = @@ -1894,25 +1878,23 @@ 	-- When on an adjusted branch, this updates the master branch 	-- to match it, which is necessary since the master branch is going 	-- to be exported.-	commitchanges = git_annex "sync" ["--no-pull", "--no-push"] @? "sync failed"+	commitchanges = git_annex "sync" ["--no-pull", "--no-push"] "sync"  test_export_import_subdir :: Assertion test_export_import_subdir = intmpclonerepo $ do 	createDirectory "dir"-	git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") @? "initremote failed"-	git_annex "get" [] @? "get of files failed"+	git_annex "initremote" (words "foo type=directory encryption=none directory=dir exporttree=yes importtree=yes") "initremote"+	git_annex "get" [] "get of files" 	annexed_present annexedfile  	createDirectory subdir-	boolSystem "git" [Param "mv", File annexedfile, File subannexedfile]-		@? "git mv failed"-	boolSystem "git" [Param "commit", Param "-m", Param "moved"]-		@? "git commit failed"+	git "mv" [annexedfile, subannexedfile] "git mv"+	git "commit" ["-m", "moved"] "git commit" 	 	-- When on an adjusted branch, this updates the master branch 	-- to match it, which is necessary since the master branch is going 	-- to be exported.-	git_annex "sync" ["--no-pull", "--no-push"] @? "sync failed"+	git_annex "sync" ["--no-pull", "--no-push"] "sync"  	-- Run three times because there was a bug that took a couple 	-- of runs to lead to the wrong tree being written to the remote@@ -1933,13 +1915,13 @@ 	 	testexport = do 		origbranch <- annexeval origBranch-		git_annex "export" [origbranch++":"++subdir, "--to", "foo"] @? "export of subdir failed"+		git_annex "export" [origbranch++":"++subdir, "--to", "foo"] "export of subdir" 		dircontains annexedfile (content annexedfile) 	 	testimport = do 		origbranch <- annexeval origBranch-		git_annex "import" [origbranch++":"++subdir, "--from", "foo"] @? "import of subdir failed"-		git_annex "merge" ["foo/master"] @? "git annex merge foo/master failed"+		git_annex "import" [origbranch++":"++subdir, "--from", "foo"] "import of subdir"+		git_annex "merge" ["foo/master"] "git annex merge foo/master"  		-- Make sure that import did not import the file to the top 		-- of the repo.
Test/Framework.hs view
@@ -40,34 +40,51 @@ import qualified Annex.Action import qualified Annex.AdjustedBranch import qualified Utility.Process+import qualified Utility.Process.Transcript import qualified Utility.Env import qualified Utility.Env.Set import qualified Utility.Exception import qualified Utility.ThreadScheduler import qualified Utility.Tmp.Dir import qualified Utility.Metered-import qualified Utility.SafeCommand import qualified Command.Uninit +-- Run a process. The output and stderr is captured, and is only+-- displayed if the process does not return the expected value.+testProcess :: String -> [String] -> (Bool -> Bool) -> String -> Assertion+testProcess command params expectedret faildesc = do+	(transcript, ret) <- Utility.Process.Transcript.processTranscript command params Nothing+	(expectedret ret) @? (faildesc ++ " failed (transcript follows)\n" ++ transcript)++-- Run git. (Do not use to run git-annex as the one being tested+-- may not be in path.)+git :: String -> [String] -> String -> Assertion+git command params = testProcess "git" (command:params) (== True)++-- For when git is expected to fail.+git_shouldfail :: String -> [String] -> String -> Assertion+git_shouldfail command params = testProcess "git" (command:params) (== False)+ -- Run git-annex.-git_annex :: String -> [String] -> IO Bool-git_annex command params = do-	pp <- Annex.Path.programPath-	Utility.SafeCommand.boolSystem pp $-		map Utility.SafeCommand.Param (command:params)+git_annex :: String -> [String] -> String -> Assertion+git_annex = git_annex' (== True)  -- For when git-annex is expected to fail.--- Run with -q to squelch error.-git_annex_shouldfail :: String -> [String] -> IO Bool-git_annex_shouldfail command params = not <$> git_annex command ("-q":params)+git_annex_shouldfail :: String -> [String] -> String -> Assertion+git_annex_shouldfail = git_annex' (== False) -{- Runs git-annex and returns its output. -}+git_annex' :: (Bool -> Bool) -> String -> [String] -> String -> Assertion+git_annex' expectedret command params faildesc = do+	pp <- Annex.Path.programPath+	testProcess pp (command:params) expectedret faildesc++{- Runs git-annex and returns its standard output. -} git_annex_output :: String -> [String] -> IO String git_annex_output command params = do 	pp <- Annex.Path.programPath 	Utility.Process.readProcess pp (command:params) -git_annex_expectoutput :: String -> [String] -> [String] -> IO ()+git_annex_expectoutput :: String -> [String] -> [String] -> Assertion git_annex_expectoutput command params expected = do 	got <- lines <$> git_annex_output command params 	got == expected @? ("unexpected value running " ++ command ++ " " ++ show params ++ " -- got: " ++ show got ++ " expected: " ++ show expected)@@ -96,7 +113,7 @@ 	origindir <- absPath . Git.Types.fromConfigValue 		=<< annexeval (Config.getConfig k v) 	let originurl = "localhost:" ++ fromRawFilePath origindir-	boolSystem "git" [Param "config", Param config, Param originurl] @? "git config failed"+	git "config" [config, originurl] "git config failed" 	a   where 	config = "remote.origin.url"@@ -135,7 +152,7 @@ 			throwM e  disconnectOrigin :: Assertion-disconnectOrigin = boolSystem "git" [Param "remote", Param "rm", Param "origin"] @? "remote rm"+disconnectOrigin = git "remote" ["rm", "origin"] "remote rm"  withgitrepo :: (FilePath -> Assertion) -> Assertion withgitrepo a = do@@ -163,7 +180,7 @@ setuprepo dir = do 	cleanup dir 	ensuretmpdir-	boolSystem "git" [Param "init", Param "-q", File dir] @? "git init failed"+	git "init" ["-q", dir] "git init" 	configrepo dir 	return dir @@ -184,18 +201,22 @@ 	cleanup new 	ensuretmpdir 	let cloneparams = catMaybes-		[ Just $ Param "clone"-		, Just $ Param "-q"-		, if bareClone cfg then Just (Param "--bare") else Nothing-		, if sharedClone cfg then Just (Param "--shared") else Nothing-		, Just $ File old-		, Just $ File new+		[ Just "-q"+		, if bareClone cfg then Just "--bare" else Nothing+		, if sharedClone cfg then Just "--shared" else Nothing+		, Just old+		, Just new 		]-	boolSystem "git" cloneparams @? "git clone failed"+	git "clone" cloneparams "git clone" 	configrepo new 	indir new $ do 		ver <- annexVersion <$> getTestMode-		git_annex "init" ["-q", new, "--version", show (Types.RepoVersion.fromRepoVersion ver)] @? "git annex init failed"+		git_annex "init" +			[ "-q"+			, new, "--version"+			, show (Types.RepoVersion.fromRepoVersion ver)+			]+			"git annex init" 	unless (bareClone cfg) $ 		indir new $ 			setupTestMode@@ -204,16 +225,16 @@ configrepo :: FilePath -> IO () configrepo dir = indir dir $ do 	-- ensure git is set up to let commits happen-	boolSystem "git" [Param "config", Param "user.name", Param "Test User"] @? "git config failed"-	boolSystem "git" [Param "config", Param "user.email", Param "test@example.com"] @? "git config failed"+	git "config" ["user.name", "Test User"]+		"git config"+	git "config" ["user.email", "test@example.com"]+		"git config" 	-- avoid signed commits by test suite-	boolSystem "git" [Param "config", Param "commit.gpgsign", Param "false"] @? "git config failed"+	git "config" ["commit.gpgsign", "false"]+		"git config" 	-- tell git-annex to not annex the ingitfile-	boolSystem "git"-		[ Param "config"-		, Param "annex.largefiles"-		, Param ("exclude=" ++ ingitfile)-		] @? "git config annex.largefiles failed"+	git "config" ["annex.largefiles", "exclude=" ++ ingitfile]+		"git config annex.largefiles"  ensuretmpdir :: IO () ensuretmpdir = do@@ -394,10 +415,10 @@ unannexed :: FilePath -> Assertion unannexed = runchecks [checkregularfile, checkcontent, checkwritable] -add_annex :: FilePath -> IO Bool-add_annex f = ifM (unlockedFiles <$> getTestMode)-	( boolSystem "git" [Param "add", File f]-	, git_annex "add" [f]+add_annex :: FilePath -> String -> Assertion+add_annex f faildesc = ifM (unlockedFiles <$> getTestMode)+	( git "add" [f] faildesc+	, git_annex "add" [f] faildesc 	)  data TestMode = TestMode@@ -471,8 +492,8 @@ setupTestMode = do 	testmode <- getTestMode 	when (adjustedUnlockedBranch testmode) $ do-		boolSystem "git" [Param "commit", Param "--allow-empty", Param "-m", Param "empty"] @? "git commit failed"-		git_annex "adjust" ["--unlock"] @? "git annex adjust failed"+		git "commit" ["--allow-empty", "-m", "empty"] "git commit failed"+		git_annex "adjust" ["--unlock"] "git annex adjust failed"  changeToTmpDir :: FilePath -> IO () changeToTmpDir t = do
Types/AdjustedBranch.hs view
@@ -1,6 +1,6 @@ {- adjusted branch types  -- - Copyright 2016-2018 Joey Hess <id@joeyh.name>+ - Copyright 2016-2020 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -10,9 +10,9 @@ data Adjustment 	= LinkAdjustment LinkAdjustment 	| PresenceAdjustment PresenceAdjustment (Maybe LinkAdjustment)+	| LinkPresentAdjustment LinkPresentAdjustment 	deriving (Show, Eq) --- Doesn't make sense to combine unlock with fix. data LinkAdjustment 	= UnlockAdjustment 	| LockAdjustment@@ -25,6 +25,11 @@ 	| ShowMissingAdjustment 	deriving (Show, Eq) +data LinkPresentAdjustment+	= UnlockPresentAdjustment+	| LockPresentAdjustment+	deriving (Show, Eq)+ -- Adjustments have to be able to be reversed, so that commits made to the -- adjusted branch can be reversed to the commit that would have been made -- without the adjustment and applied to the original branch.@@ -36,6 +41,8 @@ 		LinkAdjustment (reverseAdjustment l) 	reverseAdjustment (PresenceAdjustment p ml) = 		PresenceAdjustment (reverseAdjustment p) (fmap reverseAdjustment ml)+	reverseAdjustment (LinkPresentAdjustment l) =+		LinkPresentAdjustment (reverseAdjustment l)  instance ReversableAdjustment LinkAdjustment where 	reverseAdjustment UnlockAdjustment = LockAdjustment@@ -48,7 +55,10 @@ 	reverseAdjustment HideMissingAdjustment = ShowMissingAdjustment 	reverseAdjustment ShowMissingAdjustment = HideMissingAdjustment +instance ReversableAdjustment LinkPresentAdjustment where+	reverseAdjustment UnlockPresentAdjustment = LockPresentAdjustment+	reverseAdjustment LockPresentAdjustment = UnlockPresentAdjustment+ adjustmentHidesFiles :: Adjustment -> Bool adjustmentHidesFiles (PresenceAdjustment HideMissingAdjustment _) = True adjustmentHidesFiles _ = False-
Types/CleanupActions.hs view
@@ -16,6 +16,7 @@ 	| StopHook UUID 	| FsckCleanup 	| SshCachingCleanup+	| AdjustedBranchUpdate 	| TorrentCleanup URLString 	| OtherTmpCleanup 	deriving (Eq, Ord)
Types/GitConfig.hs view
@@ -125,6 +125,7 @@ 	, annexAutoUpgradeRepository :: Bool 	, annexCommitMode :: CommitMode 	, annexSkipUnknown :: Bool+	, annexAdjustedBranchRefresh :: Integer 	, coreSymlinks :: Bool 	, coreSharedRepository :: SharedRepository 	, receiveDenyCurrentBranch :: DenyCurrentBranch@@ -219,6 +220,10 @@ 		then ManualCommit 		else AutomaticCommit 	, annexSkipUnknown = getbool (annexConfig "skipunknown") True+	, annexAdjustedBranchRefresh = fromMaybe+		-- parse as bool if it's not a number+		(if getbool "adjustedbranchrefresh" False then 1 else 0)+		(getmayberead (annexConfig "adjustedbranchrefresh")) 	, coreSymlinks = getbool "core.symlinks" True 	, coreSharedRepository = getSharedRepository r 	, receiveDenyCurrentBranch = getDenyCurrentBranch r
Upgrade/V0.hs view
@@ -19,7 +19,8 @@ 	olddir <- fromRawFilePath <$> fromRepo gitAnnexDir 	keys <- getKeysPresent0 olddir 	forM_ keys $ \k ->-		moveAnnex k $ toRawFilePath $ olddir </> keyFile0 k+		moveAnnex k (AssociatedFile Nothing)+			(toRawFilePath $ olddir </> keyFile0 k)  	-- update the symlinks to the key files 	-- No longer needed here; V1.upgrade does the same thing
Upgrade/V1.hs view
@@ -80,7 +80,7 @@ 		let d = parentDir f' 		liftIO $ allowWrite d 		liftIO $ allowWrite f'-		_ <- moveAnnex k f'+		_ <- moveAnnex k (AssociatedFile Nothing) f' 		liftIO $ removeDirectory (fromRawFilePath d)  updateSymlinks :: Annex ()
Upgrade/V5.hs view
@@ -32,6 +32,7 @@ import Utility.InodeCache import Utility.DottedVersion import Annex.AdjustedBranch+import qualified Utility.RawFilePath as R  import qualified Data.ByteString as S @@ -88,8 +89,13 @@ 	 - as does annex.thin. -} 	setConfig (annexConfig "thin") (boolConfig True) 	Direct.setIndirect-	cur <- fromMaybe (error "Somehow no branch is checked out")-		<$> inRepo Git.Branch.current+	cur <- inRepo Git.Branch.current >>= \case+		Just cur -> return cur+		Nothing -> do+			-- Avoid running pre-commit hook.+			commitForAdjustedBranch [Param "--no-verify"]+			fromMaybe (giveup "Nothing is committed, and a commit failed; unable to proceed.") +				<$> inRepo Git.Branch.current 	upgradeDirectWorkTree 	removeDirectCruft 	{- Create adjusted branch where all files are unlocked.@@ -151,7 +157,7 @@ 		) 	 	writepointer f k = liftIO $ do-		removeWhenExistsWith removeLink f+		removeWhenExistsWith R.removeLink (toRawFilePath f) 		S.writeFile f (formatPointer k)  {- Remove all direct mode bookkeeping files. -}
Utility/Batch.hs view
@@ -41,12 +41,10 @@ 	batchthread = asyncBound $ do 		setProcessPriority 0 maxNice 		a+	maxNice = 19 #else batch a = a #endif--maxNice :: Int-maxNice = 19  {- Makes a command be run by whichever of nice, ionice, and nocache  - are available in the path. -}
Utility/Daemon.hs view
@@ -112,7 +112,7 @@ 	pid <- getPID 	writeFile pidfile (show pid) 	lckfile <- winLockFile pid pidfile-	writeFile lckfile ""+	writeFile (fromRawFilePath lckfile) "" 	void $ lockExclusive lckfile #endif @@ -176,14 +176,14 @@  - when eg, restarting the daemon.  -} #ifdef mingw32_HOST_OS-winLockFile :: PID -> FilePath -> IO FilePath+winLockFile :: PID -> FilePath -> IO RawFilePath winLockFile pid pidfile = do 	cleanstale-	return $ prefix ++ show pid ++ suffix+	return $ toRawFilePath $ prefix ++ show pid ++ suffix   where 	prefix = pidfile ++ "." 	suffix = ".lck" 	cleanstale = mapM_ (void . tryIO . removeFile) =<<-		(filter iswinlockfile <$> dirContents (parentDir pidfile))+		(filter iswinlockfile <$> dirContents (fromRawFilePath (parentDir (toRawFilePath pidfile)))) 	iswinlockfile f = suffix `isSuffixOf` f && prefix `isPrefixOf` f #endif
Utility/Directory.hs view
@@ -16,7 +16,7 @@  import Control.Monad import System.FilePath-import System.PosixCompat.Files+import System.PosixCompat.Files hiding (removeLink) import Control.Applicative import System.IO.Unsafe (unsafeInterleaveIO) import Data.Maybe
Utility/FileMode.hs view
@@ -16,7 +16,7 @@ import System.IO import Control.Monad import System.PosixCompat.Types-import System.PosixCompat.Files+import System.PosixCompat.Files hiding (removeLink) import Control.Monad.IO.Class import Foreign (complement) import Control.Monad.Catch
Utility/FileSize.hs view
@@ -14,7 +14,7 @@ 	getFileSize', ) where -import System.PosixCompat.Files+import System.PosixCompat.Files hiding (removeLink) import qualified Utility.RawFilePath as R #ifdef mingw32_HOST_OS import Control.Exception (bracket)
Utility/FileSystemEncoding.hs view
@@ -36,17 +36,18 @@ import System.IO import System.IO.Unsafe import Data.Word-import Data.List+import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L #ifdef mingw32_HOST_OS import qualified Data.ByteString.UTF8 as S8 import qualified Data.ByteString.Lazy.UTF8 as L8+#else+import Data.List+import Utility.Split #endif-import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath)  import Utility.Exception-import Utility.Split  {- Makes all subsequent Handles that are opened, as well as stdio Handles,  - use the filesystem encoding, instead of the encoding of the current@@ -178,6 +179,7 @@ toRawFilePath :: FilePath -> RawFilePath toRawFilePath = encodeFilePath +#ifndef mingw32_HOST_OS {- Converts a [Word8] to a FilePath, encoding using the filesystem encoding.  -  - w82s produces a String, which may contain Chars that are invalid@@ -206,6 +208,7 @@ decodeW8NUL = intercalate [c2w8 nul] . map decodeW8 . splitc nul   where 	nul = '\NUL'+#endif  c2w8 :: Char -> Word8 c2w8 = fromIntegral . fromEnum
Utility/Gpg.hs view
@@ -332,6 +332,7 @@ testKeyId :: String testKeyId = "129D6E0AC537B9C7" +#ifndef mingw32_HOST_OS testKey :: String testKey = keyBlock True 	[ "mI0ETvFAZgEEAKnqwWgZqznMhi1RQExem2H8t3OyKDxaNN3rBN8T6LWGGqAYV4wT"@@ -400,7 +401,6 @@ 		| public = "PUBLIC" 		| otherwise = "PRIVATE" -#ifndef mingw32_HOST_OS {- Runs an action using gpg in a test harness, in which gpg does  - not use ~/.gpg/, but sets up the test key in a subdirectory of   - the passed directory and uses it.
Utility/LockFile/Windows.hs view
@@ -16,7 +16,6 @@ import System.Win32.Types import System.Win32.File import Control.Concurrent-import System.FilePath.ByteString (RawFilePath)  import Utility.FileSystemEncoding
Utility/MagicWormhole.hs view
@@ -113,23 +113,28 @@ 	-- Work around stupid stdout buffering behavior of python. 	-- See https://github.com/warner/magic-wormhole/issues/108 	environ <- addEntry "PYTHONUNBUFFERED" "1" <$> getEnvironment-	runWormHoleProcess p { env = Just environ} $ \_hin hout herr -> do-		(inout, inerr) <- findcode hout `concurrently` findcode herr+	runWormHoleProcess p { env = Just environ} $ \_hin hout herr ph -> do+ 		(inout, inerr) <- concurrently+			(findcode ph hout)+			(findcode ph herr) 		return (inout || inerr)   where 	p = wormHoleProcess (Param "send" : ps ++ [File f])-	findcode h = findcode' =<< words <$> hGetContents h+	findcode ph h = findcode' =<< getwords ph h [] 	findcode' [] = return False 	findcode' (w:ws) = case mkCode w of 		Just code -> do 			_ <- tryPutMVar observer code 			return True 		Nothing -> findcode' ws+	getwords ph h c = hGetLineUntilExitOrEOF ph h >>= \case+		Nothing -> return $ concatMap words $ reverse c+		Just l -> getwords ph h (l:c)  -- | Receives a file. Once the receive is under way, the Code will be -- read from the CodeProducer, and fed to wormhole on stdin. receiveFile :: FilePath -> CodeProducer -> WormHoleParams -> IO Bool-receiveFile f (CodeProducer producer) ps = runWormHoleProcess p $ \hin _hout _herr -> do+receiveFile f (CodeProducer producer) ps = runWormHoleProcess p $ \hin _hout _herr _ph -> do 	Code c <- readMVar producer 	hPutStrLn hin c 	hFlush hin@@ -145,7 +150,7 @@ wormHoleProcess :: WormHoleParams -> CreateProcess wormHoleProcess = proc "wormhole" . toCommand -runWormHoleProcess :: CreateProcess -> (Handle -> Handle -> Handle -> IO Bool) ->  IO Bool+runWormHoleProcess :: CreateProcess -> (Handle -> Handle -> Handle -> ProcessHandle -> IO Bool) ->  IO Bool runWormHoleProcess p consumer = 	withCreateProcess p' go `catchNonAsync` const (return False)   where@@ -155,7 +160,7 @@ 		, std_err = CreatePipe 		} 	go (Just hin) (Just hout) (Just herr) pid =-		consumer hin hout herr <&&> waitbool pid+		consumer hin hout herr pid <&&> waitbool pid 	go _ _ _ _ = error "internal" 	waitbool pid = do 		r <- waitForProcess pid
Utility/Metered.hs view
@@ -49,7 +49,6 @@ import Utility.Percentage import Utility.DataUnits import Utility.HumanTime-import Utility.ThreadScheduler import Utility.SimpleProtocol as Proto  import qualified Data.ByteString.Lazy as L@@ -266,7 +265,7 @@ commandMeterExitCode' :: ProgressParser -> OutputHandler -> Maybe Meter -> MeterUpdate -> FilePath -> [CommandParam] -> (CreateProcess -> CreateProcess) -> IO (Maybe ExitCode) commandMeterExitCode' progressparser oh mmeter meterupdate cmd params mkprocess =  	outputFilter cmd params mkprocess Nothing-		(feedprogress mmeter zeroBytesProcessed [])+		(const $ feedprogress mmeter zeroBytesProcessed []) 		handlestderr   where 	feedprogress sendtotalsize prev buf h = do@@ -291,9 +290,11 @@ 							meterupdate bytes 						feedprogress sendtotalsize' bytes buf' h -	handlestderr h = unlessM (hIsEOF h) $ do-		stderrHandler oh =<< hGetLine h-		handlestderr h+	handlestderr ph h = hGetLineUntilExitOrEOF ph h >>= \case+		Just l -> do+			stderrHandler oh l+			handlestderr ph h+		Nothing -> return ()  {- Runs a command, that may display one or more progress meters on  - either stdout or stderr, and prevents the meters from being displayed.@@ -306,8 +307,8 @@ demeterCommandEnv :: OutputHandler -> FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool demeterCommandEnv oh cmd params environ = do 	ret <- outputFilter cmd params id environ-		(\outh -> avoidProgress True outh stdouthandler)-		(\errh -> avoidProgress True errh $ stderrHandler oh)+		(\ph outh -> avoidProgress True ph outh stdouthandler)+		(\ph errh -> avoidProgress True ph errh $ stderrHandler oh) 	return $ case ret of 		Just ExitSuccess -> True 		_ -> False@@ -320,44 +321,31 @@  - filter out lines that contain \r (typically used to reset to the  - beginning of the line when updating a progress display).  -}-avoidProgress :: Bool -> Handle -> (String -> IO ()) -> IO ()-avoidProgress doavoid h emitter = unlessM (hIsEOF h) $ do-	s <- hGetLine h-	unless (doavoid && '\r' `elem` s) $-		emitter s-	avoidProgress doavoid h emitter+avoidProgress :: Bool -> ProcessHandle -> Handle -> (String -> IO ()) -> IO ()+avoidProgress doavoid ph h emitter = hGetLineUntilExitOrEOF ph h >>= \case+	Just s -> do+		unless (doavoid && '\r' `elem` s) $+			emitter s+		avoidProgress doavoid ph h emitter+	Nothing -> return ()  outputFilter 	:: FilePath 	-> [CommandParam] 	-> (CreateProcess -> CreateProcess) 	-> Maybe [(String, String)]-	-> (Handle -> IO ())-	-> (Handle -> IO ())+	-> (ProcessHandle -> Handle -> IO ())+	-> (ProcessHandle -> Handle -> IO ()) 	-> IO (Maybe ExitCode) outputFilter cmd params mkprocess environ outfilter errfilter =  	catchMaybeIO $ withCreateProcess p go   where-	go _ (Just outh) (Just errh) pid = do-		outt <- async $ tryIO (outfilter outh) >> hClose outh-		errt <- async $ tryIO (errfilter errh) >> hClose errh-		ret <- waitForProcess pid--		-- Normally, now that the process has exited, the threads-		-- will finish processing its output and terminate.-		-- But, just in case the process did something evil like-		-- forking to the background while inheriting stderr,-		-- it's possible that the threads will not finish, which-		-- would result in a deadlock. So, wait a few seconds-		-- maximum for them to finish and then cancel them.-		-- (One program that has behaved this way in the past is-		-- openssh.)-		void $ tryNonAsync $ race_-			(wait outt >> wait errt)-			(threadDelaySeconds (Seconds 2))-		cancel outt-		cancel errt-+	go _ (Just outh) (Just errh) ph = do+		outt <- async $ tryIO (outfilter ph outh) >> hClose outh+		errt <- async $ tryIO (errfilter ph errh) >> hClose errh+		ret <- waitForProcess ph+		wait outt+		wait errt 		return ret 	go _ _ _ _ = error "internal"
Utility/MoveFile.hs view
@@ -15,12 +15,12 @@  import Control.Monad import System.FilePath-import System.PosixCompat.Files-import Control.Monad.IfElse+import System.PosixCompat.Files hiding (removeLink) import System.IO.Error import Prelude  #ifndef mingw32_HOST_OS+import Control.Monad.IfElse import Utility.SafeCommand #endif
Utility/Process.hs view
@@ -6,7 +6,7 @@  - License: BSD-2-clause  -} -{-# LANGUAGE CPP, Rank2Types #-}+{-# LANGUAGE CPP, Rank2Types, LambdaCase #-} {-# OPTIONS_GHC -fno-warn-tabs #-}  module Utility.Process (@@ -24,6 +24,7 @@ 	withCreateProcess, 	waitForProcess, 	cleanupProcess,+	hGetLineUntilExitOrEOF, 	startInteractiveProcess, 	stdinHandle, 	stdoutHandle,@@ -229,3 +230,92 @@ 	maybe (return ()) hClose mb_stderr 	void $ waitForProcess pid #endif++{- | Like hGetLine, reads a line from the Handle. Returns Nothing if end of+ - file is reached, or the handle is closed, or if the process has exited+ - and there is nothing more buffered to read from the handle.+ -+ - This is useful to protect against situations where the process might+ - have transferred the handle being read to another process, and so+ - the handle could remain open after the process has exited. That is a rare+ - situation, but can happen. Consider a the process that started up a+ - daemon, and the daemon inherited stderr from it, rather than the more+ - usual behavior of closing the file descriptor. Reading from stderr+ - would block past the exit of the process.+ -+ - In that situation, this will detect when the process has exited,+ - and avoid blocking forever. But will still return anything the process+ - buffered to the handle before exiting.+ -+ - Note on newline mode: This ignores whatever newline mode is configured+ - for the handle, because there is no way to query that. On Windows,+ - it will remove any \r coming before the \n. On other platforms,+ - it does not treat \r specially.+ -}+hGetLineUntilExitOrEOF :: ProcessHandle -> Handle -> IO (Maybe String)+hGetLineUntilExitOrEOF ph h = go []+  where+	go buf = do+		ready <- waitforinputorerror smalldelay+		if ready+			then getloop buf go+			else getProcessExitCode ph >>= \case+				-- Process still running, wait longer.+				Nothing -> go buf+				-- Process is done. It's possible+				-- that it output something and exited+				-- since the prior hWaitForInput,+				-- so check one more time for any buffered+				-- output.+				Just _ -> finalcheck buf++	finalcheck buf = do+		ready <- waitforinputorerror 0+		if ready+			then getloop buf finalcheck+			-- No remaining buffered input, though the handle+			-- may not be EOF if something else is keeping it+			-- open. Treated the same as EOF.+			else eofwithnolineend buf++	-- On exception, proceed as if there was input;+	-- EOF and any encoding issues are dealt with+	-- when reading from the handle.+	waitforinputorerror t = hWaitForInput h t+		`catchNonAsync` const (pure True)++	getchar = +		catcherr EOF $+			-- If the handle is closed, reading from it is+			-- an IllegalOperation.+			catcherr IllegalOperation $+				Just <$> hGetChar h+	  where+		catcherr t = catchIOErrorType t (const (pure Nothing))++	getloop buf cont =+		getchar >>= \case+			Just c+				| c == '\n' -> return (Just (gotline buf))+				| otherwise -> cont (c:buf)+			Nothing -> eofwithnolineend buf++#ifndef mingw32_HOST_OS+	gotline buf = reverse buf+#else+	gotline ('\r':buf) = reverse buf+	gotline buf = reverse buf+#endif++	eofwithnolineend buf = return $+		if null buf +			then Nothing -- no line read+			else Just (reverse buf)++	-- Tenth of a second delay. If the process exits with the FD being+	-- held open, will wait up to twice this long before returning.+	-- This delay could be made smaller. However, that is an unusual+	-- case, and making it too small would cause lots of wakeups while+	-- waiting for output. Bearing in mind that this could be run on+	-- many processes at the same time.+	smalldelay = 100 -- milliseconds
Utility/Process/Transcript.hs view
@@ -15,14 +15,13 @@ ) where  import Utility.Process-import Utility.Misc  import System.IO import System.Exit import Control.Concurrent.Async import Control.Monad-import Control.Exception #ifndef mingw32_HOST_OS+import Control.Exception import qualified System.Posix.IO #else import Control.Applicative@@ -63,10 +62,10 @@ 			, std_err = UseHandle writeh 			} 		withCreateProcess cp' $ \hin hout herr pid -> do-			get <- asyncreader readh+			get <- asyncreader pid readh 			writeinput input (hin, hout, herr, pid)-			transcript <- wait get 			code <- waitForProcess pid+			transcript <- wait get 			return (transcript, code) #else {- This implementation for Windows puts stderr after stdout. -}@@ -77,16 +76,18 @@ 		} 	withCreateProcess cp' $ \hin hout herr pid -> do 		let p = (hin, hout, herr, pid)-		getout <- asyncreader (stdoutHandle p)-		geterr <- asyncreader (stderrHandle p)+		getout <- asyncreader pid (stdoutHandle p)+		geterr <- asyncreader pid (stderrHandle p) 		writeinput input p-		transcript <- (++) <$> wait getout <*> wait geterr 		code <- waitForProcess pid+		transcript <- (++) <$> wait getout <*> wait geterr 		return (transcript, code) #endif   where-	asyncreader = async . hGetContentsStrict-+	asyncreader pid h = async $ reader pid h []+	reader pid h c = hGetLineUntilExitOrEOF pid h >>= \case+		Nothing -> return (concat (reverse c))+		Just l -> reader pid h (l:c) 	writeinput (Just s) p = do 		let inh = stdinHandle p 		unless (null s) $ do
Utility/RawFilePath.hs view
@@ -46,7 +46,6 @@ createDirectory p = D.createDirectory p 0o777  #else-import qualified Data.ByteString as B import System.PosixCompat (FileStatus, FileMode) import qualified System.PosixCompat as P import qualified System.PosixCompat.Files as F@@ -66,8 +65,10 @@ 	(fromRawFilePath a) 	(fromRawFilePath b) +{- On windows, removeLink is not available, so only remove files,+ - not symbolic links. -} removeLink :: RawFilePath -> IO ()-removeLink = P.removeLink . fromRawFilePath+removeLink = D.removeFile . fromRawFilePath  getFileStatus :: RawFilePath -> IO FileStatus getFileStatus = P.getFileStatus . fromRawFilePath
Utility/Tmp.hs view
@@ -20,7 +20,7 @@ import System.FilePath import System.Directory import Control.Monad.IO.Class-import System.PosixCompat.Files+import System.PosixCompat.Files hiding (removeLink)  import Utility.Exception import Utility.FileSystemEncoding
Utility/Url.hs view
@@ -452,7 +452,12 @@ {- Download a perhaps large file using conduit, with auto-resume  - of incomplete downloads.  -- - Does not catch exceptions.+ - A Request can be configured to throw exceptions for non-2xx http+ - status codes, or not. That configuration is overridden by this,+ - and if it is unable to download, it throws an exception containing+ - a user-visible explanation of the problem. (However, exceptions+ - thrown for reasons other than http status codes will still be thrown+ - as usual.)  -} downloadConduit :: MeterUpdate -> Request -> FilePath -> UrlOptions -> IO () downloadConduit meterupdate req file uo =@@ -480,28 +485,29 @@ 			filter ((/= hAcceptEncoding) . fst) 				(requestHeaders req) 		, decompress = const False+		-- Avoid throwing exceptions non-2xx http status codes,+		-- since we rely on parsing the Response to handle+		-- several such codes.+		, checkResponse = \_ _ -> return () 		}  	-- Resume download from where a previous download was interrupted,  	-- when supported by the http server. The server may also opt to 	-- send the whole file rather than resuming.-	resumedownload sz = catchJust-		(matchStatusCodeHeadersException (alreadydownloaded sz))-		dl-		(const noop)-	  where-		dl = join $ runResourceT $ do-			let req'' = req' { requestHeaders = resumeFromHeader sz : requestHeaders req }-			liftIO $ debugM "url" (show req'')-			resp <- http req'' (httpManager uo)-			if responseStatus resp == partialContent206+	resumedownload sz = join $ runResourceT $ do+		let req'' = req' { requestHeaders = resumeFromHeader sz : requestHeaders req' }+		liftIO $ debugM "url" (show req'')+		resp <- http req'' (httpManager uo)+		if responseStatus resp == partialContent206+			then do+				store (toBytesProcessed sz) AppendMode resp+				return (return ())+			else if responseStatus resp == ok200 				then do-					store (toBytesProcessed sz) AppendMode resp+					store zeroBytesProcessed WriteMode resp 					return (return ())-				else if responseStatus resp == ok200-					then do-						store zeroBytesProcessed WriteMode resp-						return (return ())+				else if alreadydownloaded sz resp+					then return (return ()) 					else do 						rf <- extractFromResourceT (respfailure resp) 						if responseStatus resp == unauthorized401@@ -510,8 +516,9 @@ 								Just ba -> retryauthed ba 							else return $ giveup rf 	-	alreadydownloaded sz s h = s == requestedRangeNotSatisfiable416 -		&& case lookup hContentRange h of+	alreadydownloaded sz resp+		| responseStatus resp /= requestedRangeNotSatisfiable416 = False+		| otherwise = case lookup hContentRange (responseHeaders resp) of 			-- This could be improved by fixing 			-- https://github.com/aristidb/http-types/issues/87 			Just crh -> crh == B8.fromString ("bytes */" ++ show sz)
Utility/WebApp.hs view
@@ -36,9 +36,6 @@ import Control.Arrow ((***)) import Control.Concurrent -localhost :: HostName-localhost = "localhost"- {- Builds a command to use to start or open a web browser showing an url. -} browserProc :: String -> CreateProcess #ifdef darwin_HOST_OS@@ -105,6 +102,7 @@ 		_ -> error "unable to bind to a local socket"   where 	hostname = fromMaybe localhost h+	localhost = "localhost" 	hints = defaultHints { addrSocketType = Stream } 	{- Repeated attempts because bind sometimes fails for an 	 - unknown reason on OSX. -}
doc/git-annex-adjust.mdwn view
@@ -4,7 +4,7 @@  # SYNOPSIS -git annex adjust `--unlock|--lock|--fix|--hide-missing [--unlock|--lock|--fix]`+git annex adjust `--unlock|--lock|--fix|--hide-missing [--unlock|--lock|--fix]|--unlock-present`  # DESCRIPTION @@ -31,8 +31,8 @@  Re-running this command with the same options while inside the adjusted branch will update the adjusted branch-as necessary (eg for `--hide-missing`), and will also propagate commits-back to the original branch.+as necessary (eg for `--hide-missing` and `--unlock-present`), +and will also propagate commits back to the original branch.  # OPTIONS @@ -82,13 +82,32 @@   branch.      To update the adjusted branch to reflect changes to content availability, -  run `git annex adjust --hide-missing` again.+  run `git annex adjust --hide-missing` again. Or, to automate updates,+  set the `annex.adjustedbranchrefresh` config.    Despite missing files being hidden, `git annex sync --content` will   still operate on them, and can be used to download missing-  files from remotes.+  files from remotes. It also updates the adjusted branch after+  transferring content.    This option can be combined with --unlock, --lock, or --fix.++* `--unlock-present`++  Unlock files whose content is present, and lock files whose content is+  missing. This provides the benefits of working with unlocked files,+  but makes it easier to see when the content of a file is not missing,+  since it will be a broken symlink.+  +  The adjusted branch is not immediately changed when content availability+  changes, so when you `git annex get` files, they will remain locked.+  And when you `git annex drop` files, they will remain locked and so will+  not be broken symlinks.+  +  To update the adjusted branch to reflect changes to content availability, +  run `git annex adjust --unlock-present` again. Or, to automate updates,+  set the `annex.adjustedbranchrefresh` config. Or use `git-annex sync+  --content`, which updates the branch after transferring content.  # SEE ALSO
doc/git-annex-examinekey.mdwn view
@@ -28,7 +28,8 @@    These variables are also available for use in formats: ${key}, ${backend},   ${bytesize}, ${humansize}, ${keyname}, ${hashdirlower}, ${hashdirmixed},-  ${mtime} (for the mtime field of a WORM key).+  ${mtime} (for the mtime field of a WORM key), ${file} (when a filename is+  provided to examinekey).    Also, '\\n' is a newline, '\\000' is a NULL, etc.
doc/git-annex.mdwn view
@@ -1016,6 +1016,23 @@    When the `--batch` option is used, this configuration is ignored. +* `annex.adjustedbranchrefresh`++  When [[git-annex-adjust]](1) is used to set up an adjusted branch+  that needs to be refreshed after getting or dropping files, this config+  controls how frequently the branch is refreshed. ++  Refreshing the branch takes some time, so doing it after every file+  can be too slow. (It also can generate a lot of dangling git objects.)+  The default value is 0 (or false), which does not+  refresh the branch. Setting 1 (or true) will refresh only once, +  after git-annex has made other changes. Setting 2 refreshes after every+  file, 3 after every other file, and so on; setting 100 refreshes after+  every 99 files.++  (If git-annex gets faster in the future, refresh rates will increase+  proportional to the speed improvements.)+ * `annex.queuesize`    git-annex builds a queue of git commands, in order to combine similar
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 8.20201116+Version: 8.20201127 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -609,6 +609,7 @@     Annex     Annex.Action     Annex.AdjustedBranch+    Annex.AdjustedBranch.Merge     Annex.AdjustedBranch.Name     Annex.AutoMerge     Annex.BloomFilter@@ -623,6 +624,7 @@     Annex.Concurrent     Annex.Concurrent.Utility     Annex.Content+    Annex.Content.Presence     Annex.Content.LowLevel     Annex.Content.PointerFile     Annex.CurrentBranch