packages feed

git-annex 8.20210310 → 8.20210330

raw patch · 59 files changed

+506/−285 lines, 59 filesdep ~attoparsec

Dependency ranges changed: attoparsec

Files

Annex/Branch.hs view
@@ -89,7 +89,7 @@  {- Branch's name in origin. -} originname :: Git.Ref-originname = Git.Ref $ "origin/" <> fromRef' name+originname = Git.Ref $ "refs/remotes/origin/" <> fromRef' name  {- Does origin/git-annex exist? -} hasOrigin :: Annex Bool@@ -114,7 +114,11 @@   where 	go True = do 		inRepo $ Git.Command.run-			[Param "branch", Param $ fromRef name, Param $ fromRef originname]+			[ Param "branch"+			, Param "--no-track"+			, Param $ fromRef name+			, Param $ fromRef originname+			] 		fromMaybe (error $ "failed to create " ++ fromRef name) 			<$> branchsha 	go False = withIndex' True $ do@@ -414,7 +418,9 @@  branchFiles' :: Git.Repo -> IO ([RawFilePath], IO Bool) branchFiles' = Git.Command.pipeNullSplit' $-	lsTreeParams Git.LsTree.LsTreeRecursive fullname [Param "--name-only"]+	lsTreeParams Git.LsTree.LsTreeRecursive (Git.LsTree.LsTreeLong False)+		fullname+		[Param "--name-only"]  {- Populates the branch's index file with the current branch contents.  - 
Annex/CatFile.hs view
@@ -133,10 +133,12 @@  {- From ref to a symlink or a pointer file, get the key. -} catKey :: Ref -> Annex (Maybe Key)-catKey ref = catKey' ref =<< catObjectMetaData ref+catKey ref = catObjectMetaData ref >>= \case+	Just (_, sz, _) -> catKey' ref sz+	Nothing -> return Nothing -catKey' :: Ref -> Maybe (Sha, Integer, ObjectType) -> Annex (Maybe Key)-catKey' ref (Just (_, sz, _))+catKey' :: Ref -> FileSize -> Annex (Maybe Key)+catKey' ref sz 	-- Avoid catting large files, that cannot be symlinks or 	-- pointer files, which would require buffering their 	-- content in memory, as well as a lot of IO.
Annex/Init.hs view
@@ -128,10 +128,14 @@ 	setDifferences 	unlessM (isJust <$> getVersion) $ 		setVersion (fromMaybe defaultVersion mversion)-	configureSmudgeFilter+	supportunlocked <- annexSupportUnlocked <$> Annex.getGitConfig+	if supportunlocked+		then configureSmudgeFilter+		else deconfigureSmudgeFilter 	unlessM isBareRepo $ do-		showSideAction "scanning for unlocked files"-		scanUnlockedFiles+		when supportunlocked $ do+			showSideAction "scanning for unlocked files"+			scanUnlockedFiles 		hookWrite postCheckoutHook 		hookWrite postMergeHook 	AdjustedBranch.checkAdjustedClone >>= \case
Annex/Locations.hs view
@@ -583,7 +583,6 @@ 	esc '/' = "%" 	esc c = S8.singleton c - {- Reverses keyFile, converting a filename fragment (ie, the basename of  - the symlink target) into a key. -} fileKey :: RawFilePath -> Maybe Key
Annex/Path.hs view
@@ -69,7 +69,8 @@ {- Parameters to pass to a git-annex child process to run a subcommand  - with some parameters.  -- - Includes -c values that were passed on the git-annex command line.+ - Includes -c values that were passed on the git-annex command line+ - or due to --debug being enabled.  -} gitAnnexChildProcessParams :: String -> [CommandParam] -> Annex [CommandParam] gitAnnexChildProcessParams subcmd ps = do
Annex/SpecialRemote.hs view
@@ -89,7 +89,7 @@ 			(Just name, Right t) -> whenM (canenable u) $ do 				showSideAction $ "Auto enabling special remote " ++ name 				dummycfg <- liftIO dummyRemoteGitConfig-				tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case+				tryNonAsync (setup t (AutoEnable c) (Just u) Nothing c dummycfg) >>= \case 					Left e -> warning (show e) 					Right (_c, _u) -> 						when (cu /= u) $
Annex/Url.hs view
@@ -19,7 +19,6 @@ 	download', 	exists, 	getUrlInfo,-	U.downloadQuiet, 	U.URLString, 	U.UrlOptions(..), 	U.UrlInfo(..),@@ -82,9 +81,6 @@ 	 	checkallowedaddr = words . annexAllowedIPAddresses <$> Annex.getGitConfig >>= \case 		["all"] -> do-			-- Only allow curl when all are allowed,-			-- as its interface does not allow preventing-			-- it from accessing specific IP addresses. 			curlopts <- map Param . annexWebOptions <$> Annex.getGitConfig 			let urldownloader = if null curlopts 				then U.DownloadWithConduit $@@ -120,6 +116,8 @@ 					"http proxy settings not used due to annex.security.allowed-ip-addresses configuration" 			manager <- liftIO $ U.newManager $  				avoidtimeout settings+			-- Curl is not used, as its interface does not allow+			-- preventing it from accessing specific IP addresses. 			let urldownloader = U.DownloadWithConduit $ 				U.DownloadWithCurlRestricted r 			return (urldownloader, manager)
Annex/WorkTree.hs view
@@ -70,7 +70,7 @@  -   - This is expensive, and so normally the associated files are updated  - incrementally when changes are noticed. So, this only needs to be done- - when initializing/upgrading a v6+ mode repository.+ - when initializing/upgrading repository.  -  - Also, the content for the unlocked file may already be present as  - an annex object. If so, populate the pointer file with it.@@ -82,7 +82,10 @@ 	dropold <- liftIO $ newMVar $  		Database.Keys.runWriter $ 			liftIO . Database.Keys.SQL.dropAllAssociatedFiles-	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive Git.Ref.headRef+	(l, cleanup) <- inRepo $ Git.LsTree.lsTree+		Git.LsTree.LsTreeRecursive+		(Git.LsTree.LsTreeLong False)+		Git.Ref.headRef 	forM_ l $ \i ->  		when (isregfile i) $ 			maybe noop (add dropold i)
Assistant/Threads/ConfigMonitor.hs view
@@ -89,7 +89,7 @@  getConfigs :: Assistant Configs getConfigs = S.fromList . map extract-	<$> liftAnnex (inRepo $ LsTree.lsTreeFiles Annex.Branch.fullname files)+	<$> liftAnnex (inRepo $ LsTree.lsTreeFiles (LsTree.LsTreeLong False) Annex.Branch.fullname files)   where 	files = map (fromRawFilePath . fst) configFilesActions 	extract treeitem = (getTopFilePath $ LsTree.file treeitem, LsTree.sha treeitem)
CHANGELOG view
@@ -1,3 +1,41 @@+git-annex (8.20210330) upstream; urgency=medium++  * Behavior change: When autoenabling special remotes of type S3, weddav,+    or glacier, do not take login credentials from environment variables,+    as the user may not be expecting the autoenable to happen, or may+    have those set for other purposes and not intend git-annex to use them.+  * New annex.supportunlocked config that can be set to false to avoid+    some expensive things needed to support unlocked files, if you do not+    use them.+  * Fix bug importing from a special remote into a subdirectory more than+    one level deep, which generated unusual git trees that could confuse+    git merge.+  * borg: Fix a bug that prevented importing keys of type URL and WORM.+  * borg: Support importing files that are hard linked in the borg backup.+  * export: When a submodule is in the tree to be exported, skip it.+  * import: When the previously exported tree contained a submodule,+    preserve it in the imported tree so it does not get deleted.+  * export --json: Fill in the file field.+  * rmurl: When youtube-dl was used for an url, it no longer needs to be+    prefixed with "yt:" in order to be removed.+  * rmurl: If an url is both used by the web and also claimed by another+    special remote, fix a bug that caused the url to to not be removed.+  * unregisterurl: Fix a bug that caused an url to not be unregistered+    when it is claimed by a special remote other than the web.+  * whereis: Don't include yt: prefix when showing url to content+    retrieved with youtube-dl.+  * webdav: Work around some buggy webdav server behavior involving+    renaming files.+  * Make --debug also enable debugging in child git-annex processes.+  * fsck: When --from is used in combination with --all or similar options,+    do not verify required content, which can't be checked properly when+    operating on keys.+  * Sped up git-annex init in a clone of an existing repository.+  * Improved display of errors when accessing a git http remote fails.+  * Fix build with attoparsec-0.14.++ -- Joey Hess <id@joeyh.name>  Tue, 30 Mar 2021 13:01:17 -0400+ git-annex (8.20210310) upstream; urgency=medium    * When non-annexed files in a tree are exported to a special remote,
CmdLine/Option.hs view
@@ -1,20 +1,25 @@ {- common command-line options  -- - Copyright 2010-2011 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module CmdLine.Option where  import Options.Applicative -import Annex.Common import CmdLine.Usage import CmdLine.GlobalSetter import qualified Annex import Types.Messages import Types.DeferredParse+import Types.GitConfig+import Git.Types (ConfigKey(..))+import Git.Config+import Utility.FileSystemEncoding  -- Global options accepted by both git-annex and git-annex-shell sub-commands. commonGlobalOptions :: [GlobalOption]@@ -39,12 +44,12 @@ 		<> help "allow verbose output (default)" 		<> hidden 		)-	, globalFlag setdebug+	, globalFlag (setdebug True) 		( long "debug" <> short 'd' 		<> help "show debug messages" 		<> hidden 		)-	, globalFlag unsetdebug+	, globalFlag (setdebug False) 		( long "no-debug" 		<> help "don't show debug messages" 		<> hidden@@ -59,5 +64,8 @@ 	setforce v = Annex.changeState $ \s -> s { Annex.force = v } 	setfast v = Annex.changeState $ \s -> s { Annex.fast = v } 	setforcebackend v = Annex.changeState $ \s -> s { Annex.forcebackend = Just v }-	setdebug = Annex.overrideGitConfig $ \c -> c { annexDebug = True }-	unsetdebug = Annex.overrideGitConfig $ \c -> c { annexDebug = False }+	-- Overriding this way, rather than just setting annexDebug+	-- makes the config be passed on to any git-annex child processes.+	setdebug b = Annex.addGitConfigOverride $ decodeBS' $+		debugconfig <> "=" <> boolConfig' b+	(ConfigKey debugconfig) = annexConfig "debug"
CmdLine/Seek.hs view
@@ -279,6 +279,7 @@ 		void Annex.Branch.update 		(l, cleanup) <- inRepo $ LsTree.lsTree 			LsTree.LsTreeRecursive+			(LsTree.LsTreeLong False) 			Annex.Branch.fullname 		let getk f = fmap (,f) (locationLogFileKey config f) 		let discard reader = reader >>= \case@@ -301,7 +302,7 @@ 	runbranchkeys bs = do 		keyaction <- mkkeyaction 		forM_ bs $ \b -> do-			(l, cleanup) <- inRepo $ LsTree.lsTree LsTree.LsTreeRecursive b+			(l, cleanup) <- inRepo $ LsTree.lsTree LsTree.LsTreeRecursive (LsTree.LsTreeLong False) b 			forM_ l $ \i -> catKey (LsTree.sha i) >>= \case 				Just k ->  					let bfp = mkActionItem (BranchFilePath b (LsTree.file i), k)
Command/Add.hs view
@@ -110,7 +110,7 @@ {- Pass file off to git-add. -} startSmall :: AddOptions -> SeekInput -> RawFilePath -> CommandStart startSmall o si file =-	starting "add" (ActionItemWorkTreeFile file) si $+	starting "add" (ActionItemTreeFile file) si $ 		next $ addSmall (checkGitIgnoreOption o) file  addSmall :: CheckGitIgnore -> RawFilePath -> Annex Bool@@ -120,7 +120,7 @@  startSmallOverridden :: AddOptions -> SeekInput -> RawFilePath -> CommandStart startSmallOverridden o si file = -	starting "add" (ActionItemWorkTreeFile file) si $ next $ do+	starting "add" (ActionItemTreeFile file) si $ next $ do 		showNote "adding content to git repository" 		addFile Small (checkGitIgnoreOption o) file @@ -148,7 +148,7 @@ 		Just s  			| not (isRegularFile s) && not (isSymbolicLink s) -> stop 			| otherwise -> -				starting "add" (ActionItemWorkTreeFile file) si $+				starting "add" (ActionItemTreeFile file) si $ 					if isSymbolicLink s 						then next $ addFile Small (checkGitIgnoreOption o) file 						else perform o file addunlockedmatcher@@ -157,13 +157,13 @@ 			Just s | isSymbolicLink s -> fixuplink key 			_ -> add 	fixuplink key = -		starting "add" (ActionItemWorkTreeFile file) si $+		starting "add" (ActionItemTreeFile file) si $ 			addingExistingLink file key $ do 				liftIO $ removeFile (fromRawFilePath file) 				addLink (checkGitIgnoreOption o) file key Nothing 				next $ cleanup key =<< inAnnex key 	fixuppointer key =-		starting "add" (ActionItemWorkTreeFile file) si $+		starting "add" (ActionItemTreeFile file) si $ 			addingExistingLink file key $ do 				Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file) 				next $ addFile Large (checkGitIgnoreOption o) file
Command/Export.hs view
@@ -87,7 +87,7 @@ 		setConfig (remoteAnnexConfig r "tracking-branch") 			(fromRef $ exportTreeish o) 	-	tree <- filterPreferredContent r =<<+	tree <- filterExport r =<< 		fromMaybe (giveup "unknown tree") <$> 		inRepo (Git.Ref.tree (exportTreeish o)) 	@@ -121,8 +121,8 @@  -- | Changes what's exported to the remote. Does not upload any new -- files, but does delete and rename files already exported to the remote.-changeExport :: Remote -> ExportHandle -> PreferredFiltered Git.Ref -> CommandSeek-changeExport r db (PreferredFiltered new) = do+changeExport :: Remote -> ExportHandle -> ExportFiltered Git.Ref -> CommandSeek+changeExport r db (ExportFiltered new) = do 	old <- getExport (uuid r) 	recordExportBeginning (uuid r) new 	@@ -236,12 +236,16 @@ -- -- Once all exported files have reached the remote, updates the -- remote tracking branch.-fillExport :: Remote -> ExportHandle -> PreferredFiltered Git.Ref -> Maybe (RemoteTrackingBranch, Sha) -> Annex Bool-fillExport r db (PreferredFiltered newtree) mtbcommitsha = do-	(l, cleanup) <- inRepo $ Git.LsTree.lsTree Git.LsTree.LsTreeRecursive newtree+fillExport :: Remote -> ExportHandle -> ExportFiltered Git.Ref -> Maybe (RemoteTrackingBranch, Sha) -> Annex Bool+fillExport r db (ExportFiltered newtree) mtbcommitsha = do+	(l, cleanup) <- inRepo $ Git.LsTree.lsTree+		Git.LsTree.LsTreeRecursive+		(Git.LsTree.LsTreeLong False)+		newtree 	cvar <- liftIO $ newMVar (FileUploaded False) 	allfilledvar <- liftIO $ newMVar (AllFilled True)-	commandActions $ map (startExport r db cvar allfilledvar) l+	commandActions $+		map (startExport r db cvar allfilledvar) l 	void $ liftIO $ cleanup 	waitForAllRunningCommandActions @@ -269,7 +273,7 @@ 	loc = mkExportLocation f 	f = getTopFilePath (Git.LsTree.file ti) 	af = AssociatedFile (Just f)-	ai = ActionItemOther (Just (fromRawFilePath f))+	ai = ActionItemTreeFile f 	si = SeekInput [] 	notrecordedpresent ek = (||) 		<$> liftIO (notElem loc <$> getExportedLocation db ek)@@ -331,7 +335,7 @@   where 	loc = mkExportLocation f' 	f' = getTopFilePath f-	ai = ActionItemOther (Just (fromRawFilePath f'))+	ai = ActionItemTreeFile f' 	si = SeekInput []  startUnexport' :: Remote -> ExportHandle -> TopFilePath -> Key -> CommandStart@@ -341,7 +345,7 @@   where 	loc = mkExportLocation f' 	f' = getTopFilePath f-	ai = ActionItemOther (Just (fromRawFilePath f'))+	ai = ActionItemTreeFile f' 	si = SeekInput []  -- Unlike a usual drop from a repository, this does not check that@@ -383,7 +387,7 @@ 	| otherwise = do 		ek <- exportKey sha 		let loc = exportTempName ek-		let ai = ActionItemOther (Just (fromRawFilePath (fromExportLocation loc)))+		let ai = ActionItemTreeFile (fromExportLocation loc) 		let si = SeekInput [] 		starting ("unexport " ++ name r) ai si $ do 			liftIO $ removeExportedLocation db ek oldloc@@ -463,50 +467,59 @@  -- | A value that has been filtered through the remote's preferred content -- expression.-newtype PreferredFiltered t = PreferredFiltered t+newtype ExportFiltered t = ExportFiltered t --- | Filters the tree to files that are preferred content of the remote.+-- | Filters the tree to annexed files that are preferred content of the+-- remote, and also including non-annexed files, but not submodules. ----- A log is written with files that were filtered out, so they can be added--- back in when importing from the remote.-filterPreferredContent :: Remote -> Git.Ref -> Annex (PreferredFiltered Git.Ref)-filterPreferredContent r tree = logExportExcluded (uuid r) $ \logwriter -> do+-- A log is written with tree items that were filtered out, so they can+-- be added back in when importing from the remote.+filterExport :: Remote -> Git.Ref -> Annex (ExportFiltered Git.Ref)+filterExport r tree = logExportExcluded (uuid r) $ \logwriter -> do 	m <- preferredContentMap 	case M.lookup (uuid r) m of-		Just matcher | not (isEmpty matcher) -> do-			PreferredFiltered <$> go matcher logwriter-		_ -> return (PreferredFiltered tree)+		Just matcher | not (isEmpty matcher) ->+			ExportFiltered <$> go (Just matcher) logwriter+		_ -> ExportFiltered <$> go Nothing logwriter   where-	go matcher logwriter = do+	go mmatcher logwriter = do 		g <- Annex.gitRepo 		Git.Tree.adjustTree-			(checkmatcher matcher logwriter)+			(check mmatcher logwriter) 			[] 			(\_old new -> new) 			[] 			tree 			g-	-	checkmatcher matcher logwriter ti@(Git.Tree.TreeItem topf _ sha) =-		catKey sha >>= \case-			Just k -> do-				let mi = MatchingInfo $ ProvidedInfo-					{ providedFilePath = Just $-						-- Match filename relative-						-- to the top of the tree.-						getTopFilePath topf-					, providedKey = Just k-					, providedFileSize = Nothing-					, providedMimeType = Nothing-					, providedMimeEncoding = Nothing-					, providedLinkType = Nothing-					}-				ifM (checkMatcher' matcher mi mempty)-					( return (Just ti)-					, do-						() <- liftIO $ logwriter ti-						return Nothing-					)-			-- Always export non-annexed files.-			Nothing -> return (Just ti) +	check mmatcher logwriter ti@(Git.Tree.TreeItem topf mode sha) =+		case toTreeItemType mode of+			-- Don't export submodule entries.+			Just TreeSubmodule -> excluded+			_ -> case mmatcher of+				Nothing -> return (Just ti)+				Just matcher -> catKey sha >>= \case+					Just k -> checkmatcher matcher k+					-- Always export non-annexed files.+					Nothing -> return (Just ti)+	  where+		excluded = do+			() <- liftIO $ logwriter ti+			return Nothing++		checkmatcher matcher k = do+			let mi = MatchingInfo $ ProvidedInfo+				{ providedFilePath = Just $+					-- Match filename relative+					-- to the top of the tree.+					getTopFilePath topf+				, providedKey = Just k+				, providedFileSize = Nothing+				, providedMimeType = Nothing+				, providedMimeEncoding = Nothing+				, providedLinkType = Nothing+				}+			ifM (checkMatcher' matcher mi mempty)+				( return (Just ti)+				, excluded+				)
Command/Fsck.hs view
@@ -306,25 +306,30 @@ {- Verifies that all repos that are required to contain the content do,  - checking against the location log. -} verifyRequiredContent :: Key -> ActionItem -> Annex Bool-verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = do-	requiredlocs <- S.fromList . M.keys <$> requiredContentMap-	if S.null requiredlocs-		then return True-		else do-			presentlocs <- S.fromList <$> loggedLocations key-			missinglocs <- filterM-				(\u -> isRequiredContent (Just u) S.empty (Just key) afile False)-				(S.toList $ S.difference requiredlocs presentlocs)-			if null missinglocs-				then return True-				else do-					missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs-					warning $-						"** Required content " ++-						decodeBS' (actionItemDesc ai) ++-						" is missing from these repositories:\n" ++-						missingrequired-					return False+verifyRequiredContent key ai@(ActionItemAssociatedFile afile _) = case afile of+	-- Can't be checked if there's no associated file.+	AssociatedFile Nothing -> return True+	AssociatedFile (Just _) -> do+		requiredlocs <- S.fromList . M.keys <$> requiredContentMap+		if S.null requiredlocs+			then return True+			else go requiredlocs+  where+	go requiredlocs = do+		presentlocs <- S.fromList <$> loggedLocations key+		missinglocs <- filterM+			(\u -> isRequiredContent (Just u) S.empty (Just key) afile False)+			(S.toList $ S.difference requiredlocs presentlocs)+		if null missinglocs+			then return True+			else do+				missingrequired <- Remote.prettyPrintUUIDs "missingrequired" missinglocs+				warning $+					"** Required content " +++					decodeBS' (actionItemDesc ai) +++					" is missing from these repositories:\n" +++					missingrequired+				return False verifyRequiredContent _ _ = return True  {- Verifies the associated file records. -}
Command/Import.hs view
@@ -145,7 +145,7 @@ 		, stop 		)   where- 	ai = ActionItemWorkTreeFile destfile+ 	ai = ActionItemTreeFile destfile 	si = SeekInput []  	deletedup k = do
Command/Info.hs view
@@ -589,7 +589,10 @@ getTreeStatInfo :: InfoOptions -> Git.Ref -> Annex (Maybe StatInfo) getTreeStatInfo o r = do 	fast <- Annex.getState Annex.fast-	(ls, cleanup) <- inRepo $ LsTree.lsTree LsTree.LsTreeRecursive r+	(ls, cleanup) <- inRepo $ LsTree.lsTree+		LsTree.LsTreeRecursive+		(LsTree.LsTreeLong False)+		r 	(presentdata, referenceddata, repodata) <- go fast ls initial 	ifM (liftIO cleanup) 		( return $ Just $
Command/ReKey.hs view
@@ -69,7 +69,7 @@ 		| otherwise = starting "rekey" ai si $ 			perform file oldkey newkey -	ai = ActionItemWorkTreeFile file+	ai = ActionItemTreeFile file  perform :: RawFilePath -> Key -> Key -> CommandPerform perform file oldkey newkey = do
Command/RmUrl.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2013-2016 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,7 +9,6 @@  import Command import Logs.Web-import qualified Remote  cmd :: Command cmd = notBareRepo $@@ -55,6 +54,7 @@  cleanup :: String -> Key -> CommandCleanup cleanup url key = do-	r <- Remote.claimingUrl url-	setUrlMissing key (setDownloader' url r)+	-- Remove the url, no matter what downloader.+	forM_ [minBound..maxBound] $ \dl -> +		setUrlMissing key (setDownloader url dl) 	return True
Command/Smudge.hs view
@@ -105,7 +105,10 @@ 		Nothing -> do 			let fileref = Git.Ref.fileRef file 			indexmeta <- catObjectMetaData fileref-			go' b indexmeta =<< catKey' fileref indexmeta+			oldkey <- case indexmeta of+				Just (_, sz, _) -> catKey' fileref sz+				Nothing -> return Nothing+			go' b indexmeta oldkey 	go' b indexmeta oldkey = ifM (shouldAnnex file indexmeta oldkey) 		( do 			-- Before git 2.5, failing to consume all stdin here
Command/Sync.hs view
@@ -854,7 +854,7 @@ 			mtbcommitsha <- Command.Export.getExportCommit r b 			case (mtree, mtbcommitsha) of 				(Just tree, Just _) -> do-					filteredtree <- Command.Export.filterPreferredContent r tree+					filteredtree <- Command.Export.filterExport r tree 					Command.Export.changeExport r db filteredtree 					Command.Export.fillExport r db filteredtree mtbcommitsha 				_ -> nontracking r db@@ -862,7 +862,7 @@ 	nontracking r db = do 		exported <- getExport (Remote.uuid r) 		maybe noop (warnnontracking r exported) currbranch-		fillexport r db (exportedTreeishes exported) Nothing+		nontrackingfillexport r db (exportedTreeishes exported) Nothing 	 	warnnontracking r exported currb = inRepo (Git.Ref.tree currb) >>= \case 		Just currt | not (any (== currt) (exportedTreeishes exported)) ->@@ -876,11 +876,14 @@ 	  where 		gitconfig = show (remoteAnnexConfig r "tracking-branch") -	fillexport _ _ [] _ = return False-	fillexport r db (tree:[]) mtbcommitsha = do-		let filteredtree = Command.Export.PreferredFiltered tree+	nontrackingfillexport _ _ [] _ = return False+	nontrackingfillexport r db (tree:[]) mtbcommitsha = do+		-- The tree was already filtered when it was exported, so+		-- does not need be be filtered again now, when we're only+		-- filling in any files that did not get transferred.+		let filteredtree = Command.Export.ExportFiltered tree 		Command.Export.fillExport r db filteredtree mtbcommitsha-	fillexport r _ _ _ = do+	nontrackingfillexport r _ _ _ = do 		warnExportImportConflict r 		return False 
Command/UnregisterUrl.hs view
@@ -21,5 +21,14 @@  seek :: RegisterUrlOptions -> CommandSeek seek o = case (batchOption o, keyUrlPairs o) of-	(Batch fmt, _) -> commandAction $ startMass setUrlMissing fmt-	(NoBatch, ps) -> withWords (commandAction . start setUrlMissing) ps+	(Batch fmt, _) -> commandAction $ startMass unregisterUrl fmt+	(NoBatch, ps) -> withWords (commandAction . start unregisterUrl) ps++unregisterUrl :: Key -> String -> Annex ()+unregisterUrl key url = do+	-- Remove the url no matter what downloader;+	-- registerurl can set OtherDownloader, and this should also+	-- be able to remove urls added by addurl, which may use+	-- YoutubeDownloader.+	forM_ [minBound..maxBound] $ \dl ->+		setUrlMissing key (setDownloader url dl)
Command/Unused.hs view
@@ -164,7 +164,7 @@  -    This is the fastest one to build and will filter out most keys.  - 2. Bloom filter containing all keys in the diff from the work tree to  -    the index.- - 3. Associated files filter. A v6 unlocked file may have had its content+ - 3. Associated files filter. An unlocked file may have had its content  -    added to the annex (by eg, git diff running the smudge filter),  -    but the new key is not yet staged in the index. But if so, it will   -    have an associated file.
Command/Whereis.hs view
@@ -96,7 +96,7 @@ 			mapM_ (showRemoteUrls remotemap) urls 		Just formatter -> liftIO $ do 			let vs = Command.Find.formatVars key-				(AssociatedFile (actionItemWorkTreeFile ai))+				(AssociatedFile (actionItemFile ai)) 			let showformatted muuid murl = putStr $ 				Utility.Format.format formatter $ 					M.fromList $ vs ++ catMaybes@@ -131,7 +131,8 @@  getRemoteUrls :: Key -> Remote -> Annex [URLString] getRemoteUrls key remote-	| uuid remote == webUUID = getWebUrls key+	| uuid remote == webUUID = +		map (fst . getDownloader) <$> getWebUrls key 	| otherwise = (++) 		<$> askremote 		<*> claimedurls
Creds.hs view
@@ -1,6 +1,6 @@ {- Credentials storage  -- - Copyright 2012-2020 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -25,6 +25,7 @@ import qualified Annex import Types.Creds import Types.RemoteConfig+import Types.Remote (SetupStage(..)) import Annex.SpecialRemote.Config import Annex.Perms import Utility.FileMode@@ -52,21 +53,25 @@  - that. Also caches them locally.  -  - The creds are found from the CredPairStorage storage if not provided,- - so may be provided by an environment variable etc.+ - so may be provided by an environment variable etc. When autoenabling,+ - the user would not expect to provide creds, so none are found.  -  - The remote's configuration should have already had a cipher stored in it  - if that's going to be done, so that the creds can be encrypted using the  - cipher. The EncryptionIsSetup is witness to that being the case.  -} setRemoteCredPair-	:: EncryptionIsSetup+	:: SetupStage+	-> EncryptionIsSetup 	-> ParsedRemoteConfig 	-> RemoteGitConfig 	-> CredPairStorage 	-> Maybe CredPair 	-> Annex RemoteConfig-setRemoteCredPair encsetup pc gc storage mcreds = unparsedRemoteConfig <$>-	setRemoteCredPair' pc encsetup gc storage mcreds+setRemoteCredPair ss encsetup pc gc storage mcreds = case ss of+	AutoEnable _ -> pure (unparsedRemoteConfig pc)+	_ -> unparsedRemoteConfig <$>+		setRemoteCredPair' pc encsetup gc storage mcreds  setRemoteCredPair' 	:: ParsedRemoteConfig
Git/LsTree.hs view
@@ -1,13 +1,14 @@ {- git ls-tree interface  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  module Git.LsTree ( 	TreeItem(..),-	LsTreeMode(..),+	LsTreeRecursive(..),+	LsTreeLong(..), 	lsTree, 	lsTree', 	lsTreeStrict,@@ -38,44 +39,55 @@ 	{ mode :: FileMode 	, typeobj :: S.ByteString 	, sha :: Ref+	, size :: Maybe FileSize 	, file :: TopFilePath+	-- ^ only available when long is used 	} deriving (Show) -data LsTreeMode = LsTreeRecursive | LsTreeNonRecursive+data LsTreeRecursive = LsTreeRecursive | LsTreeNonRecursive +{- Enabling --long also gets the size of tree items.+ - This slows down ls-tree some, since it has to look up the size of each+ - blob.+ -}+data LsTreeLong = LsTreeLong Bool+ {- Lists the contents of a tree, with lazy output. -}-lsTree :: LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)+lsTree :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool) lsTree = lsTree' [] -lsTree' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO ([TreeItem], IO Bool)-lsTree' ps lsmode t repo = do-	(l, cleanup) <- pipeNullSplit (lsTreeParams lsmode t ps) repo-	return (rights (map parseLsTree l), cleanup)+lsTree' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO ([TreeItem], IO Bool)+lsTree' ps recursive long t repo = do+	(l, cleanup) <- pipeNullSplit (lsTreeParams recursive long t ps) repo+	return (rights (map (parseLsTree long) l), cleanup) -lsTreeStrict :: LsTreeMode -> Ref -> Repo -> IO [TreeItem]+lsTreeStrict :: LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem] lsTreeStrict = lsTreeStrict' [] -lsTreeStrict' :: [CommandParam] -> LsTreeMode -> Ref -> Repo -> IO [TreeItem]-lsTreeStrict' ps lsmode t repo = rights . map parseLsTreeStrict-	<$> pipeNullSplitStrict (lsTreeParams lsmode t ps) repo+lsTreeStrict' :: [CommandParam] -> LsTreeRecursive -> LsTreeLong -> Ref -> Repo -> IO [TreeItem]+lsTreeStrict' ps recursive long t repo = rights . map (parseLsTreeStrict long)+	<$> pipeNullSplitStrict (lsTreeParams recursive long t ps) repo -lsTreeParams :: LsTreeMode -> Ref -> [CommandParam] -> [CommandParam]-lsTreeParams lsmode r ps =+lsTreeParams :: LsTreeRecursive -> LsTreeLong -> Ref -> [CommandParam] -> [CommandParam]+lsTreeParams recursive long r ps = 	[ Param "ls-tree" 	, Param "--full-tree" 	, Param "-z"-	] ++ recursiveparams ++ ps +++	] ++ recursiveparams ++ longparams ++ ps ++ 	[ Param "--" 	, File $ fromRef r 	]   where-	recursiveparams = case lsmode of+	recursiveparams = case recursive of 		LsTreeRecursive -> [ Param "-r" ] 		LsTreeNonRecursive -> []+	longparams = case long of+		LsTreeLong True -> [ Param "--long" ]+		LsTreeLong False -> []  {- Lists specified files in a tree. -}-lsTreeFiles :: Ref -> [FilePath] -> Repo -> IO [TreeItem]-lsTreeFiles t fs repo = rights . map (parseLsTree . L.fromStrict)+lsTreeFiles :: LsTreeLong -> Ref -> [FilePath] -> Repo -> IO [TreeItem]+lsTreeFiles long t fs repo = rights . map (parseLsTree long . L.fromStrict) 	<$> pipeNullSplitStrict ps repo   where 	ps =@@ -86,41 +98,54 @@ 		, File $ fromRef t 		] ++ map File fs -parseLsTree :: L.ByteString -> Either String TreeItem-parseLsTree b = case A.parse parserLsTree b of+parseLsTree :: LsTreeLong -> L.ByteString -> Either String TreeItem+parseLsTree long b = case A.parse (parserLsTree long) b of 	A.Done _ r  -> Right r 	A.Fail _ _ err -> Left err -parseLsTreeStrict :: S.ByteString -> Either String TreeItem-parseLsTreeStrict b = go (AS.parse parserLsTree b)+parseLsTreeStrict :: LsTreeLong -> S.ByteString -> Either String TreeItem+parseLsTreeStrict long b = go (AS.parse (parserLsTree long) b)   where 	go (AS.Done _ r) = Right r 	go (AS.Fail _ _ err) = Left err 	go (AS.Partial c) = go (c mempty)  {- Parses a line of ls-tree output, in format:- - mode SP type SP sha TAB file+ -   mode SP type SP sha TAB file+ - Or long format:+ -   mode SP type SP sha SPACES size TAB file  -  - The TAB can also be a space. Git does not use that, but an earlier  - version of formatLsTree did, and this keeps parsing what it output  - working.- -- - (The --long format is not currently supported.) -}-parserLsTree :: A.Parser TreeItem-parserLsTree = TreeItem-	-- mode-	<$> octal-	<* A8.char ' '-	-- type-	<*> A8.takeTill (== ' ')-	<* A8.char ' '-	-- sha-	<*> (Ref <$> A8.takeTill A8.isSpace)-	<* A8.space-	-- file-	<*> (asTopFilePath . Git.Filename.decode <$> A.takeByteString)+ -}+parserLsTree :: LsTreeLong -> A.Parser TreeItem+parserLsTree long = case long of+	LsTreeLong False -> +		startparser <*> pure Nothing <* filesep <*> fileparser+	LsTreeLong True ->+		startparser <* sizesep <*> sizeparser <* filesep <*> fileparser+  where+	startparser = TreeItem+		-- mode+		<$> octal+		<* A8.char ' '+		-- type+		<*> A8.takeTill (== ' ')+		<* A8.char ' '+		-- sha+		<*> (Ref <$> A8.takeTill A8.isSpace) -{- Inverse of parseLsTree -}+	fileparser = asTopFilePath . Git.Filename.decode <$> A.takeByteString++	sizeparser = fmap Just A8.decimal++	filesep = A8.space++	sizesep = A.many1 A8.space++{- Inverse of parseLsTree. Note that the long output format is not+ - generated, so any size information is not included. -} formatLsTree :: TreeItem -> String formatLsTree ti = unwords 	[ showOct (mode ti) ""
Git/Ref.hs view
@@ -84,7 +84,8 @@ fileFromRef :: Ref -> RawFilePath -> Ref fileFromRef r f = let (Ref fr) = fileRef f in Ref (fromRef' r <> fr) -{- Checks if a ref exists. -}+{- Checks if a ref exists. Note that it must be fully qualified,+ - eg refs/heads/master rather than master. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool 	[ Param "show-ref"
Git/Repair.hs view
@@ -351,8 +351,9 @@ verifyTree missing treesha r 	| S.member treesha missing = return False 	| otherwise = do-		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive treesha []) r-		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree) ls+		let nolong = LsTree.LsTreeLong False+		(ls, cleanup) <- pipeNullSplit (LsTree.lsTreeParams LsTree.LsTreeRecursive nolong treesha []) r+		let objshas = mapMaybe (LsTree.sha <$$> eitherToMaybe . LsTree.parseLsTree nolong) ls 		if any (`S.member` missing) objshas 			then do 				void cleanup
Git/Tree.hs view
@@ -55,16 +55,17 @@ 	deriving (Show, Eq, Ord)  {- Gets the Tree for a Ref. -}-getTree :: LsTree.LsTreeMode -> Ref -> Repo -> IO Tree-getTree lstreemode r repo = do-	(l, cleanup) <- lsTreeWithObjects lstreemode r repo+getTree :: LsTree.LsTreeRecursive -> Ref -> Repo -> IO Tree+getTree recursive r repo = do+	(l, cleanup) <- lsTreeWithObjects recursive r repo 	let !t = either (\e -> error ("ls-tree parse error:" ++ e)) id 		(extractTree l) 	void cleanup 	return t -lsTreeWithObjects :: LsTree.LsTreeMode -> Ref -> Repo -> IO ([LsTree.TreeItem], IO Bool)-lsTreeWithObjects = LsTree.lsTree' [Param "-t"]+lsTreeWithObjects :: LsTree.LsTreeRecursive -> Ref -> Repo -> IO ([LsTree.TreeItem], IO Bool)+lsTreeWithObjects recursive = +	LsTree.lsTree' [Param "-t"] recursive (LsTree.LsTreeLong False)  newtype MkTreeHandle = MkTreeHandle CoProcess.CoProcessHandle @@ -135,8 +136,12 @@ treeItemToLsTreeItem :: TreeItem -> LsTree.TreeItem treeItemToLsTreeItem (TreeItem f mode sha) = LsTree.TreeItem 	{ LsTree.mode = mode-	, LsTree.typeobj = fmtObjectType BlobObject+	, LsTree.typeobj = fmtObjectType $ case toTreeItemType mode of+		Just TreeSubmodule -> CommitObject+		Just TreeSubtree -> TreeObject+		_ -> BlobObject 	, LsTree.sha = sha+	, LsTree.size = Nothing 	, LsTree.file = f 	} @@ -240,10 +245,11 @@ 			Just CommitObject -> do 				let ti = TreeItem (LsTree.file i) (LsTree.mode i) (LsTree.sha i) 				v <- adjusttreeitem ti-				let commit = tc $ fromMaybe ti v-				go h wasmodified (commit:c) depth intree is-				where-					tc (TreeItem f m s) = TreeCommit f m s+				case v of+					Nothing -> go h True c depth intree is+					Just (TreeItem f m s) -> +						let commit = TreeCommit f m s+						in go h wasmodified (commit:c) depth intree is 			_ -> error ("unexpected object type \"" ++ decodeBS (LsTree.typeobj i) ++ "\"") 		| otherwise = return (c, wasmodified, i:is) @@ -300,43 +306,44 @@ 	-> Repo 	-> MkTreeHandle 	-> IO Sha-graftTree' subtree graftloc basetree repo hdl = go basetree graftdirs+graftTree' subtree graftloc basetree repo hdl = go basetree subdirs graftdirs    where-	go tsha (topmostgraphdir:restgraphdirs) = do+	go tsha (subdir:restsubdirs) (topmostgraphdir:restgraphdirs) = do 		Tree t <- getTree LsTree.LsTreeNonRecursive tsha repo-		t' <- case partition isabovegraft t of+		let abovegraftpoint i = gitPath i == gitPath subdir+		t' <- case partition abovegraftpoint t of+			-- the graft point is not already in the tree,+			-- so graft it in, keeping the existing tree+			-- content 			([], _) -> do 				graft <- graftin (topmostgraphdir:restgraphdirs) 				return (graft:t)-			-- normally there can only be one matching item-			-- in the tree, but it's theoretically possible-			-- for a git tree to have multiple items with the-			-- same name, so process them all 			(matching, rest) -> do 				newshas <- forM matching $ \case 					RecordedSubTree tloc tsha' _ 						| null restgraphdirs -> return $ 							RecordedSubTree tloc subtree [] 						| otherwise -> do-							tsha'' <- go tsha' restgraphdirs+							tsha'' <- go tsha' restsubdirs restgraphdirs 							return $ RecordedSubTree tloc tsha'' [] 					_ -> graftin (topmostgraphdir:restgraphdirs) 				return (newshas ++ rest) 		mkTree hdl t'-	go _ [] = return subtree--	isabovegraft i = beneathSubTree i graftloc || gitPath i == gitPath graftloc+	go _ _ [] = return subtree+	go _ [] _ = return subtree 	 	graftin t = recordSubTree hdl $ graftin' t 	graftin' [] = RecordedSubTree graftloc subtree [] 	graftin' (d:rest)  		| d == graftloc = graftin' [] 		| otherwise = NewSubTree d [graftin' rest]-	++	subdirs = splitDirectories $ gitPath graftloc+ 	-- For a graftloc of "foo/bar/baz", this generates 	-- ["foo", "foo/bar", "foo/bar/baz"] 	graftdirs = map (asTopFilePath . toInternalGitPath . encodeBS) $-		mkpaths [] $ splitDirectories $ gitPath graftloc+		mkpaths [] subdirs 	mkpaths _ [] = [] 	mkpaths base (d:rest) = (joinPath base </> d) : mkpaths (base ++ [d]) rest 
Logs/ContentIdentifier/Pure.hs view
@@ -17,7 +17,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as L-import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as A8 import Data.ByteString.Builder import Data.List.NonEmpty (NonEmpty(..))
Logs/Export.hs view
@@ -204,5 +204,5 @@ exportExcludedParser :: L.ByteString -> [Git.Tree.TreeItem] exportExcludedParser = map Git.Tree.lsTreeItemToTreeItem 	. rights-	. map Git.LsTree.parseLsTree+	. map (Git.LsTree.parseLsTree (Git.LsTree.LsTreeLong False)) 	. L.split (fromIntegral $ ord '\n')
Logs/Line.hs view
@@ -9,7 +9,7 @@  import Common -import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 (isEndOfLine) import qualified Data.DList as D 
Logs/MapLog.hs view
@@ -24,7 +24,8 @@  import qualified Data.ByteString.Lazy as L import qualified Data.Map.Strict as M-import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.ByteString.Lazy as AL import qualified Data.Attoparsec.ByteString.Char8 as A8 import Data.ByteString.Builder @@ -49,8 +50,8 @@ 	nl = charUtf8 '\n'  parseMapLog :: Ord f => A.Parser f -> A.Parser v -> L.ByteString -> MapLog f v-parseMapLog fieldparser valueparser = fromMaybe M.empty . A.maybeResult -	. A.parse (mapLogParser fieldparser valueparser)+parseMapLog fieldparser valueparser = fromMaybe M.empty . AL.maybeResult +	. AL.parse (mapLogParser fieldparser valueparser)  mapLogParser :: Ord f => A.Parser f -> A.Parser v -> A.Parser (MapLog f v) mapLogParser fieldparser valueparser = M.fromListWith best <$> parseLogLines go
Logs/Remote/Pure.hs view
@@ -27,7 +27,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Map as M import Data.Char-import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.Attoparsec.ByteString as A import Data.ByteString.Builder  calcRemoteConfigMap :: L.ByteString -> M.Map UUID RemoteConfig
Logs/Trust/Pure.hs view
@@ -14,7 +14,7 @@ import Logs.UUIDBased  import qualified Data.ByteString.Lazy as L-import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as A8 import Data.ByteString.Builder 
Logs/UUIDBased.hs view
@@ -41,7 +41,8 @@  import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import qualified Data.Attoparsec.ByteString.Lazy as A+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.ByteString.Lazy as AL import qualified Data.Attoparsec.ByteString.Char8 as A8 import Data.ByteString.Builder import qualified Data.DList as D@@ -63,8 +64,8 @@ parseLogOld = parseLogOldWithUUID . const  parseLogOldWithUUID :: (UUID -> A.Parser a) -> L.ByteString -> Log a-parseLogOldWithUUID parser = fromMaybe M.empty . A.maybeResult-	. A.parse (logParserOld parser)+parseLogOldWithUUID parser = fromMaybe M.empty . AL.maybeResult+	. AL.parse (logParserOld parser)  logParserOld :: (UUID -> A.Parser a) -> A.Parser (Log a) logParserOld parser = M.fromListWith best <$> parseLogLines go
Logs/Web.hs view
@@ -72,14 +72,16 @@  setUrlMissing :: Key -> URLString -> Annex () setUrlMissing key url = do-	config <- Annex.getGitConfig-	addLog (urlLogFile config key)-		=<< logNow InfoMissing (LogInfo (encodeBS url))-	-- If the url was a web url (not OtherDownloader) and none of-	-- the remaining urls for the key are web urls, the key must not-	-- be present in the web.-	when (isweb url) $-		whenM (null . filter isweb <$> getUrls key) $+	-- Avoid making any changes if the url was not registered.+	us <- getUrls key+	when (url `elem` us) $ do+		config <- Annex.getGitConfig+		addLog (urlLogFile config key)+			=<< logNow InfoMissing (LogInfo (encodeBS url))+		-- If the url was a web url and none of the remaining urls+		-- for the key are web urls, the key must not be present+		-- in the web.+		when (isweb url && null (filter isweb $ filter (/= url) us)) $ 			logChange key webUUID InfoMissing   where 	isweb u = case snd (getDownloader u) of@@ -95,6 +97,7 @@ 	Annex.Branch.commit =<< Annex.Branch.commitMessage 	(l, cleanup) <- inRepo $ Git.LsTree.lsTree 		Git.LsTree.LsTreeRecursive+		(Git.LsTree.LsTreeLong False) 		Annex.Branch.fullname 	g <- Annex.gitRepo 	let want = urlLogFileKey . getTopFilePath . Git.LsTree.file@@ -120,7 +123,7 @@ 	s { Annex.tempurls = M.delete key (Annex.tempurls s) }  data Downloader = WebDownloader | YoutubeDownloader | QuviDownloader | OtherDownloader-	deriving (Eq, Show)+	deriving (Eq, Show, Enum, Bounded)  {- To keep track of how an url is downloaded, it's mangled slightly in  - the log, with a prefix indicating when a Downloader is used. -}
Messages.hs view
@@ -83,7 +83,7 @@ showStartKey command key ai si = outputMessage json $ 	encodeBS' command <> " " <> actionItemDesc ai <> " "   where-	json = JSON.start command (actionItemWorkTreeFile ai) (Just key) si+	json = JSON.start command (actionItemFile ai) (Just key) si  showStartOther :: String -> Maybe String -> SeekInput -> Annex () showStartOther command mdesc si = outputMessage json $ encodeBS' $@@ -97,7 +97,7 @@ 	ActionItemKey k -> showStartKey command k ai si 	ActionItemBranchFilePath _ k -> showStartKey command k ai si 	ActionItemFailedTransfer t _ -> showStartKey command (transferKey t) ai si-	ActionItemWorkTreeFile file -> showStart command file si+	ActionItemTreeFile file -> showStart command file si 	ActionItemOther msg -> showStartOther command msg si 	OnlyActionOn _ ai' -> showStartMessage (StartMessage command ai' si) showStartMessage (StartUsualMessages command ai si) = do
Remote/Borg.hs view
@@ -1,10 +1,12 @@ {- Using borg as a remote.  -- - Copyright 2020 Joey Hess <id@joeyh.name>+ - Copyright 2020,2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE OverloadedStrings #-}+ module Remote.Borg (remote) where  import Annex.Common@@ -26,6 +28,7 @@ import Utility.Metered import Logs.Export import qualified Remote.Helper.ThirdPartyPopulated as ThirdPartyPopulated+import Utility.Env  import Data.Either import Text.Read@@ -151,7 +154,7 @@ listImportableContentsM u borgrepo c = prompt $ do 	imported <- getImported u 	ls <- withborglist borgrepo Nothing formatarchivelist $ \as ->-		forM as $ \archivename ->+		forM (filter (not . S.null) as) $ \archivename -> 			case M.lookup archivename imported of 				Just getfast -> return $ Left (archivename, getfast) 				Nothing -> Right <$>@@ -163,6 +166,7 @@ 		else Just . mkimportablecontents <$> mapM (either snd pure) ls   where 	withborglist what addparam format a = do+		environ <- liftIO getEnvironment 		let p = proc "borg" $ toCommand $ catMaybes 			[ Just (Param "list") 			, Just (Param "--format")@@ -171,9 +175,13 @@ 			, addparam 			] 		(Nothing, Just h, Nothing, pid) <- liftIO $ createProcess $ p-			{ std_out = CreatePipe }+			{ std_out = CreatePipe+			-- Run in C locale because the file list can+			-- include some possibly translatable text in the+			-- "extra" field.+			, env = Just (addEntry "LANG" "C" environ)+			} 		l <- liftIO $ map L.toStrict -			. filter (not . L.null)  			. L.split 0  			<$> L.hGetContents h 		let cleanup = liftIO $ do@@ -183,21 +191,31 @@  	formatarchivelist = "{barchive}{NUL}" -	formatfilelist = "{size}{NUL}{path}{NUL}"+	formatfilelist = "{size}{NUL}{path}{NUL}{extra}{NUL}"  	subdir = File <$> getRemoteConfigValue subdirField c -	parsefilelist archivename (bsz:f:rest) = case readMaybe (fromRawFilePath bsz) of+	parsefilelist archivename (bsz:f:extra:rest) = case readMaybe (fromRawFilePath bsz) of 		Nothing -> parsefilelist archivename rest 		Just sz -> 			let loc = genImportLocation archivename f+			-- borg list reports hard links as 0 byte files,+			-- with the extra field set to " link to ".+			-- When the annex object is a hard link to+			-- something else, we'll assume it has not been+			-- modified, since usually git-annex does prevent+			-- this. Since the 0 byte size is not the actual+			-- size,  report the key size instead, when available.+			    (reqsz, retsz) = case extra of+				" link to " -> (Nothing, fromMaybe sz . fromKey keySize)+				_ -> (Just sz, const sz) 			-- This does a little unncessary work to parse the  			-- key, which is then thrown away. But, it lets the 			-- file list be shrank down to only the ones that are 			-- importable keys, so avoids needing to buffer all 			-- the rest of the files in memory.-			in case ThirdPartyPopulated.importKey' loc sz of-				Just _k -> (loc, (borgContentIdentifier, sz))+			in case ThirdPartyPopulated.importKey' loc reqsz of+				Just k -> (loc, (borgContentIdentifier, retsz k)) 					: parsefilelist archivename rest 				Nothing -> parsefilelist archivename rest 	parsefilelist _ _ = []@@ -243,7 +261,7 @@ getImported u = M.unions <$> (mapM go . exportedTreeishes =<< getExport u)   where 	go t = M.fromList . mapMaybe mk-		<$> inRepo (LsTree.lsTreeStrict LsTree.LsTreeNonRecursive t)+		<$> inRepo (LsTree.lsTreeStrict LsTree.LsTreeNonRecursive (LsTree.LsTreeLong False) t) 	 	mk ti 		| toTreeItemType (LsTree.mode ti) == Just TreeSubtree = Just@@ -255,12 +273,12 @@ 		| otherwise = Nothing  	getcontents archivename t = mapMaybe (mkcontents archivename)-		<$> inRepo (LsTree.lsTreeStrict LsTree.LsTreeRecursive t)+		<$> inRepo (LsTree.lsTreeStrict LsTree.LsTreeRecursive (LsTree.LsTreeLong False) t) 	 	mkcontents archivename ti = do 		let f = ThirdPartyPopulated.fromThirdPartyImportLocation $ 			mkImportLocation $ getTopFilePath $ LsTree.file ti-		k <- deserializeKey' (P.takeFileName f)+		k <- fileKey (P.takeFileName f) 		return 			( genImportLocation archivename f 			,
Remote/Git.hs view
@@ -136,7 +136,11 @@ 	if isNothing mu || mu == Just u 		then return (c, u) 		else error "git remote did not have specified uuid"-gitSetup (Enable _) (Just u) _ c _ = do+gitSetup (Enable _) mu _ c _ = enableRemote mu c+gitSetup (AutoEnable _) mu _ c _ = enableRemote mu c++enableRemote :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)+enableRemote (Just u) c = do 	inRepo $ Git.Command.run 		[ Param "remote" 		, Param "add"@@ -144,7 +148,7 @@ 		, Param $ maybe (giveup "no location") fromProposedAccepted (M.lookup locationField c) 		] 	return (c, u)-gitSetup (Enable _) Nothing _ _ _ = error "unable to enable git remote with no specified uuid"+enableRemote Nothing _ = error "unable to enable git remote with no specified uuid"  {- It's assumed to be cheap to read the config of non-URL remotes, so this is  - done each time git-annex is run in a way that uses remotes, unless@@ -256,7 +260,9 @@ 	| haveconfig r = return r -- already read 	| Git.repoIsSsh r = storeUpdatedRemote $ do 		v <- Ssh.onRemote NoConsumeStdin r-			(pipedconfig Git.Config.ConfigList autoinit (Git.repoDescribe r), return (Left $ giveup "configlist failed"))+			( pipedconfig Git.Config.ConfigList autoinit (Git.repoDescribe r)+			, return (Left "configlist failed")+			) 			"configlist" [] configlistfields 		case v of 			Right r'@@ -285,25 +291,32 @@ 				return $ Right r' 			Left l -> do 				warning $ "Unable to parse git config from " ++ configloc-				return $ Left l+				return $ Left (show l)  	geturlconfig = Url.withUrlOptionsPromptingCreds $ \uo -> do+		let url = Git.repoLocation r ++ "/config" 		v <- withTmpFile "git-annex.tmp" $ \tmpfile h -> do 			liftIO $ hClose h-			let url = Git.repoLocation r ++ "/config"-			ifM (liftIO $ Url.downloadQuiet nullMeterUpdate url tmpfile uo)-				( Just <$> pipedconfig Git.Config.ConfigNullList False url "git" [Param "config", Param "--null", Param "--list", Param "--file", File tmpfile]-				, return Nothing-				)+			Url.download' nullMeterUpdate url tmpfile uo >>= \case+				Right () -> pipedconfig Git.Config.ConfigNullList+					False url "git"+					[ Param "config"+					, Param "--null"+					, Param "--list"+					, Param "--file"+					, File tmpfile+					]+				Left err -> return (Left err) 		case v of-			Just (Right r') -> do+			Right r' -> do 				-- Cache when http remote is not bare for 				-- optimisation. 				unless (Git.Config.isBare r') $ 					setremote setRemoteBare False 				return r'-			_ -> do+			Left err -> do 				set_ignore "not usable by git-annex" False+				warning $ url ++ " " ++ err 				return r  	{- Is this remote just not available, or does
Remote/GitLFS.hs view
@@ -150,6 +150,7 @@ 	let failinitunlessforced msg = case ss of 		Init -> unlessM (Annex.getState Annex.force) (giveup msg) 		Enable _ -> noop+		AutoEnable _ -> noop 	case (isEncrypted pc, Git.GCrypt.urlPrefix `isPrefixOf` url) of 		(False, False) -> noop 		(True, True) -> Remote.GCrypt.setGcryptEncryption pc remotename
Remote/Glacier.hs view
@@ -123,7 +123,7 @@ 	(c', encsetup) <- encryptionSetup (c `M.union` defaults) gc 	pc <- either giveup return . parseRemoteConfig c' 		=<< configParser remote c'-	c'' <- setRemoteCredPair encsetup pc gc (AWS.creds u) mcreds+	c'' <- setRemoteCredPair ss encsetup pc gc (AWS.creds u) mcreds 	pc' <- either giveup return . parseRemoteConfig c'' 		=<< configParser remote c'' 	case ss of
Remote/Helper/ExportImport.hs view
@@ -87,11 +87,8 @@ 						| configured pc && encryptionIsEnabled pc -> 							giveup $ "cannot enable both encryption and " ++ fromProposedAccepted configfield 						| otherwise -> cont-					Enable oldc -> do-						oldpc <- parsedRemoteConfig rt oldc-						if configured pc /= configured oldpc-							then giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"-							else cont+					Enable oldc -> enable oldc pc configured configfield cont+					AutoEnable oldc -> enable oldc pc configured configfield cont 				, if configured pc 					then giveup $ fromProposedAccepted configfield ++ " is not supported by this special remote" 					else cont@@ -99,6 +96,12 @@ 		checkconfig exportSupported exportTree exportTreeField $ 			checkconfig importSupported importTree importTreeField $ 				setup rt st mu cp c gc+	+	enable oldc pc configured configfield cont = do+		oldpc <- parsedRemoteConfig rt oldc+		if configured pc /= configured oldpc+			then giveup $ "cannot change " ++ fromProposedAccepted configfield ++ " of existing special remote"+			else cont  -- | Adjust a remote to support exporttree=yes and/or importree=yes. adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote
Remote/Helper/ThirdPartyPopulated.hs view
@@ -47,10 +47,10 @@ -- find only those ImportLocations that are annex object files. -- All other ImportLocations are ignored. importKey :: ImportLocation -> ContentIdentifier -> ByteSize -> MeterUpdate -> Annex (Maybe Key)-importKey loc _cid sz _ = return $ importKey' loc sz+importKey loc _cid sz _ = return $ importKey' loc (Just sz) -importKey' :: ImportLocation -> ByteSize -> Maybe Key-importKey' loc sz = case deserializeKey' f of+importKey' :: ImportLocation -> Maybe ByteSize -> Maybe Key+importKey' loc msz = case fileKey f of 	Just k 		-- Annex objects always are in a subdirectory with the same 		-- name as the filename. If this is not the case for the file@@ -75,11 +75,11 @@ 		-- (eg, wrong data read off disk during backup, or the object 		-- was corrupt in the git-annex repo and that bad object got 		-- backed up), they can fsck the remote.-		| otherwise -> case fromKey keySize k of-			Just sz'+		| otherwise -> case (msz, fromKey keySize k) of+			(Just sz, Just sz') 				| sz' == sz -> Just k 				| otherwise -> Nothing-			Nothing -> Just k+			_ -> Just k 	Nothing -> Nothing   where 	p = fromImportLocation loc
Remote/S3.hs view
@@ -273,7 +273,7 @@ 		(c', encsetup) <- encryptionSetup (c `M.union` defaults) gc 		pc <- either giveup return . parseRemoteConfig c' 			=<< configParser remote c'-		c'' <- setRemoteCredPair encsetup pc gc (AWS.creds u) mcreds+		c'' <- setRemoteCredPair ss encsetup pc gc (AWS.creds u) mcreds 		pc' <- either giveup return . parseRemoteConfig c'' 			=<< configParser remote c'' 		info <- extractS3Info pc'@@ -287,14 +287,14 @@ 		showNote "Internet Archive mode" 		pc <- either giveup return . parseRemoteConfig c 			=<< configParser remote c-		c' <- setRemoteCredPair noEncryptionUsed pc gc (AWS.creds u) mcreds+		c' <- setRemoteCredPair ss noEncryptionUsed pc gc (AWS.creds u) mcreds 		-- Ensure user enters a valid bucket name, since 		-- this determines the name of the archive.org item. 		let validbucket = replace " " "-" $ map toLower $ 			maybe (giveup "specify bucket=") fromProposedAccepted 				(M.lookup bucketField c') 		let archiveconfig = -			-- IA acdepts x-amz-* as an alias for x-archive-*+			-- IA accepts x-amz-* as an alias for x-archive-* 			M.mapKeys (Proposed . replace "x-archive-" "x-amz-" . fromProposedAccepted) $ 			-- encryption does not make sense here 			M.insert encryptionField (Proposed "none") $@@ -1273,11 +1273,8 @@ 	case ss of 		Init -> when (versioning info) $ 			enableversioning (bucket info)-		Enable oldc -> do-			oldpc <- parsedRemoteConfig remote oldc-			oldinfo <- extractS3Info oldpc-			when (versioning info /= versioning oldinfo) $-				giveup "Cannot change versioning= of existing S3 remote."+		Enable oldc -> checkunchanged oldc+		AutoEnable oldc -> checkunchanged oldc   where 	enableversioning b = do #if MIN_VERSION_aws(0,21,1)@@ -1295,6 +1292,12 @@ 			, "It's important you enable versioning before storing anything in the bucket!" 			] #endif++	checkunchanged oldc = do+		oldpc <- parsedRemoteConfig remote oldc+		oldinfo <- extractS3Info oldpc+		when (versioning info /= versioning oldinfo) $+			giveup "Cannot change versioning= of existing S3 remote."  -- If the remote has versioning enabled, but the version ID is for some -- reason not being recorded, it's not safe to perform an action that
Remote/WebDAV.hs view
@@ -128,7 +128,7 @@ 		chunkconfig = getChunkConfig c  webdavSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-webdavSetup _ mu mcreds c gc = do+webdavSetup ss mu mcreds c gc = do 	u <- maybe (liftIO genUUID) return mu 	url <- maybe (giveup "Specify url=") 		(return . fromProposedAccepted)@@ -138,7 +138,7 @@ 	creds <- maybe (getCreds pc gc u) (return . Just) mcreds 	testDav url creds 	gitConfigSpecialRemote u c' [("webdav", "true")]-	c'' <- setRemoteCredPair encsetup pc gc (davCreds u) creds+	c'' <- setRemoteCredPair ss encsetup pc gc (davCreds u) creds 	return (c'', u)  store :: DavHandleVar -> ChunkConfig -> Storer@@ -212,7 +212,7 @@ storeExportDav hdl f k loc p = case exportLocation loc of 	Right dest -> withDavHandle hdl $ \h -> runExport h $ \dav -> do 		reqbody <- liftIO $ httpBodyStorer f p-		storeHelper dav (keyTmpLocation k) dest reqbody+		storeHelper dav (exportTmpLocation loc k) dest reqbody 	Left err -> giveup err  retrieveExportDav :: DavHandleVar -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex ()@@ -247,15 +247,24 @@  renameExportDav :: DavHandleVar -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) renameExportDav hdl _k src dest = case (exportLocation src, exportLocation dest) of-	(Right srcl, Right destl) -> withDavHandle hdl $ \h -> -		-- box.com's DAV endpoint has buggy handling of renames,-		-- so avoid renaming when using it.-		if boxComUrl `isPrefixOf` baseURL h -			then return Nothing-			else runExport h $ \dav -> do-				maybe noop (void . mkColRecursive) (locationParent destl)-				moveDAV (baseURL dav) srcl destl-				return (Just ())+	(Right srcl, Right destl) -> withDavHandle hdl $ \h -> do+		-- Several webdav servers have buggy handing of renames,+		-- and fail to rename in some circumstances.+		-- Since after a failure it's not clear where the file ended+		-- up, recover by deleting both the source and destination.+		-- The file will later be re-uploaded to the destination,+		-- so this deletion is ok.+		let go = runExport h $ \dav -> do+			maybe noop (void . mkColRecursive) (locationParent destl)+			moveDAV (baseURL dav) srcl destl+			return (Just ())+		let recover = do+			void $ runExport h $ \_dav -> safely $+				inLocation srcl delContentM+			void $ runExport h $ \_dav -> safely $+				inLocation destl delContentM+			return Nothing+		catchNonAsync go (const recover) 	(Left err, _) -> giveup err 	(_, Left err) -> giveup err 
Remote/WebDAV/DavLocation.hs view
@@ -62,6 +62,21 @@ keyTmpLocation :: Key -> DavLocation keyTmpLocation = tmpLocation . fromRawFilePath . keyFile +{- Where we store temporary data for a file as it's being exported.+ -+ - This could be just the keyTmpLocation, but when the file is in a+ - subdirectory, the temp file is put in there. Partly this is to keep+ - it close to the final destination; also certian webdav servers+ - seem to be buggy when renaming files from the root into a subdir, + - and so writing to the subdir avoids such problems.+ -}+exportTmpLocation :: ExportLocation -> Key -> DavLocation+exportTmpLocation l k+	| length (splitDirectories p) > 1 = takeDirectory p </> keyTmpLocation k+	| otherwise = keyTmpLocation k+  where+	p = fromRawFilePath (fromExportLocation l)+ tmpLocation :: FilePath -> DavLocation tmpLocation f = "git-annex-webdav-tmp-" ++ f 
Test.hs view
@@ -1495,7 +1495,7 @@ 	conflictor = "conflictor" 	check_is_link f what = do 		git_annex_expectoutput "find" ["--include=*", f] [fromRawFilePath (Git.FilePath.toInternalGitPath (toRawFilePath f))]-		l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles Git.Ref.headRef [f]+		l <- annexeval $ Annex.inRepo $ Git.LsTree.lsTreeFiles (Git.LsTree.LsTreeLong False) Git.Ref.headRef [f] 		all (\i -> Git.Types.toTreeItemType (Git.LsTree.mode i) == Just Git.Types.TreeSymlink) l 			@? (what ++ " " ++ f ++ " lost symlink bit after merge: " ++ show l) 
Types/ActionItem.hs view
@@ -22,7 +22,7 @@ 	| ActionItemKey Key 	| ActionItemBranchFilePath BranchFilePath Key 	| ActionItemFailedTransfer Transfer TransferInfo-	| ActionItemWorkTreeFile RawFilePath+	| ActionItemTreeFile RawFilePath 	| ActionItemOther (Maybe String) 	-- Use to avoid more than one thread concurrently processing the 	-- same Key.@@ -64,7 +64,7 @@ actionItemDesc (ActionItemBranchFilePath bfp _) = descBranchFilePath bfp actionItemDesc (ActionItemFailedTransfer t i) = actionItemDesc $ 	ActionItemAssociatedFile (associatedFile i) (transferKey t)-actionItemDesc (ActionItemWorkTreeFile f) = f+actionItemDesc (ActionItemTreeFile f) = f actionItemDesc (ActionItemOther s) = encodeBS' (fromMaybe "" s) actionItemDesc (OnlyActionOn _ ai) = actionItemDesc ai @@ -73,15 +73,15 @@ actionItemKey (ActionItemKey k) = Just k actionItemKey (ActionItemBranchFilePath _ k) = Just k actionItemKey (ActionItemFailedTransfer t _) = Just (transferKey t)-actionItemKey (ActionItemWorkTreeFile _) = Nothing+actionItemKey (ActionItemTreeFile _) = Nothing actionItemKey (ActionItemOther _) = Nothing actionItemKey (OnlyActionOn _ ai) = actionItemKey ai -actionItemWorkTreeFile :: ActionItem -> Maybe RawFilePath-actionItemWorkTreeFile (ActionItemAssociatedFile (AssociatedFile af) _) = af-actionItemWorkTreeFile (ActionItemWorkTreeFile f) = Just f-actionItemWorkTreeFile (OnlyActionOn _ ai) = actionItemWorkTreeFile ai-actionItemWorkTreeFile _ = Nothing+actionItemFile :: ActionItem -> Maybe RawFilePath+actionItemFile (ActionItemAssociatedFile (AssociatedFile af) _) = af+actionItemFile (ActionItemTreeFile f) = Just f+actionItemFile (OnlyActionOn _ ai) = actionItemFile ai+actionItemFile _ = Nothing  actionItemTransferDirection :: ActionItem -> Maybe Direction actionItemTransferDirection (ActionItemFailedTransfer t _) = Just $
Types/GitConfig.hs view
@@ -128,6 +128,7 @@ 	, annexCommitMode :: CommitMode 	, annexSkipUnknown :: Bool 	, annexAdjustedBranchRefresh :: Integer+	, annexSupportUnlocked :: Bool 	, coreSymlinks :: Bool 	, coreSharedRepository :: SharedRepository 	, receiveDenyCurrentBranch :: DenyCurrentBranch@@ -229,6 +230,7 @@ 		-- parse as bool if it's not a number 		(if getbool "adjustedbranchrefresh" False then 1 else 0) 		(getmayberead (annexConfig "adjustedbranchrefresh"))+	, annexSupportUnlocked = getbool (annexConfig "supportunlocked") True 	, coreSymlinks = getbool "core.symlinks" True 	, coreSharedRepository = getSharedRepository r 	, receiveDenyCurrentBranch = getDenyCurrentBranch r
Types/Remote.hs view
@@ -48,7 +48,7 @@ import Utility.Url import Utility.DataUnits -data SetupStage = Init | Enable RemoteConfig+data SetupStage = Init | Enable RemoteConfig | AutoEnable RemoteConfig  {- There are different types of remotes. -} data RemoteTypeA a = RemoteType@@ -280,7 +280,10 @@ 	, checkPresentExport :: Key -> ExportLocation -> a Bool 	-- Renames an already exported file. 	---	-- If the remote does not support renames, it can return Nothing.+	-- If the remote does not support the requested rename,+	-- it can return Nothing. It's ok if the remove deletes+	-- the file in such a situation too; it will be re-exported to+	-- recover. 	-- 	-- Throws an exception if the remote cannot be accessed, or 	-- the file doesn't exist or cannot be renamed.@@ -393,3 +396,4 @@ 		-> [ContentIdentifier] 		-> a Bool 	}+
Upgrade/V5/Direct.hs view
@@ -70,11 +70,12 @@ 		let orighead = fromDirectBranch currhead 		inRepo (Git.Ref.sha currhead) >>= \case 			Just headsha-				| orighead /= currhead -> do+				| orighead == currhead -> noop+				| otherwise -> do 					inRepo $ Git.Branch.update "leaving direct mode" orighead headsha 					inRepo $ Git.Branch.checkout orighead 					inRepo $ Git.Branch.delete currhead-			_ -> inRepo $ Git.Branch.checkout orighead+			Nothing -> inRepo $ Git.Branch.checkout orighead  {- Absolute FilePaths of Files in the tree that are associated with a key. -} associatedFiles :: Key -> Annex [FilePath]
Utility/Url.hs view
@@ -30,7 +30,6 @@ 	getUrlInfo, 	assumeUrlExists, 	download,-	downloadQuiet, 	downloadConduit, 	sinkResponseFile, 	downloadPartial,@@ -363,11 +362,6 @@  -} download :: MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO (Either String ()) download = download' False--{- Avoids displaying any error message, including silencing curl errors. -}-downloadQuiet :: MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO Bool-downloadQuiet meterupdate url file uo = isRight -	<$> download' True meterupdate url file uo  download' :: Bool -> MeterUpdate -> URLString -> FilePath -> UrlOptions -> IO (Either String ()) download' nocurlerror meterupdate url file uo =
doc/git-annex-expire.mdwn view
@@ -41,8 +41,9 @@   expired. The default is any activity.    Currently, the only activity that can be performed to avoid expiration-  is `git annex fsck`. Note that fscking a remote updates the-  expiration of the remote repository, not the local repository.+  is --activity=Fsck which corresponds to `git annex fsck`. +  Note that fscking a remote updates the expiration of the remote+  repository, not the local repository.    The first version of git-annex that recorded fsck activity was   5.20150405.
doc/git-annex-log.mdwn view
@@ -10,6 +10,8 @@  Displays the location log for the specified file or files, showing each repository they were added to ("+") and removed from ("-").+Note that the location log is for the particular file contents currently at these paths,+not for any different content that was there in earlier commits.  # OPTIONS 
doc/git-annex-rmurl.mdwn view
@@ -10,7 +10,7 @@  Record that the file is no longer available at the url. -Removing the last url will make git-annex no longer treat content as being+Removing the last web url will make git-annex no longer treat content as being present in the web special remote.  # OPTIONS
doc/git-annex-unlock.mdwn view
@@ -20,7 +20,7 @@ and when you commit modifications to the file, the modifications will also be stored in git-annex, with only the pointer file stored in git. -If you use `git add` to add a file, it will be added in unlocked form from+If you use `git add` to add a file to the annex, it will be added in unlocked form from the beginning. This allows workflows where a file starts out unlocked, is modified as necessary, and is locked once it reaches its final version. 
doc/git-annex.mdwn view
@@ -1171,6 +1171,20 @@   And when multiple files in the work tree have the same content, only   one of them gets hard linked to the annex. +* `annex.supportunlocked'++  By default git-annex supports unlocked files as well as locked files,+  so this defaults to true. If set to false, git-annex will only support+  locked files. That will avoid doing the work needed to support unlocked+  files.++  Note that setting this to false does not prevent a repository from+  having unlocked files added to it, and in that case the content of the+  files will not be accessible until they are locked.++  After changing this config, you need to re-run `git-annex init` for it+  to take effect.+ * `annex.resolvemerge`    Set to false to prevent merge conflicts in the checked out branch
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 8.20210310+Version: 8.20210330 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -367,7 +367,7 @@    memory,    deepseq,    split,-   attoparsec,+   attoparsec (>= 0.13.2.2),    concurrent-output (>= 1.10),    QuickCheck (>= 2.10.0),    tasty (>= 0.7),