packages feed

git-annex 8.20210428 → 8.20210621

raw patch · 163 files changed

+1768/−691 lines, 163 files

Files

Annex.hs view
@@ -174,6 +174,7 @@ 	, forcemincopies :: Maybe MinCopies 	, limit :: ExpandableMatcher Annex 	, timelimit :: Maybe (Duration, POSIXTime)+	, sizelimit :: Maybe (TVar Integer) 	, uuiddescmap :: Maybe UUIDDescMap 	, preferredcontentmap :: Maybe (FileMatcherMap Annex) 	, requiredcontentmap :: Maybe (FileMatcherMap Annex)@@ -188,6 +189,7 @@ 	, sentinalstatus :: Maybe SentinalStatus 	, useragent :: Maybe String 	, errcounter :: Integer+	, skippedfiles :: Bool 	, adjustedbranchrefreshcounter :: Integer 	, unusedkeys :: Maybe (S.Set Key) 	, tempurls :: M.Map Key URLString@@ -232,6 +234,7 @@ 		, forcemincopies = Nothing 		, limit = BuildingMatcher [] 		, timelimit = Nothing+		, sizelimit = Nothing 		, uuiddescmap = Nothing 		, preferredcontentmap = Nothing 		, requiredcontentmap = Nothing@@ -246,6 +249,7 @@ 		, sentinalstatus = Nothing 		, useragent = Nothing 		, errcounter = 0+		, skippedfiles = False 		, adjustedbranchrefreshcounter = 0 		, unusedkeys = Nothing 		, tempurls = M.empty
Annex/Branch.hs view
@@ -24,6 +24,7 @@ 	change, 	maybeChange, 	commitMessage,+	createMessage, 	commit, 	forceCommit, 	getBranch,@@ -129,7 +130,8 @@ 			<$> branchsha 	go False = withIndex' True $ do 		cmode <- annexCommitMode <$> Annex.getGitConfig-		inRepo $ Git.Branch.commitAlways cmode "branch created" fullname []+		cmessage <- createMessage+		inRepo $ Git.Branch.commitAlways cmode cmessage fullname [] 	use sha = do 		setIndexSha sha 		return sha@@ -363,6 +365,10 @@ commitMessage :: Annex String commitMessage = fromMaybe "update" . annexCommitMessage <$> Annex.getGitConfig +{- Commit message used when creating the branch. -}+createMessage :: Annex String+createMessage = fromMaybe "branch created" . annexCommitMessage <$> Annex.getGitConfig+ {- Stages the journal, and commits staged changes to the branch. -} commit :: String -> Annex () commit = whenM (journalDirty gitAnnexJournalDir) . forceCommit@@ -678,7 +684,7 @@ 		trustmap <- calcTrustMap <$> getStaged trustLog 		remoteconfigmap <- calcRemoteConfigMap <$> getStaged remoteLog 		-- partially apply, improves performance-		let changers' = map (\c -> c config trustmap remoteconfigmap) changers+		let changers' = map (\c -> c trustmap remoteconfigmap config) changers 		(fs, cleanup) <- branchFiles 		forM_ fs $ \f -> do 			content <- getStaged f
Annex/Branch/Transitions.hs view
@@ -1,13 +1,14 @@ {- git-annex branch transitions  -- - Copyright 2013-2019 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  module Annex.Branch.Transitions ( 	FileTransition(..),-	getTransitionCalculator+	getTransitionCalculator,+	filterBranch, ) where  import Common@@ -36,9 +37,9 @@ 	= ChangeFile Builder 	| PreserveFile -type TransitionCalculator = GitConfig -> TrustMap -> M.Map UUID RemoteConfig -> RawFilePath -> L.ByteString -> FileTransition+type TransitionCalculator = GitConfig -> RawFilePath -> L.ByteString -> FileTransition -getTransitionCalculator :: Transition -> Maybe TransitionCalculator+getTransitionCalculator :: Transition -> Maybe (TrustMap -> M.Map UUID RemoteConfig -> TransitionCalculator) getTransitionCalculator ForgetGitHistory = Nothing getTransitionCalculator ForgetDeadRemotes = Just dropDead @@ -54,36 +55,17 @@ -- the latter uuid, that also needs to be removed. The sameas-uuid -- is not removed from the remote log, for the same reason the trust log -- is not changed.-dropDead :: TransitionCalculator-dropDead gc trustmap remoteconfigmap f content = case getLogVariety gc f of-	Just OldUUIDBasedLog-		| f == trustLog -> PreserveFile-		| f == remoteLog -> ChangeFile $-			Remote.buildRemoteConfigLog $-				M.mapWithKey minimizesameasdead $-					dropDeadFromMapLog trustmap id $-						Remote.parseRemoteConfigLog content-		| otherwise -> ChangeFile $-			UUIDBased.buildLogOld byteString $-				dropDeadFromMapLog trustmap' id $-					UUIDBased.parseLogOld A.takeByteString content-	Just NewUUIDBasedLog -> ChangeFile $-		UUIDBased.buildLogNew byteString $-			dropDeadFromMapLog trustmap' id $-				UUIDBased.parseLogNew A.takeByteString content-	Just (ChunkLog _) -> ChangeFile $-		Chunk.buildLog $ dropDeadFromMapLog trustmap' fst $-			Chunk.parseLog content-	Just (PresenceLog _) -> ChangeFile $ Presence.buildLog $-		Presence.compactLog $-			dropDeadFromPresenceLog trustmap' $-				Presence.parseLog content-	Just RemoteMetaDataLog -> ChangeFile $ MetaData.buildLog $-		dropDeadFromRemoteMetaDataLog trustmap' $-			MetaData.simplifyLog $ MetaData.parseLog content-	Just OtherLog -> PreserveFile-	Nothing -> PreserveFile+dropDead :: TrustMap -> M.Map UUID RemoteConfig -> TransitionCalculator+dropDead trustmap remoteconfigmap gc f content+	| f == trustLog = PreserveFile+	| f == remoteLog = ChangeFile $+		Remote.buildRemoteConfigLog $+			M.mapWithKey minimizesameasdead $+				filterMapLog (notdead trustmap) id $+					Remote.parseRemoteConfigLog content+	| otherwise = filterBranch (notdead trustmap') gc f content   where+	notdead m u = M.findWithDefault def u m /= DeadTrusted 	trustmap' = trustmap `M.union` 		M.map (const DeadTrusted) (M.filter sameasdead remoteconfigmap) 	sameasdead cm =@@ -96,19 +78,37 @@ 		| otherwise = l 	minimizesameasdead' c = M.restrictKeys c (S.singleton sameasUUIDField) -dropDeadFromMapLog :: TrustMap -> (k -> UUID) -> M.Map k v -> M.Map k v-dropDeadFromMapLog trustmap getuuid =-	M.filterWithKey $ \k _v -> notDead trustmap getuuid k+filterBranch :: (UUID -> Bool) -> TransitionCalculator+filterBranch wantuuid gc f content = case getLogVariety gc f of+	Just OldUUIDBasedLog -> ChangeFile $+		UUIDBased.buildLogOld byteString $+			filterMapLog wantuuid id $+				UUIDBased.parseLogOld A.takeByteString content+	Just NewUUIDBasedLog -> ChangeFile $+		UUIDBased.buildLogNew byteString $+			filterMapLog wantuuid id $+				UUIDBased.parseLogNew A.takeByteString content+	Just (ChunkLog _) -> ChangeFile $+		Chunk.buildLog $ filterMapLog wantuuid fst $+			Chunk.parseLog content+	Just (LocationLog _) -> ChangeFile $ Presence.buildLog $+		Presence.compactLog $+			filterLocationLog wantuuid $+				Presence.parseLog content+	Just (UrlLog _) -> PreserveFile+	Just RemoteMetaDataLog -> ChangeFile $ MetaData.buildLog $+		filterRemoteMetaDataLog wantuuid $+			MetaData.simplifyLog $ MetaData.parseLog content+	Just OtherLog -> PreserveFile+	Nothing -> PreserveFile -{- Presence logs can contain UUIDs or other values. Any line that matches- - a dead uuid is dropped; any other values are passed through. -}-dropDeadFromPresenceLog :: TrustMap -> [Presence.LogLine] -> [Presence.LogLine]-dropDeadFromPresenceLog trustmap =-	filter $ notDead trustmap (toUUID . Presence.fromLogInfo . Presence.info)+filterMapLog :: (UUID -> Bool) -> (k -> UUID) -> M.Map k v -> M.Map k v+filterMapLog wantuuid getuuid = M.filterWithKey $ \k _v -> wantuuid (getuuid k) -dropDeadFromRemoteMetaDataLog :: TrustMap -> MetaData.Log MetaData -> MetaData.Log MetaData-dropDeadFromRemoteMetaDataLog trustmap =-	MetaData.filterOutEmpty . MetaData.filterRemoteMetaData (notDead trustmap id)+filterLocationLog :: (UUID -> Bool) -> [Presence.LogLine] -> [Presence.LogLine]+filterLocationLog wantuuid = filter $+	wantuuid . toUUID . Presence.fromLogInfo . Presence.info -notDead :: TrustMap -> (v -> UUID) -> v -> Bool-notDead trustmap a v = M.findWithDefault def (a v) trustmap /= DeadTrusted+filterRemoteMetaDataLog :: (UUID -> Bool) -> MetaData.Log MetaData -> MetaData.Log MetaData+filterRemoteMetaDataLog wantuuid = +	MetaData.filterOutEmpty . MetaData.filterRemoteMetaData wantuuid
Annex/CatFile.hs view
@@ -178,11 +178,11 @@ catKeyFile :: RawFilePath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) 	( catKeyFileHEAD f-	, catKey $ Git.Ref.fileRef f+	, catKey =<< liftIO (Git.Ref.fileRef f) 	)  catKeyFileHEAD :: RawFilePath -> Annex (Maybe Key)-catKeyFileHEAD f = catKey $ Git.Ref.fileFromRef Git.Ref.headRef f+catKeyFileHEAD f = catKey =<< liftIO (Git.Ref.fileFromRef Git.Ref.headRef f)  {- Look in the original branch from whence an adjusted branch is based  - to find the file. But only when the adjustment hides some files. -}@@ -194,5 +194,6 @@  hiddenCat :: (Ref -> Annex (Maybe a)) -> RawFilePath -> CurrBranch -> Annex (Maybe a) hiddenCat a f (Just origbranch, Just adj)-	| adjustmentHidesFiles adj = a (Git.Ref.fileFromRef origbranch f)+	| adjustmentHidesFiles adj = +		a =<< liftIO (Git.Ref.fileFromRef origbranch f) hiddenCat _ _ _ = return Nothing
Annex/Concurrent.hs view
@@ -1,6 +1,6 @@ {- git-annex concurrent state  -- - Copyright 2015-2020 Joey Hess <id@joeyh.name>+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}
Annex/Drop.hs view
@@ -21,14 +21,13 @@ import Annex.Content import Annex.SpecialRemote.Config import qualified Database.Keys-import Git.FilePath  import qualified Data.Set as S  type Reason = String -{- Drop a key from local and/or remote when allowed by the preferred content- - and numcopies settings.+{- Drop a key from local and/or remote when allowed by the preferred content,+ - required content, and numcopies settings.  -  - Skips trying to drop from remotes that are appendonly, since those drops  - would presumably fail. Also skips dropping from exporttree/importtree remotes,@@ -51,12 +50,7 @@  -} handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> SeekInput -> [VerifiedCopy] -> (CommandStart -> CommandCleanup) -> Annex () handleDropsFrom locs rs reason fromhere key afile si preverified runner = do-	g <- Annex.gitRepo-	l <- map (`fromTopFilePath` g)-		<$> Database.Keys.getAssociatedFiles key-	let fs = case afile of-		AssociatedFile (Just f) -> nub (f : l)-		AssociatedFile Nothing -> l+	fs <- Database.Keys.getAssociatedFilesIncluding afile key 	n <- getcopies fs 	void $ if fromhere && checkcopies n Nothing 		then go fs rs n >>= dropl fs@@ -64,11 +58,7 @@   where 	getcopies fs = do 		(untrusted, have) <- trustPartition UnTrusted locs-		(numcopies, mincopies) <- if null fs-			then (,) <$> getNumCopies <*> getMinCopies-			else do-				l <- mapM getFileNumMinCopies fs-				return (maximum $ map fst l, maximum $ map snd l)+		(numcopies, mincopies) <- getSafestNumMinCopies' afile key fs 		return (length have, numcopies, mincopies, S.fromList untrusted)  	{- Check that we have enough copies still to drop the content.@@ -103,16 +93,13 @@ 			dropr fs r n >>= go fs rest 		| otherwise = pure n -	checkdrop fs n u a-		| null fs = check $ -- no associated files; unused content-			wantDrop True u (Just key) (AssociatedFile Nothing)-		| otherwise = check $-			allM (wantDrop True u (Just key) . AssociatedFile . Just) fs-		where-			check c = ifM c-				( dodrop n u a-				, return n-				)+	checkdrop fs n u a =+		let afs = map (AssociatedFile . Just) fs+		    pcc = Command.Drop.PreferredContentChecked True+		in ifM (wantDrop True u (Just key) afile (Just afs))+			( dodrop n u (a pcc)+			, return n+			)  	dodrop n@(have, numcopies, mincopies, _untrusted) u a =  		ifM (safely $ runner $ a numcopies mincopies)@@ -130,12 +117,12 @@ 			, return n 			) -	dropl fs n = checkdrop fs n Nothing $ \numcopies mincopies ->+	dropl fs n = checkdrop fs n Nothing $ \pcc numcopies mincopies -> 		stopUnless (inAnnex key) $-			Command.Drop.startLocal afile ai si numcopies mincopies key preverified+			Command.Drop.startLocal pcc afile ai si numcopies mincopies key preverified -	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies mincopies ->-		Command.Drop.startRemote afile ai si numcopies mincopies key r+	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \pcc numcopies mincopies ->+		Command.Drop.startRemote pcc afile ai si numcopies mincopies key r  	ai = mkActionItem (key, afile)
Annex/Ingest.hs view
@@ -178,9 +178,7 @@  	golocked key mcache s = 		tryNonAsync (moveAnnex key naf (contentLocation source)) >>= \case-			Right True -> do-				populateAssociatedFiles key source restage-				success key mcache s		+			Right True -> success key mcache s		 			Right False -> giveup "failed to add content to annex" 			Left e -> restoreFile (keyFilename source) key e @@ -198,8 +196,8 @@ 		cleanOldKeys (keyFilename source) key 		linkToAnnex key (keyFilename source) (Just cache) >>= \case 			LinkAnnexFailed -> failure "failed to link to annex"-			_ -> do-				finishIngestUnlocked' key source restage+			lar -> do+				finishIngestUnlocked' key source restage (Just lar) 				success key (Just cache) s 	gounlocked _ _ _ = failure "failed statting file" @@ -215,17 +213,23 @@ finishIngestUnlocked :: Key -> KeySource -> Annex () finishIngestUnlocked key source = do 	cleanCruft source-	finishIngestUnlocked' key source (Restage True)+	finishIngestUnlocked' key source (Restage True) Nothing -finishIngestUnlocked' :: Key -> KeySource -> Restage -> Annex ()-finishIngestUnlocked' key source restage = do+finishIngestUnlocked' :: Key -> KeySource -> Restage -> Maybe LinkAnnexResult -> Annex ()+finishIngestUnlocked' key source restage lar = do 	Database.Keys.addAssociatedFile key 		=<< inRepo (toTopFilePath (keyFilename source))-	populateAssociatedFiles key source restage+	populateUnlockedFiles key source restage lar -{- Copy to any other locations using the same key. -}-populateAssociatedFiles :: Key -> KeySource -> Restage -> Annex ()-populateAssociatedFiles key source restage = do+{- Copy to any other unlocked files using the same key.+ -+ - When linkToAnnex did not have to do anything, the object file+ - was already present, and so other unlocked files are already populated,+ - and nothing needs to be done here.+ -}+populateUnlockedFiles :: Key -> KeySource -> Restage -> Maybe LinkAnnexResult -> Annex ()+populateUnlockedFiles _ _ _ (Just LinkAnnexNoop) = return ()+populateUnlockedFiles key source restage _ = do 	obj <- calcRepo (gitAnnexLocation key) 	g <- Annex.gitRepo 	ingestedf <- flip fromTopFilePath g@@ -387,19 +391,10 @@ 			, matchFile = file 			, matchKey = Just key 			}-		-- Provide as much info as we can without access to the-		-- file's content.-		Nothing -> MatchingInfo $ ProvidedInfo-			{ providedFilePath = Just file-			, providedKey = Just key-			, providedFileSize = Nothing-			, providedMimeType = Nothing-			, providedMimeEncoding = Nothing-			, providedLinkType = Nothing-			}+		Nothing -> keyMatchInfoWithoutContent key file 	 	linkunlocked mode = linkFromAnnex key file mode >>= \case-		LinkAnnexFailed -> liftIO $ writepointer mode+		LinkAnnexFailed -> writepointer mode 		_ -> return () 	 	writepointer mode = liftIO $ writePointerFile file key mode
Annex/Init.hs view
@@ -50,8 +50,8 @@ import Annex.Tmp import Utility.UserInfo import qualified Utility.RawFilePath as R-#ifndef mingw32_HOST_OS import Utility.ThreadScheduler+#ifndef mingw32_HOST_OS import Annex.Perms import Utility.FileMode import System.Posix.User@@ -133,9 +133,7 @@ 		then configureSmudgeFilter 		else deconfigureSmudgeFilter 	unlessM isBareRepo $ do-		when supportunlocked $ do-			showSideAction "scanning for unlocked files"-			scanUnlockedFiles+		scanAnnexedFiles True 		hookWrite postCheckoutHook 		hookWrite postMergeHook 	AdjustedBranch.checkAdjustedClone >>= \case
Annex/Link.hs view
@@ -7,7 +7,7 @@  -  - Pointer files are used instead of symlinks for unlocked files.  -- - Copyright 2013-2019 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -294,10 +294,33 @@  {- Checks if a worktree file is a pointer to a key.  -- - Unlocked files whose content is present are not detected by this. -}+ - Unlocked files whose content is present are not detected by this.+ -+ - It's possible, though unlikely, that an annex symlink points to+ - an object that looks like a pointer file. Or that a non-annex+ - symlink does. Avoids a false positive in those cases.+ - -} isPointerFile :: RawFilePath -> IO (Maybe Key)-isPointerFile f = catchDefaultIO Nothing $ withFile (fromRawFilePath f) ReadMode $ \h ->-	parseLinkTargetOrPointer <$> S.hGet h unpaddedMaxPointerSz+isPointerFile f = catchDefaultIO Nothing $+#if defined(mingw32_HOST_OS)+	checkcontentfollowssymlinks -- no symlinks supported on windows+#else+#if MIN_VERSION_unix(2,8,0)+	bracket+		(openFd (fromRawFilePath f) ReadOnly (defaultFileFlags { nofollow = True }) Nothing)+		closeFd+		(\fd -> readhandle =<< fdToHandle fd)+#else+	ifM (isSymbolicLink <$> R.getSymbolicLinkStatus f)+		( return Nothing+		, checkcontentfollowssymlinks+		)+#endif+#endif+  where+	checkcontentfollowssymlinks = +		withFile (fromRawFilePath f) ReadMode readhandle+	readhandle h = parseLinkTargetOrPointer <$> S.hGet h unpaddedMaxPointerSz  {- Checks a symlink target or pointer file first line to see if it  - appears to point to annexed content.
Annex/NumCopies.hs view
@@ -11,7 +11,8 @@ 	module Types.NumCopies, 	module Logs.NumCopies, 	getFileNumMinCopies,-	getAssociatedFileNumMinCopies,+	getSafestNumMinCopies,+	getSafestNumMinCopies', 	getGlobalFileNumCopies, 	getNumCopies, 	getMinCopies,@@ -34,6 +35,8 @@ import qualified Types.Remote as Remote import Annex.Content import Annex.UUID+import Annex.CatFile+import qualified Database.Keys  import Control.Exception import qualified Control.Monad.Catch as M@@ -119,12 +122,48 @@ 					<$> fallbacknum 					<*> fallbackmin -getAssociatedFileNumMinCopies :: AssociatedFile -> Annex (NumCopies, MinCopies)-getAssociatedFileNumMinCopies (AssociatedFile (Just file)) =-	getFileNumMinCopies file-getAssociatedFileNumMinCopies (AssociatedFile Nothing) = (,)-	<$> getNumCopies-	<*> getMinCopies+{- Gets the highest NumCopies and MinCopies value for all files+ - associated with a key. Provide any known associated file;+ - the rest are looked up from the database.+ -+ - Using this when dropping, rather than getFileNumMinCopies+ - avoids dropping one file that has a smaller value violating+ - the value set for another file that uses the same content.+ -}+getSafestNumMinCopies :: AssociatedFile -> Key -> Annex (NumCopies, MinCopies)+getSafestNumMinCopies afile k =+	Database.Keys.getAssociatedFilesIncluding afile k+		>>= getSafestNumMinCopies' afile k++getSafestNumMinCopies' :: AssociatedFile -> Key -> [RawFilePath] -> Annex (NumCopies, MinCopies)+getSafestNumMinCopies' afile k fs = do+	l <- mapM getFileNumMinCopies fs+	let l' = zip l fs+	(,)+		<$> findmax fst l' getNumCopies+		<*> findmax snd l' getMinCopies+  where+	-- Some associated files in the keys database may no longer+	-- correspond to files in the repository.+	-- (But the AssociatedFile passed to this is known to be+	-- an associated file, which may not be in the keys database+	-- yet, so checking it is skipped.)+	stillassociated f+		| AssociatedFile (Just f) == afile = return True+		| otherwise = catKeyFile f >>= \case+			Just k' | k' == k -> return True+			_ -> return False+	+	-- Avoid calling stillassociated on every file; just make sure+	-- that the one with the highest value is still associated.+	findmax _ [] fallback = fallback+	findmax getv l fallback = do+		let n = maximum (map (getv . fst) l)+		let (maxls, l') = partition (\(x, _) -> getv x == n) l+		ifM (anyM stillassociated (map snd maxls))+			( return n+			, findmax getv l' fallback+			)  {- This is the globally visible numcopies value for a file. So it does  - not include local configuration in the git config or command line
Annex/Path.hs view
@@ -1,11 +1,17 @@ {- git-annex program path  -- - Copyright 2013-2020 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} -module Annex.Path where+module Annex.Path (+	programPath,+	readProgramFile,+	gitAnnexChildProcess,+	gitAnnexChildProcessParams,+	gitAnnexDaemonizeParams,+) where  import Annex.Common import Config.Files@@ -13,7 +19,7 @@ import Annex.PidLock import qualified Annex -import System.Environment (getExecutablePath)+import System.Environment (getExecutablePath, getArgs)  {- A fully qualified path to the currently running git-annex program.  - @@ -70,9 +76,24 @@  - with some parameters.  -  - Includes -c values that were passed on the git-annex command line- - or due to --debug being enabled.+ - or due to options like --debug being enabled.  -} gitAnnexChildProcessParams :: String -> [CommandParam] -> Annex [CommandParam] gitAnnexChildProcessParams subcmd ps = do-	cps <- concatMap (\c -> [Param "-c", Param c]) <$> Annex.getGitConfigOverrides+	cps <- gitAnnexGitConfigOverrides 	return (Param subcmd : cps ++ ps)++gitAnnexGitConfigOverrides :: Annex [CommandParam]+gitAnnexGitConfigOverrides = concatMap (\c -> [Param "-c", Param c])+	<$> Annex.getGitConfigOverrides++{- Parameters to pass to git-annex when re-running the current command+ - to daemonize it. Used with Utility.Daemon.daemonize. -}+gitAnnexDaemonizeParams :: Annex [CommandParam]+gitAnnexDaemonizeParams = do+	-- This inclues -c parameters passed to git, as well as ones+	-- passed to git-annex.+	cps <- gitAnnexGitConfigOverrides+	-- Get every parameter git-annex was run with.+	ps <- liftIO getArgs+	return (map Param ps ++ cps)
Annex/Ssh.hs view
@@ -118,9 +118,10 @@ 			ConcurrentPerCpu -> warnnocaching whynocaching 		return (Nothing, []) 	-	warnnocaching whynocaching = do-		warning nocachingwarning-		warning whynocaching+	warnnocaching whynocaching =+		whenM (annexAdviceNoSshCaching <$> Annex.getGitConfig) $ do+			warning nocachingwarning+			warning whynocaching 	 	nocachingwarning = unwords 		[ "You have enabled concurrency, but git-annex is not able"
Annex/Wanted.hs view
@@ -1,6 +1,6 @@ {- git-annex checking whether content is wanted  -- - Copyright 2012 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -10,6 +10,10 @@ import Annex.Common import Logs.PreferredContent import Annex.UUID+import Annex.CatFile+import Git.FilePath+import qualified Database.Keys+import Types.FileMatcher  import qualified Data.Set as S @@ -17,13 +21,55 @@ wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool wantGet d key file = isPreferredContent Nothing S.empty key file d -{- Check if a file is preferred content for a remote. -}+{- Check if a file is preferred content for a repository. -} wantSend :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool wantSend d key file to = isPreferredContent (Just to) S.empty key file d -{- Check if a file can be dropped, maybe from a remote.- - Don't drop files that are preferred content. -}-wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> Annex Bool-wantDrop d from key file = do-	u <- maybe getUUID (return . id) from-	not <$> isPreferredContent (Just u) (S.singleton u) key file d+{- Check if a file is not preferred or required content, and can be+ - dropped. When a UUID is provided, checks for that repository.+ -+ - The AssociatedFile is the one that the user requested to drop.+ - There may be other files that use the same key, and preferred content+ - may match some of those and not others. If any are preferred content,+ - that will prevent dropping. When the other associated files are known,+ - they can be provided, otherwise this looks them up.+ -}+wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex Bool+wantDrop d from key file others =+	isNothing <$> checkDrop isPreferredContent d from key file others++{- Generalization of wantDrop that can also be used with isRequiredContent.+ -+ - When the content should not be dropped, returns Just the file that+ - the checker matches.+ -}+checkDrop :: (Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool) -> Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex (Maybe AssociatedFile)+checkDrop checker d from key file others = do+	u <- maybe getUUID (pure . id) from+	let s = S.singleton u+	let checker' f = checker (Just u) s key f d+	ifM (checker' file)+		( return (Just file)+		, do+			others' <- case others of+				Just afs -> pure (filter (/= file) afs)+				Nothing -> case key of+					Just k ->+						mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))+							=<< Database.Keys.getAssociatedFiles k+					Nothing -> pure []+			l <- filterM checker' others'+			if null l+				then return Nothing+				else checkassociated l+		)+  where+	-- Some associated files that are in the keys database may no+	-- longer correspond to files in the repository, and should+	-- not prevent dropping.+	checkassociated [] = return Nothing+	checkassociated (af@(AssociatedFile (Just f)):fs) =+		catKeyFile f >>= \case+			Just k | Just k == key -> return (Just af)+			_ -> checkassociated fs+	checkassociated (AssociatedFile Nothing:fs) = checkassociated fs
Annex/WorkTree.hs view
@@ -1,6 +1,6 @@ {- git-annex worktree files  -- - Copyright 2013-2020 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -8,6 +8,7 @@ module Annex.WorkTree where  import Annex.Common+import qualified Annex import Annex.Link import Annex.CatFile import Annex.Content@@ -16,15 +17,15 @@ import Annex.InodeSentinal import Utility.InodeCache import Git.FilePath+import Git.CatFile import qualified Git.Ref import qualified Git.LsTree import qualified Git.Types import qualified Database.Keys-import qualified Database.Keys.SQL import Config import qualified Utility.RawFilePath as R -import Control.Concurrent+import qualified Data.ByteString.Lazy as L  {- Looks up the key corresponding to an annexed file in the work tree,  - by examining what the file links to.@@ -66,42 +67,63 @@ ifAnnexed :: RawFilePath -> (Key -> Annex a) -> Annex a -> Annex a ifAnnexed file yes no = maybe no yes =<< lookupKey file -{- Find all unlocked files and update the keys database for them. +{- Find all annexed files and update the keys database for them.  -   - 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 repository.+ - when initializing/upgrading a repository.  -- - Also, the content for the unlocked file may already be present as+ - Also, the content for an unlocked file may already be present as  - an annex object. If so, populate the pointer file with it.  - But if worktree file does not have a pointer file's content, it is left  - as-is.  -}-scanUnlockedFiles :: Annex ()-scanUnlockedFiles = whenM (inRepo Git.Ref.headExists <&&> not <$> isBareRepo) $ do-	dropold <- liftIO $ newMVar $ -		Database.Keys.runWriter $-			liftIO . Database.Keys.SQL.dropAllAssociatedFiles-	(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)-				=<< catKey (Git.LsTree.sha i)-	liftIO $ void cleanup+scanAnnexedFiles :: Bool -> Annex ()+scanAnnexedFiles initscan = do+	-- This gets the keys database populated with all annexed files,+	-- by running Database.Keys.reconcileStaged.+	Database.Keys.runWriter (const noop)+	-- The above tries to populate pointer files, but one thing it+	-- is not able to handle is populating a pointer file when the+	-- annex object file already exists, but its inode is not yet+	-- cached and annex.thin is set. So, the rest of this makes+	-- another pass over the tree to do that.+	whenM+		( pure initscan+		<&&> annexThin <$> Annex.getGitConfig+		<&&> inRepo Git.Ref.headExists+		<&&> not <$> isBareRepo+		) $ do+			g <- Annex.gitRepo+			(l, cleanup) <- inRepo $ Git.LsTree.lsTree+				Git.LsTree.LsTreeRecursive+				(Git.LsTree.LsTreeLong True)+				Git.Ref.headRef+			catObjectStreamLsTree l want g go+			liftIO $ void cleanup   where-	isregfile i = case Git.Types.toTreeItemType (Git.LsTree.mode i) of-		Just Git.Types.TreeFile -> True-		Just Git.Types.TreeExecutable -> True-		_ -> False-	add dropold i k = do-		join $ fromMaybe noop <$> liftIO (tryTakeMVar dropold)+	-- Want to process symlinks, and regular files.+	want i = case Git.Types.toTreeItemType (Git.LsTree.mode i) of+		Just Git.Types.TreeSymlink -> Just (i, False)+		Just Git.Types.TreeFile -> checkfilesize i+		Just Git.Types.TreeExecutable -> checkfilesize i+		_ -> Nothing+	+	-- Avoid processing files that are too large to be pointer files.+	checkfilesize i = case Git.LsTree.size i of+		Just n | n < maxPointerSz -> Just (i, True)+		_ -> Nothing+	+	go getnext = liftIO getnext >>= \case+		Just ((i, isregfile), Just c) -> do+			maybe noop (add i isregfile)+				(parseLinkTargetOrPointer (L.toStrict c))+			go getnext+		_ -> return ()+	+	add i isregfile k = do 		let tf = Git.LsTree.file i-		Database.Keys.runWriter $-			liftIO . Database.Keys.SQL.addAssociatedFileFast k tf-		whenM (inAnnex k) $ do+		whenM (pure isregfile <&&> inAnnex k) $ do 			f <- fromRepo $ fromTopFilePath tf 			liftIO (isPointerFile f) >>= \case 				Just k' | k' == k -> do
Assistant.hs view
@@ -52,9 +52,9 @@ import Annex.Perms import Annex.BranchState import Utility.LogFile+import Annex.Path #ifdef mingw32_HOST_OS import Utility.Env-import Annex.Path import System.Environment (getArgs) #endif import qualified Utility.Debug as Debug@@ -80,7 +80,7 @@ 	createAnnexDirectory (parentDir pidfile) #ifndef mingw32_HOST_OS 	createAnnexDirectory (parentDir logfile)-	logfd <- liftIO $ handleToFd =<< openLog (fromRawFilePath logfile)+	let logfd = handleToFd =<< openLog (fromRawFilePath logfile) 	if foreground 		then do 			origout <- liftIO $ catchMaybeIO $ @@ -92,8 +92,10 @@ 				case startbrowser of 					Nothing -> Nothing 					Just a -> Just $ a origout origerr-		else-			start (Utility.Daemon.daemonize logfd (Just (fromRawFilePath pidfile)) False) Nothing+		else do+			git_annex <- liftIO programPath+			ps <- gitAnnexDaemonizeParams+			start (Utility.Daemon.daemonize git_annex ps logfd (Just (fromRawFilePath pidfile)) False) Nothing #else 	-- Windows doesn't daemonize, but does redirect output to the 	-- log file. The only way to do so is to restart the program.
Benchmark.hs view
@@ -32,9 +32,9 @@ 		forM_ l $ \(cmd, seek, st) -> 			-- The cmd is run for benchmarking without startup or 			-- shutdown actions.-			Annex.eval st $ performCommandAction cmd seek noop+			Annex.eval st $ performCommandAction False cmd seek noop   where-	-- Simplified versio of CmdLine.dispatch, without support for fuzzy+	-- Simplified version of CmdLine.dispatch, without support for fuzzy 	-- matching or out-of-repo commands. 	parsesubcommand ps = do 		(cmd, seek, globalconfig) <- liftIO $ O.handleParseResult $
CHANGELOG view
@@ -1,3 +1,42 @@+git-annex (8.20210621) upstream; urgency=medium++  * New matching options --excludesamecontent and --includesamecontent+  * When two files have the same content, and a required content expression+    matches one but not the other, dropping the latter file will fail as it+    would also remove the content of the required file.+  * drop, move, mirror: When two files have the same content, and+    different numcopies or requiredcopies values, use the higher value.+  * drop --auto: When two files have the same content, and a preferred content+    expression matches one but not the other, do not drop the content.+  * sync --content, assistant: When two unlocked files have the same+    content, and a preferred content expression matches one but not the+    other, do not drop the content. (This was already the case for locked+    files.)+  * sync --content, assistant: Fix an edge case where a file that is not+    preferred content did not get dropped.+  * filter-branch: New command, useful to produce a filtered version of the+    git-annex branch, eg when splitting a repository.+  * fromkey: Create an unlocked file when used in an adjusted branch+    where the file should be unlocked, or when configured by annex.addunlocked.+  * Fix behavior of several commands, including reinject, addurl, and rmurl+    when given an absolute path to an unlocked file, or a relative path+    that leaves and re-enters the repository.+  * smudge: Fix a case where an unlocked annexed file that annex.largefiles+    does not match could get its unchanged content checked into git,+    due to git running the smudge filter unecessarily.+  * reinject: Error out when run on a file that is not annexed, rather+    than silently skipping it.+  * assistant: Fix a crash on startup by avoiding using forkProcess.+  * init: When annex.commitmessage is set, use that message for the commit+    that creates the git-annex branch.+  * Added annex.adviceNoSshCaching config.+  * Added --size-limit option.+  * Future proof activity log parsing.+  * Fix an exponential slowdown when large numbers of duplicate files are+    being added in unlocked form.++ -- Joey Hess <id@joeyh.name>  Mon, 21 Jun 2021 12:17:24 -0400+ git-annex (8.20210428) upstream; urgency=medium    * New annex.private and remote.name.annex-private configs that can
CmdLine.hs view
@@ -62,7 +62,7 @@ 			forM_ fields $ uncurry Annex.setField 			prepRunCommand cmd globalsetter 			startup-			performCommandAction cmd seek $+			performCommandAction True cmd seek $ 				shutdown $ cmdnocommit cmd 	go (Left norepo) = do 		let ingitrepo = \a -> a =<< Git.Config.global
CmdLine/Action.hs view
@@ -1,6 +1,6 @@ {- git-annex command-line actions and concurrency  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -15,9 +15,11 @@ import Annex.WorkerPool import Types.Command import Types.Concurrency+import Annex.Content import Messages.Concurrent import Types.Messages import Types.WorkerPool+import Types.ActionItem import Remote.List  import Control.Concurrent@@ -28,19 +30,32 @@ import qualified System.Console.Regions as Regions  {- Runs a command, starting with the check stage, and then- - the seek stage. Finishes by running the continutation, and - - then showing a count of any failures. -}-performCommandAction :: Command -> CommandSeek -> Annex () -> Annex ()-performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do+ - the seek stage. Finishes by running the continuation.+ -+ - Can exit when there was a problem or when files were skipped.+ - Also shows a count of any failures when that is enabled.+ -}+performCommandAction :: Bool -> Command -> CommandSeek -> Annex () -> Annex ()+performCommandAction canexit (Command { cmdcheck = c, cmdname = name }) seek cont = do 	mapM_ runCheck c 	Annex.changeState $ \s -> s { Annex.errcounter = 0 } 	seek 	finishCommandActions 	cont-	showerrcount =<< Annex.getState Annex.errcounter+	st <- Annex.getState id+	when canexit $ liftIO $ case (Annex.errcounter st, Annex.skippedfiles st) of+		(0, False) -> noop+		(errcnt, False) -> do+			showerrcount errcnt+			exitWith $ ExitFailure 1+		(0, True) -> exitskipped+		(errcnt, True) -> do+			showerrcount errcnt+			exitskipped   where-	showerrcount 0 = noop-	showerrcount cnt = giveup $ name ++ ": " ++ show cnt ++ " failed"+	showerrcount cnt = hPutStrLn stderr $+		name ++ ": " ++ show cnt ++ " failed"+	exitskipped = exitWith $ ExitFailure 101  commandActions :: [CommandStart] -> Annex () commandActions = mapM_ commandAction@@ -55,23 +70,32 @@  - This should only be run in the seek stage.  -} commandAction :: CommandStart -> Annex ()-commandAction start = getConcurrency >>= \case-	NonConcurrent -> runnonconcurrent-	Concurrent n-		| n > 1 -> runconcurrent-		| otherwise -> runnonconcurrent-	ConcurrentPerCpu -> runconcurrent+commandAction start = do+	st <- Annex.getState id+	case getConcurrency' (Annex.concurrency st) of+		NonConcurrent -> runnonconcurrent (Annex.sizelimit st)+		Concurrent n+			| n > 1 -> runconcurrent (Annex.sizelimit st) (Annex.workers st)+			| otherwise -> runnonconcurrent (Annex.sizelimit st)+		ConcurrentPerCpu -> runconcurrent (Annex.sizelimit st) (Annex.workers st)   where-	runnonconcurrent = void $ includeCommandAction start-	runconcurrent = Annex.getState Annex.workers >>= \case-		Nothing -> runnonconcurrent-		Just tv -> -			liftIO (atomically (waitStartWorkerSlot tv)) >>=-				maybe runnonconcurrent (runconcurrent' tv)-	runconcurrent' tv (workerstrd, workerstage) = do+	runnonconcurrent sizelimit = start >>= \case+		Nothing -> noop+		Just (startmsg, perform) -> +			checkSizeLimit sizelimit startmsg $ do+				showStartMessage startmsg+				void $ accountCommandAction startmsg $+					performCommandAction' startmsg perform++	runconcurrent sizelimit Nothing = runnonconcurrent sizelimit+	runconcurrent sizelimit (Just tv) = +		liftIO (atomically (waitStartWorkerSlot tv)) >>= maybe+			(runnonconcurrent sizelimit)+			(runconcurrent' sizelimit tv)+	runconcurrent' sizelimit tv (workerstrd, workerstage) = do 		aid <- liftIO $ async $ snd  			<$> Annex.run workerstrd-				(concurrentjob (fst workerstrd))+				(concurrentjob sizelimit (fst workerstrd)) 		liftIO $ atomically $ do 			pool <- takeTMVar tv 			let !pool' = addWorkerPool (ActiveWorker aid workerstage) pool@@ -87,10 +111,11 @@ 				let !pool' = deactivateWorker pool aid workerstrd' 				putTMVar tv pool' 	-	concurrentjob workerst = start >>= \case+	concurrentjob sizelimit workerst = start >>= \case 		Nothing -> noop 		Just (startmsg, perform) ->-			concurrentjob' workerst startmsg perform+			checkSizeLimit sizelimit startmsg $+				concurrentjob' workerst startmsg perform 	 	concurrentjob' workerst startmsg perform = case mkActionItem startmsg of 		OnlyActionOn k _ -> ensureOnlyActionOn k $@@ -125,7 +150,7 @@ 			Nothing -> do 				showEndMessage startmsg False 				return False-+	 {- Waits for all worker threads to finish and merges their AnnexStates  - back into the current Annex's state.  -}@@ -293,3 +318,30 @@ 					writeTVar tv $! M.insert k mytid m 					return $ liftIO $ atomically $ 						modifyTVar tv $ M.delete k++checkSizeLimit :: Maybe (TVar Integer) -> StartMessage -> Annex () -> Annex ()+checkSizeLimit Nothing _ a = a+checkSizeLimit (Just sizelimitvar) startmsg a =+	case actionItemKey (mkActionItem startmsg) of+		Just k -> case fromKey keySize k of+			Just sz -> go sz+			Nothing -> do+				fsz <- catchMaybeIO $ withObjectLoc k $+					liftIO . getFileSize+				maybe skipped go fsz+		Nothing -> a+  where+	go sz = do+		fits <- liftIO $ atomically $ do+			n <- readTVar sizelimitvar+			let !n' = n - sz+			if n' >= 0+				then do+					writeTVar sizelimitvar n'+					return True+				else return False+		if fits +			then a+			else skipped+	+	skipped = Annex.changeState $ \s -> s { Annex.skippedfiles = True }
CmdLine/GitAnnex.hs view
@@ -68,6 +68,7 @@ import qualified Command.Lock import qualified Command.PreCommit import qualified Command.PostReceive+import qualified Command.FilterBranch import qualified Command.Find import qualified Command.FindRef import qualified Command.Whereis@@ -202,6 +203,7 @@ 	, Command.Unused.cmd 	, Command.DropUnused.cmd 	, Command.AddUnused.cmd+	, Command.FilterBranch.cmd 	, Command.Find.cmd 	, Command.FindRef.cmd 	, Command.Whereis.cmd
CmdLine/GitAnnex/Options.hs view
@@ -12,6 +12,7 @@ import Control.Monad.Fail as Fail (MonadFail(..)) import Options.Applicative import Data.Time.Clock.POSIX+import Control.Concurrent.STM import qualified Data.Map as M  import Annex.Common@@ -37,6 +38,7 @@ import qualified Backend import qualified Types.Backend as Backend import Utility.HumanTime+import Utility.DataUnits import Annex.Concurrent  -- Global options that are accepted by all git-annex sub-commands,@@ -233,11 +235,12 @@ 	, fileMatchingOptions' Limit.LimitAnnexFiles 	, combiningOptions 	, timeLimitOption+	, sizeLimitOption 	]  -- Matching options that can operate on keys as well as files. keyMatchingOptions :: [GlobalOption]-keyMatchingOptions = keyMatchingOptions' ++ combiningOptions ++ timeLimitOption+keyMatchingOptions = keyMatchingOptions' ++ combiningOptions ++ timeLimitOption ++ sizeLimitOption  keyMatchingOptions' :: [GlobalOption] keyMatchingOptions' = @@ -338,6 +341,16 @@ 		<> help "limit to files matching the glob pattern" 		<> hidden 		)+	, globalOption (setAnnexState . Limit.addExcludeSameContent) $ strOption+		( long "excludesamecontent" <> short 'x' <> metavar paramGlob+		<> help "skip files whose content is the same as another file matching the glob pattern"+		<> hidden+		)+	, globalOption (setAnnexState . Limit.addIncludeSameContent) $ strOption+		( long "includesamecontent" <> short 'I' <> metavar paramGlob+		<> help "limit to files whose content is the same as another file matching the glob pattern"+		<> hidden+		) 	, globalOption (setAnnexState . Limit.addLargerThan lb) $ strOption 		( long "largerthan" <> metavar paramSize 		<> help "match files larger than a size"@@ -424,6 +437,19 @@ 		start <- liftIO getPOSIXTime 		let cutoff = start + durationToPOSIXTime duration 		Annex.changeState $ \s -> s { Annex.timelimit = Just (duration, cutoff) }++sizeLimitOption :: [GlobalOption]+sizeLimitOption =+	[ globalOption setsizelimit $ option (maybeReader (readSize dataUnits))+		( long "size-limit" <> metavar paramSize+		<> help "total size of annexed files to process"+		<> hidden+		)+	]+  where+	setsizelimit n = setAnnexState $ do+		v <- liftIO $ newTVarIO n+		Annex.changeState $ \s -> s { Annex.sizelimit = Just v }  data DaemonOptions = DaemonOptions 	{ foregroundDaemonOption :: Bool
Command/Add.hs view
@@ -22,6 +22,8 @@ import Config.GitConfig import Config.Smudge import Utility.OptParse+import Utility.InodeCache+import Annex.InodeSentinal import qualified Utility.RawFilePath as R  cmd :: Command@@ -129,13 +131,23 @@ addFile :: SmallOrLarge -> CheckGitIgnore -> RawFilePath -> Annex Bool addFile smallorlarge ci file = do 	ps <- gitAddParams ci+	cps <- case smallorlarge of+		-- In case the file is being converted from an annexed file+		-- to be stored in git, remove the cached inode, so that+		-- if the smudge clean filter later runs on the file,+		-- it will not remember it was annexed.+		--+		-- The use of bypassSmudgeConfig prevents the smudge+		-- filter from being run. So the changes to the database+		-- can be queued up and not flushed to disk immediately.+		Small -> do+			maybe noop Database.Keys.removeInodeCache+				=<< withTSDelta (liftIO . genInodeCache file)+			return bypassSmudgeConfig+		Large -> return [] 	Annex.Queue.addCommand cps "add" (ps++[Param "--"]) 		[fromRawFilePath file] 	return True-  where-	cps = case smallorlarge of-		Large -> []-		Small -> bypassSmudgeConfig  start :: AddOptions -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart start o si file addunlockedmatcher = do
Command/Drop.hs view
@@ -21,8 +21,6 @@ import Annex.Wanted import Annex.Notification -import qualified Data.Set as S- cmd :: Command cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $ 	command "drop" SectionCommon@@ -86,33 +84,34 @@ start' :: DropOptions -> Maybe Remote -> Key -> AssociatedFile -> ActionItem -> SeekInput -> CommandStart start' o from key afile ai si =  	checkDropAuto (autoMode o) from afile key $ \numcopies mincopies ->-		stopUnless want $+		stopUnless wantdrop $ 			case from of-				Nothing -> startLocal afile ai si numcopies mincopies key []-				Just remote -> startRemote afile ai si numcopies mincopies key remote+				Nothing -> startLocal pcc afile ai si numcopies mincopies key []+				Just remote -> startRemote pcc afile ai si numcopies mincopies key remote   where-	want-		| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile+	wantdrop+		| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile Nothing 		| otherwise = return True+	pcc = PreferredContentChecked (autoMode o)  startKeys :: DropOptions -> Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart startKeys o from (si, key, ai) = start' o from key (AssociatedFile Nothing) ai si -startLocal :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> CommandStart-startLocal afile ai si numcopies mincopies key preverified =+startLocal :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> CommandStart+startLocal pcc afile ai si numcopies mincopies key preverified = 	starting "drop" (OnlyActionOn key ai) si $-		performLocal key afile numcopies mincopies preverified+		performLocal pcc key afile numcopies mincopies preverified -startRemote :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> Remote -> CommandStart-startRemote afile ai si numcopies mincopies key remote = +startRemote :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> Remote -> CommandStart+startRemote pcc afile ai si numcopies mincopies key remote =  	starting ("drop " ++ Remote.name remote) (OnlyActionOn key ai) si $-		performRemote key afile numcopies mincopies remote+		performRemote pcc key afile numcopies mincopies remote -performLocal :: Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> CommandPerform-performLocal key afile numcopies mincopies preverified = lockContentForRemoval key fallback $ \contentlock -> do+performLocal :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> CommandPerform+performLocal pcc key afile numcopies mincopies preverified = lockContentForRemoval key fallback $ \contentlock -> do 	u <- getUUID 	(tocheck, verified) <- verifiableCopies key [u]-	doDrop u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck+	doDrop pcc u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck 		( \proof -> do 			fastDebug "Command.Drop" $ unwords 				[ "Dropping from here"@@ -134,12 +133,12 @@ 	-- to be done except for cleaning up. 	fallback = next $ cleanupLocal key -performRemote :: Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> CommandPerform-performRemote key afile numcopies mincopies remote = do+performRemote :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> CommandPerform+performRemote pcc key afile numcopies mincopies remote = do 	-- Filter the uuid it's being dropped from out of the lists of 	-- places assumed to have the key, and places to check. 	(tocheck, verified) <- verifiableCopies key [uuid]-	doDrop uuid Nothing key afile numcopies mincopies [uuid] verified tocheck+	doDrop pcc uuid Nothing key afile numcopies mincopies [uuid] verified tocheck 		( \proof -> do  			fastDebug "Command.Drop" $ unwords 				[ "Dropping from remote"@@ -169,12 +168,11 @@  - verify that enough copies of a key exist to allow it to be  - safely removed (with no data loss).  -- - Also checks if it's required content, and refuses to drop if so.- -  - --force overrides and always allows dropping.  -} doDrop-	:: UUID+	:: PreferredContentChecked+	-> UUID 	-> Maybe ContentRemovalLock 	-> Key 	-> AssociatedFile@@ -185,10 +183,10 @@ 	-> [UnVerifiedCopy] 	-> (Maybe SafeDropProof -> CommandPerform, CommandPerform) 	-> CommandPerform-doDrop dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) = +doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =  	ifM (Annex.getState Annex.force) 		( dropaction Nothing-		, ifM (checkRequiredContent dropfrom key afile)+		, ifM (checkRequiredContent pcc dropfrom key afile) 			( verifyEnoughCopiesToDrop nolocmsg key  				contentlock numcopies mincopies 				skip preverified check@@ -203,24 +201,33 @@ 		showLongNote "(Use --force to override this check, or adjust numcopies.)" 		a -checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool-checkRequiredContent u k afile =-	ifM (isRequiredContent (Just u) S.empty (Just k) afile False)-		( requiredContent-		, return True-		)+{- Checking preferred content also checks required content, so when+ - auto mode causes preferred content to be checked, it's redundant+ - for checkRequiredContent to separately check required content, and+ - providing this avoids that extra work. -}+newtype PreferredContentChecked = PreferredContentChecked Bool -requiredContent :: Annex Bool-requiredContent = do-	showLongNote "That file is required content, it cannot be dropped!"-	showLongNote "(Use --force to override this check, or adjust required content configuration.)"-	return False+checkRequiredContent :: PreferredContentChecked -> UUID -> Key -> AssociatedFile -> Annex Bool+checkRequiredContent (PreferredContentChecked True) _ _ _ = return True+checkRequiredContent (PreferredContentChecked False) u k afile =+	checkDrop isRequiredContent False (Just u) (Just k) afile Nothing >>= \case+		Nothing -> return True+		Just afile' -> do+			if afile == afile'+				then showLongNote "That file is required content. It cannot be dropped!"+				else showLongNote $ "That file has the same content as another file"+					++ case afile' of+						AssociatedFile (Just f) -> " (" ++ fromRawFilePath f ++ "),"+						AssociatedFile Nothing -> ""+					++ " which is required content. It cannot be dropped!"+			showLongNote "(Use --force to override this check, or adjust required content configuration.)"+			return False  {- In auto mode, only runs the action if there are enough  - copies on other semitrusted repositories. -} checkDropAuto :: Bool -> Maybe Remote -> AssociatedFile -> Key -> (NumCopies -> MinCopies -> CommandStart) -> CommandStart checkDropAuto automode mremote afile key a =-	go =<< getAssociatedFileNumMinCopies afile+	go =<< getSafestNumMinCopies afile key   where 	go (numcopies, mincopies) 		| automode = do
Command/DropUnused.hs view
@@ -49,7 +49,7 @@ perform from numcopies mincopies key = case from of 	Just r -> do 		showAction $ "from " ++ Remote.name r-		Command.Drop.performRemote key (AssociatedFile Nothing) numcopies mincopies r+		Command.Drop.performRemote pcc key (AssociatedFile Nothing) numcopies mincopies r 	Nothing -> ifM (inAnnex key) 		( droplocal 		, ifM (objectFileExists key)@@ -63,7 +63,8 @@ 			) 		)   where-	droplocal = Command.Drop.performLocal key (AssociatedFile Nothing) numcopies mincopies []+	droplocal = Command.Drop.performLocal pcc key (AssociatedFile Nothing) numcopies mincopies []+	pcc = Command.Drop.PreferredContentChecked False  performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform performOther filespec key = do
Command/Expire.hs view
@@ -111,6 +111,6 @@ parseActivity :: MonadFail m => String -> m Activity parseActivity s = case readish s of 	Nothing -> Fail.fail $ "Unknown activity. Choose from: " ++ -		unwords (map show [minBound..maxBound :: Activity])+		unwords (map show allActivities) 	Just v -> return v
+ Command/FilterBranch.hs view
@@ -0,0 +1,194 @@+{- git-annex command+ -+ - Copyright 2021 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Command.FilterBranch where++import Command+import qualified Annex+import qualified Annex.Branch+import Annex.Branch.Transitions (filterBranch, FileTransition(..))+import Annex.HashObject+import Annex.Tmp+import Annex.SpecialRemote.Config+import Types.ProposedAccepted+import Logs+import Logs.Remote+import Git.Types+import Git.FilePath+import Git.Index+import Git.Env+import Git.UpdateIndex+import qualified Git.LsTree as LsTree+import qualified Git.Branch as Git+import Utility.RawFilePath++import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Builder+import qualified System.FilePath.ByteString as P++cmd :: Command+cmd = noMessages $ withGlobalOptions [annexedMatchingOptions] $ +	command "filter-branch" SectionMaintenance +		"filter information from the git-annex branch"+		paramPaths (seek <$$> optParser)++data FilterBranchOptions = FilterBranchOptions+	{ includeFiles :: CmdParams+	, keyOptions :: Maybe KeyOptions+	, keyInformation :: [IncludeExclude (DeferredParse UUID)]+	, repoConfig :: [IncludeExclude (DeferredParse UUID)]+	, includeGlobalConfig :: Bool+	}++optParser :: CmdParamsDesc -> Parser FilterBranchOptions+optParser desc = FilterBranchOptions+	<$> cmdParams desc+	<*> optional parseKeyOptions+	<*> many (parseIncludeExclude "key-information")+	<*> many (parseIncludeExclude "repo-config")+	<*> switch+		( long "include-global-config"+		<> help "include global configuration"+		)++data IncludeExclude t+	= Include t+	| Exclude t+	| IncludeAll+	deriving (Show, Eq, Ord)++isInclude :: IncludeExclude t -> Bool+isInclude (Include _) = True+isInclude IncludeAll = True+isInclude (Exclude _) = False++parseIncludeExclude :: String -> Parser (IncludeExclude (DeferredParse UUID))+parseIncludeExclude s = +	( Include <$> parseRepositoryOption+		("include-" ++ s ++ "-for")+		"include information about a repository"+	) <|>+	( Exclude <$> parseRepositoryOption+		("exclude-" ++ s ++ "-for")+		"exclude information about a repository"+	) <|>+	( flag' IncludeAll +		( long ("include-all-" ++ s)+		<> help "include information about all non-excluded repositories"+		)+	)++parseRepositoryOption :: String -> String -> Parser (DeferredParse UUID)+parseRepositoryOption s h = parseUUIDOption <$> strOption+	( long s+	<> help h+	<> metavar (paramRemote `paramOr` paramDesc `paramOr` paramUUID)+	<> completeRemotes+	)++mkUUIDMatcher :: [IncludeExclude (DeferredParse UUID)] -> Annex (UUID -> Bool)+mkUUIDMatcher l = do+	sameasmap <- M.mapMaybe+		(toUUID . fromProposedAccepted <$$> M.lookup sameasUUIDField)+		<$> remoteConfigMap+	mkUUIDMatcher' sameasmap <$> mapM get l+  where+	get (Include v) = Include <$> getParsed v+	get (Exclude v) = Exclude <$> getParsed v+	get IncludeAll = pure IncludeAll++mkUUIDMatcher' :: M.Map UUID UUID -> [IncludeExclude UUID] -> (UUID -> Bool)+mkUUIDMatcher' sameasmap l = \u -> +	let sameas = M.lookup u sameasmap+	in ( S.member (Include u) includes+		|| S.member IncludeAll includes+		|| maybe False (\u' -> S.member (Include u') includes) sameas+		)+		&& S.notMember (Exclude u) excludes+		&& maybe True (\u' -> S.notMember (Exclude u') excludes) sameas+  where+	(includes, excludes) = (S.partition isInclude (S.fromList l))++seek :: FilterBranchOptions -> CommandSeek+seek o = withOtherTmp $ \tmpdir -> do+	let tmpindex = tmpdir P.</> "index"+	gc <- Annex.getGitConfig+	tmpindexrepo <- Annex.inRepo $ \r ->+		addGitEnv r indexEnv (fromRawFilePath tmpindex)+	withUpdateIndex tmpindexrepo $ \h -> do+		keyinfomatcher <- mkUUIDMatcher (keyInformation o)+		repoconfigmatcher <- mkUUIDMatcher (repoConfig o)++		let addtoindex f sha = liftIO $ streamUpdateIndex' h $+			pureStreamer $ L.fromStrict $ LsTree.formatLsTree $ LsTree.TreeItem+				{ LsTree.mode = fromTreeItemType TreeFile+				, LsTree.typeobj = fmtObjectType BlobObject+				, LsTree.sha = sha+				, LsTree.size = Nothing+				, LsTree.file = asTopFilePath f+				}+		+		let filterbanch matcher f c+			| L.null c = noop+			| otherwise = case filterBranch matcher gc f c of+				ChangeFile builder -> do+					let c' = toLazyByteString builder+					unless (L.null c') $+						addtoindex f =<< hashBlob c'+				-- This could perhaps be optimised by looking+				-- up the sha of the file in the branch.+				PreserveFile -> addtoindex f =<< hashBlob c++		-- Add information for all keys that are being included,+		-- filtering out information for repositories that are not+		-- being included.+		let addkeyinfo k = startingCustomOutput k $ do+			forM_ (keyLogFiles gc k) $ \f ->+				filterbanch keyinfomatcher f+					=<< Annex.Branch.get f+			next (return True)+		let seeker = AnnexedFileSeeker+			{ startAction = \_ _ k -> addkeyinfo k+			, checkContentPresent = Nothing+			, usesLocationLog = True+			}+		-- Avoid the usual default of all files in the current+		-- directory and below, because this command is documented+		-- as only including the information it has explicitly been+		-- told to include.+		when (not (null (includeFiles o)) || isJust (keyOptions o)) $+			withKeyOptions (keyOptions o) False seeker+				(commandAction . \(_, k, _) -> addkeyinfo k)+				(withFilesInGitAnnex ww seeker)+				=<< workTreeItems ww (includeFiles o)+	+		-- Add repository configs for all repositories that are+		-- being included.+		forM_ topLevelUUIDBasedLogs $ \f ->+			filterbanch repoconfigmatcher f+				=<< Annex.Branch.get f++		-- Add global configs when included.+		when (includeGlobalConfig o) $+			forM_ otherTopLevelLogs $ \f -> do+				c <- Annex.Branch.get f+				unless (L.null c) $+					addtoindex f =<< hashBlob c++	-- Commit the temporary index, and output the result.+	t <- liftIO $ Git.writeTree tmpindexrepo+	liftIO $ removeWhenExistsWith removeLink tmpindex+	cmode <- annexCommitMode <$> Annex.getGitConfig+	cmessage <- Annex.Branch.commitMessage+	c <- inRepo $ Git.commitTree cmode cmessage [] t+	liftIO $ putStrLn (fromRef c)+  where+	ww = WarnUnmatchLsFiles
Command/FromKey.hs view
@@ -1,22 +1,23 @@ {- git-annex command  -- - Copyright 2010-2019 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE BangPatterns #-}- module Command.FromKey where  import Command-import qualified Annex.Queue+import qualified Annex+import qualified Database.Keys+import qualified Backend.URL import Annex.Content import Annex.WorkTree import Annex.Perms-import qualified Annex-import qualified Backend.URL-import qualified Utility.RawFilePath as R+import Annex.Link+import Annex.FileMatcher+import Annex.Ingest+import Git.FilePath  import Network.URI @@ -37,16 +38,18 @@ 	<*> parseBatchOption  seek :: FromKeyOptions -> CommandSeek-seek o = case (batchOption o, keyFilePairs o) of-	(Batch fmt, _) -> seekBatch fmt-	-- older way of enabling batch input, does not support BatchNull-	(NoBatch, []) -> seekBatch BatchLine-	(NoBatch, ps) -> do-		force <- Annex.getState Annex.force-		withPairs (commandAction . start force) ps+seek o = do+	matcher <- addUnlockedMatcher+	case (batchOption o, keyFilePairs o) of+		(Batch fmt, _) -> seekBatch matcher fmt+		-- older way of enabling batch input, does not support BatchNull+		(NoBatch, []) -> seekBatch matcher BatchLine+		(NoBatch, ps) -> do+			force <- Annex.getState Annex.force+			withPairs (commandAction . start matcher force) ps -seekBatch :: BatchFormat -> CommandSeek-seekBatch fmt = batchInput fmt parse (commandAction . go)+seekBatch :: AddUnlockedMatcher -> BatchFormat -> CommandSeek+seekBatch matcher fmt = batchInput fmt parse (commandAction . go)   where 	parse s = do 		let (keyname, file) = separate (== ' ') s@@ -59,10 +62,10 @@ 	go (si, (file, key)) =  		let ai = mkActionItem (key, file) 		in starting "fromkey" ai si $-			perform key file+			perform matcher key file -start :: Bool -> (SeekInput, (String, FilePath)) -> CommandStart-start force (si, (keyname, file)) = do+start :: AddUnlockedMatcher -> Bool -> (SeekInput, (String, FilePath)) -> CommandStart+start matcher force (si, (keyname, file)) = do 	let key = keyOpt keyname 	unless force $ do 		inbackend <- inAnnex key@@ -70,7 +73,7 @@ 			"key ("++ keyname ++") is not present in backend (use --force to override this sanity check)" 	let ai = mkActionItem (key, file') 	starting "fromkey" ai si $-		perform key file'+		perform matcher key file'   where 	file' = toRawFilePath file @@ -89,16 +92,32 @@ 		Just k -> k 		Nothing -> giveup $ "bad key/url " ++ s -perform :: Key -> RawFilePath -> CommandPerform-perform key file = lookupKeyNotHidden file >>= \case+perform :: AddUnlockedMatcher -> Key -> RawFilePath -> CommandPerform+perform matcher key file = lookupKeyNotHidden file >>= \case 	Nothing -> ifM (liftIO $ doesFileExist (fromRawFilePath file)) 		( hasothercontent 		, do-			link <- calcRepo $ gitAnnexLink file key+			contentpresent <- inAnnex key+			objectloc <- calcRepo (gitAnnexLocation key)+			let mi = if contentpresent+				then MatchingFile $ FileInfo+					{ contentFile = objectloc+					, matchFile = file+					, matchKey = Just key+					}+				else keyMatchInfoWithoutContent key file 			createWorkTreeDirectory (parentDir file)-			liftIO $ R.createSymbolicLink link file-			Annex.Queue.addCommand [] "add" [Param "--"]-				[fromRawFilePath file]+			ifM (addUnlocked matcher mi contentpresent)+				( do+					stagePointerFile file Nothing =<< hashPointerFile key+					Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)+					if contentpresent+						then linkunlocked+						else writepointer+				, do+					link <- calcRepo $ gitAnnexLink file key+					addAnnexLink link file+				) 			next $ return True 		) 	Just k@@ -108,3 +127,9 @@ 	hasothercontent = do 		warning $ fromRawFilePath file ++ " already exists with different content" 		next $ return False+	+	linkunlocked = linkFromAnnex key file Nothing >>= \case+		LinkAnnexFailed -> writepointer+		_ -> return ()+	+	writepointer = liftIO $ writePointerFile file key Nothing
Command/Lock.hs view
@@ -62,7 +62,7 @@ 	lockdown =<< calcRepo (gitAnnexLocation key) 	addLink (CheckGitIgnore False) file key 		=<< withTSDelta (liftIO . genInodeCache file)-	next $ cleanup file key+	next $ return True   where 	lockdown obj = do 		ifM (isUnmodified key obj)@@ -96,11 +96,6 @@ 			Nothing -> lostcontent  	lostcontent = logStatus key InfoMissing--cleanup :: RawFilePath -> Key -> CommandCleanup-cleanup file key = do-	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)-	return True  errorModified :: a errorModified =  giveup "Locking this file would discard any changes you have made to it. Use 'git annex add' to stage your changes. (Or, use --force to override)"
Command/Migrate.hs view
@@ -86,7 +86,7 @@ 			urls <- getUrls oldkey 			forM_ urls $ \url -> 				setUrlPresent newkey url-			next $ Command.ReKey.cleanup file oldkey newkey+			next $ Command.ReKey.cleanup file newkey 		, giveup "failed creating link from old to new key" 		) 	genkey Nothing = do
Command/Mirror.hs view
@@ -68,8 +68,8 @@ 	ToRemote r -> checkFailedTransferDirection ai Upload $ ifM (inAnnex key) 		( Command.Move.toStart Command.Move.RemoveNever afile key ai si =<< getParsed r 		, do-			(numcopies, mincopies) <- getnummincopies-			Command.Drop.startRemote afile ai si numcopies mincopies key =<< getParsed r+			(numcopies, mincopies) <- getSafestNumMinCopies afile key+			Command.Drop.startRemote pcc afile ai si numcopies mincopies key =<< getParsed r 		) 	FromRemote r -> checkFailedTransferDirection ai Download $ do 		haskey <- flip Remote.hasKey key =<< getParsed r@@ -81,11 +81,9 @@ 				) 			Right False -> ifM (inAnnex key) 				( do-					(numcopies, mincopies) <- getnummincopies-					Command.Drop.startLocal afile ai si numcopies mincopies key []+					(numcopies, mincopies) <- getSafestNumMinCopies afile key+					Command.Drop.startLocal pcc afile ai si numcopies mincopies key [] 				, stop 				)   where-	getnummincopies = case afile of-		AssociatedFile Nothing -> (,) <$> getNumCopies <*> getMinCopies-		AssociatedFile (Just af) -> getFileNumMinCopies af+	pcc = Command.Drop.PreferredContentChecked False
Command/Move.hs view
@@ -166,7 +166,7 @@ 			willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case 				DropAllowed -> drophere setpresentremote contentlock "moved" 				DropCheckNumCopies -> do-					(numcopies, mincopies) <- getAssociatedFileNumMinCopies afile+					(numcopies, mincopies) <- getSafestNumMinCopies afile key 					(tocheck, verified) <- verifiableCopies key [srcuuid] 					verifyEnoughCopiesToDrop "" key (Just contentlock) 						 numcopies mincopies [srcuuid] verified@@ -245,7 +245,7 @@ 		willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case 			DropAllowed -> dropremote "moved" 			DropCheckNumCopies -> do-				(numcopies, mincopies) <- getAssociatedFileNumMinCopies afile+				(numcopies, mincopies) <- getSafestNumMinCopies afile key 				(tocheck, verified) <- verifiableCopies key [Remote.uuid src] 				verifyEnoughCopiesToDrop "" key Nothing numcopies mincopies [Remote.uuid src] verified 					tocheck (dropremote . showproof) faileddropremote@@ -293,7 +293,7 @@  - repository reduces the number of copies, and should fail if  - that would violate numcopies settings.  -- - On the other hand, when the destiation repository does not already+ - On the other hand, when the destination repository does not already  - have a copy of a file, it can be dropped without making numcopies  - worse, so the move is allowed even if numcopies is not met.  -@@ -311,7 +311,7 @@  -} willDropMakeItWorse :: UUID -> UUID -> DestStartedWithCopy -> Key -> AssociatedFile -> Annex DropCheck willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy) key afile =-	ifM (Command.Drop.checkRequiredContent srcuuid key afile)+	ifM (Command.Drop.checkRequiredContent (Command.Drop.PreferredContentChecked False) srcuuid key afile) 		( if deststartedwithcopy 			then unlessforced DropCheckNumCopies 			else ifM checktrustlevel
Command/Multicast.hs view
@@ -108,7 +108,7 @@ 	-- Except for on Windows XP, secp521r1 is supported on all 	-- platforms by uftp. DJB thinks it's pretty good compared 	-- with other NIST curves: "there's one standard NIST curve-	-- using a nice prime, namely 2521−1  but the sheer size of this+	-- using a nice prime, namely 2521-1  but the sheer size of this 	-- prime makes it much slower than NIST P-256" 	-- (http://blog.cr.yp.to/20140323-ecdsa.html) 	-- Since this key is only used to set up the block encryption,
Command/ReKey.hs view
@@ -15,8 +15,6 @@ import Annex.Perms import Annex.ReplaceFile import Logs.Location-import Git.FilePath-import qualified Database.Keys import Annex.InodeSentinal import Utility.InodeCache import qualified Utility.RawFilePath as R@@ -79,7 +77,7 @@ 		, unlessM (Annex.getState Annex.force) $ 			giveup $ fromRawFilePath file ++ " is not available (use --force to override)" 		)-	next $ cleanup file oldkey newkey+	next $ cleanup file newkey  {- Make a hard link to the old key content (when supported),  - to avoid wasting disk space. -}@@ -119,8 +117,8 @@ 					LinkAnnexNoop -> True 	) -cleanup :: RawFilePath -> Key -> Key -> CommandCleanup-cleanup file oldkey newkey = do+cleanup :: RawFilePath -> Key -> CommandCleanup+cleanup file newkey = do 	ifM (isJust <$> isAnnexLink file) 		( do 			-- Update symlink to use the new key.@@ -131,8 +129,6 @@ 			liftIO $ whenM (isJust <$> isPointerFile file) $ 				writePointerFile file newkey mode 			stagePointerFile file mode =<< hashPointerFile newkey-			Database.Keys.removeAssociatedFile oldkey -				=<< inRepo (toTopFilePath file) 		) 	whenM (inAnnex newkey) $ 		logStatus newkey InfoPresent
Command/Reinject.hs view
@@ -44,7 +44,9 @@ startSrcDest ps@(src:dest:[]) 	| src == dest = stop 	| otherwise = notAnnexed src' $-		ifAnnexed (toRawFilePath dest) go stop+		ifAnnexed (toRawFilePath dest) +			go+			(giveup $ src ++ " is not an annexed file")   where 	src' = toRawFilePath src 	go key = starting "reinject" ai si $
Command/RemoteDaemon.hs view
@@ -12,6 +12,7 @@ import Command import RemoteDaemon.Core import Utility.Daemon+import Annex.Path  cmd :: Command cmd = noCommit $@@ -25,8 +26,10 @@ 	| foregroundDaemonOption o = liftIO runInteractive 	| otherwise = do #ifndef mingw32_HOST_OS-		nullfd <- liftIO $ openFd "/dev/null" ReadOnly Nothing defaultFileFlags-		liftIO $ daemonize nullfd Nothing False runNonInteractive+		git_annex <- liftIO programPath+		ps <- gitAnnexDaemonizeParams+		let logfd = openFd "/dev/null" ReadOnly Nothing defaultFileFlags+		liftIO $ daemonize git_annex ps logfd Nothing False runNonInteractive #else 		liftIO $ foreground Nothing runNonInteractive	 #endif
Command/Smudge.hs view
@@ -13,6 +13,7 @@ import Annex.FileMatcher import Annex.Ingest import Annex.CatFile+import Annex.WorkTree import Logs.Smudge import Logs.Location import qualified Database.Keys@@ -103,7 +104,7 @@ 				getMoveRaceRecovery k file 				liftIO $ L.hPut stdout b 		Nothing -> do-			let fileref = Git.Ref.fileRef file+			fileref <- liftIO $ Git.Ref.fileRef file 			indexmeta <- catObjectMetaData fileref 			oldkey <- case indexmeta of 				Just (_, sz, _) -> catKey' fileref sz@@ -168,25 +169,26 @@ 		filepath <- liftIO $ absPath file 		return $ not $ dirContains repopath filepath --- If annex.largefiles is configured, matching files are added to the--- annex. But annex.gitaddtoannex can be set to false to disable that.+-- If annex.largefiles is configured (and not disabled by annex.gitaddtoannex+-- being set to false), matching files are added to the annex and the rest to+-- git. -- -- When annex.largefiles is not configured, files are normally not--- added to the annex, so will be added to git. But some heuristics--- are used to avoid bad behavior:------ If the file is annexed in the index, keep it annexed.--- This prevents accidental conversions.+-- added to the annex, so will be added to git. However, if the file+-- is annexed in the index, keep it annexed. This prevents accidental+-- conversions when previously annexed files get modified and added. ----- Otherwise, when the file's inode is the same as one that was used for--- annexed content before, annex it. This handles cases such as renaming an--- unlocked annexed file followed by git add, which the user naturally--- expects to behave the same as git mv.+-- In either case, if the file's inode is the same as one that was used+-- for annexed content before, annex it. And if the file is not annexed+-- in the index, and has the same content, leave it in git.+-- This handles cases such as renaming a file followed by git add,+-- which the user naturally expects to behave the same as git mv. shouldAnnex :: RawFilePath -> Maybe (Sha, FileSize, ObjectType) -> Maybe Key -> Annex Bool-shouldAnnex file indexmeta moldkey = ifM (annexGitAddToAnnex <$> Annex.getGitConfig)-	( checkunchangedgitfile $ checkmatcher checkheuristics-	, checkunchangedgitfile checkheuristics-	)+shouldAnnex file indexmeta moldkey = do+	ifM (annexGitAddToAnnex <$> Annex.getGitConfig)+		( checkunchanged $ checkmatcher checkwasannexed+		, checkunchanged checkwasannexed+		)   where 	checkmatcher d 		| dotfile file = ifM (getGitConfigVal annexDotFiles)@@ -199,14 +201,21 @@ 			matcher <- largeFilesMatcher 			checkFileMatcher' matcher file d 	-	checkheuristics = case moldkey of-		Just _ -> return True-		Nothing -> checkknowninode+	checkwasannexed = pure $ isJust moldkey -	checkknowninode = withTSDelta (liftIO . genInodeCache file) >>= \case+	isknownannexedinode = withTSDelta (liftIO . genInodeCache file) >>= \case 		Nothing -> pure False 		Just ic -> Database.Keys.isInodeKnown ic =<< sentinalStatus +	-- If the inode matches one known used for annexed content,+	-- keep the file annexed. This handles a case where the file+	-- has been annexed before, and the git is running the clean filter+	-- again on it for whatever reason.+	checkunchanged cont = ifM isknownannexedinode+		( return True+		, checkunchangedgitfile cont+		)+ 	-- This checks for a case where the file had been added to git 	-- previously, not to the annex before, and its content is not 	-- changed, but git is running the clean filter again on it@@ -254,6 +263,11 @@  update :: CommandStart update = do+	-- This gets run after a git checkout or merge, so it's a good+	-- point to refresh the keys database for changes to annexed files.+	-- Doing it explicitly here avoids a later pause in the middle of+	-- some other action.+	scanAnnexedFiles False 	updateSmudged (Restage True) 	stop
Command/Unannex.hs view
@@ -14,6 +14,8 @@ import qualified Annex.Queue import Utility.CopyFile import qualified Database.Keys+import Utility.InodeCache+import Annex.InodeSentinal import Git.FilePath import qualified Utility.RawFilePath as R @@ -55,17 +57,19 @@ 		-- for key' (read from the symlink) to differ from key 		-- (cached in git). 		Just key' -> do-			removeassociated+			cleanupdb 			next $ cleanup file key' 		-- If the file is unlocked, it can be unmodified or not and 		-- does not need to be replaced either way. 		Nothing -> do-			removeassociated+			cleanupdb 			next $ return True   where-	removeassociated = +	cleanupdb = do 		Database.Keys.removeAssociatedFile key 			=<< inRepo (toTopFilePath file)+		maybe noop Database.Keys.removeInodeCache+			=<< withTSDelta (liftIO . genInodeCache file)  cleanup :: RawFilePath -> Key -> CommandCleanup cleanup file key = do
Database/Fsck.hs view
@@ -88,7 +88,9 @@ addDb (FsckHandle h _) k = H.queueDb h checkcommit $ 	void $ insertUnique $ Fscked k   where-	-- commit queue after 1000 files or 5 minutes, whichever comes first+	-- Commit queue after 1000 changes or 5 minutes, whichever comes first.+	-- The time based commit allows for an incremental fsck to be+	-- interrupted and not lose much work. 	checkcommit sz lastcommittime 		| sz > 1000 = return True 		| otherwise = do
Database/Keys.hs view
@@ -1,18 +1,20 @@ {- Sqlite database of information about Keys  -- - Copyright 2015-2019 Joey Hess <id@joeyh.name>+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE BangPatterns #-}  module Database.Keys ( 	DbHandle, 	closeDb, 	addAssociatedFile, 	getAssociatedFiles,+	getAssociatedFilesIncluding, 	getAssociatedKey, 	removeAssociatedFile, 	storeInodeCaches,@@ -20,6 +22,7 @@ 	addInodeCaches, 	getInodeCaches, 	removeInodeCaches,+	removeInodeCache, 	isInodeKnown, 	runWriter, ) where@@ -33,7 +36,6 @@ import Annex.Common hiding (delete) import qualified Annex import Annex.LockFile-import Annex.CatFile import Annex.Content.PointerFile import Annex.Link import Utility.InodeCache@@ -43,19 +45,20 @@ import Git.Command import Git.Types import Git.Index+import Git.Sha+import Git.CatFile+import Git.Branch (writeTreeQuiet, update')+import qualified Git.Ref import Config.Smudge import qualified Utility.RawFilePath as R  import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as S8 import qualified System.FilePath.ByteString as P+import Control.Concurrent.Async  {- Runs an action that reads from the database.  -- - If the database doesn't already exist, it's not created; mempty is- - returned instead. This way, when the keys database is not in use,- - there's minimal overhead in checking it.- -  - If the database is already open, any writes are flushed to it, to ensure  - consistency.  -@@ -72,7 +75,7 @@ 		v <- a (SQL.ReadHandle qh) 		return (v, st) 	go DbClosed = do-		st' <- openDb False DbClosed+		st' <- openDb True DbClosed 		v <- case st' of 			(DbOpen qh) -> a (SQL.ReadHandle qh) 			_ -> return mempty@@ -94,7 +97,7 @@ 		v <- a (SQL.WriteHandle qh) 		return (v, st) 	go st = do-		st' <- openDb True st+		st' <- openDb False st 		v <- case st' of 			DbOpen qh -> a (SQL.WriteHandle qh) 			_ -> error "internal"@@ -103,7 +106,7 @@ runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex () runWriterIO a = runWriter (liftIO . a) -{- Opens the database, perhaps creating it if it doesn't exist yet.+{- Opens the database, creating it if it doesn't exist yet.  -  - Multiple readers and writers can have the database open at the same  - time. Database.Handle deals with the concurrency issues.@@ -114,22 +117,21 @@ openDb :: Bool -> DbState -> Annex DbState openDb _ st@(DbOpen _) = return st openDb False DbUnavailable = return DbUnavailable-openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do+openDb forwrite _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do 	dbdir <- fromRepo gitAnnexKeysDb 	let db = dbdir P.</> "db" 	dbexists <- liftIO $ R.doesPathExist db-	case (dbexists, createdb) of-		(True, _) -> open db-		(False, True) -> do+	case dbexists of+		True -> open db+		False -> do 			initDb db SQL.createTables 			open db-		(False, False) -> return DbUnavailable   where-	-- If permissions don't allow opening the database, treat it as if-	-- it does not exist.-	permerr e = case createdb of-		False -> return DbUnavailable-		True -> throwM e+	-- If permissions don't allow opening the database, and it's being+	-- opened for read, treat it as if it does not exist.+	permerr e+		| forwrite = throwM e+		| otherwise = return DbUnavailable 	 	open db = do 		qh <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable@@ -154,6 +156,15 @@ getAssociatedFiles :: Key -> Annex [TopFilePath] getAssociatedFiles = runReaderIO . SQL.getAssociatedFiles +{- Include a known associated file along with any recorded in the database. -}+getAssociatedFilesIncluding :: AssociatedFile -> Key -> Annex [RawFilePath]+getAssociatedFilesIncluding afile k = do+	g <- Annex.gitRepo+	l <- map (`fromTopFilePath` g) <$> getAssociatedFiles k+	return $ case afile of+		AssociatedFile (Just f) -> f : filter (/= f) l+		AssociatedFile Nothing -> l+ {- Gets any keys that are on record as having a particular associated file.  - (Should be one or none but the database doesn't enforce that.) -} getAssociatedKey :: TopFilePath -> Annex [Key]@@ -179,67 +190,118 @@ getInodeCaches :: Key -> Annex [InodeCache] getInodeCaches = runReaderIO . SQL.getInodeCaches +{- Remove all inodes cached for a key. -} removeInodeCaches :: Key -> Annex () removeInodeCaches = runWriterIO . SQL.removeInodeCaches +{- Remove cached inodes, for any key. -}+removeInodeCache :: InodeCache -> Annex ()+removeInodeCache = runWriterIO . SQL.removeInodeCache+ isInodeKnown :: InodeCache -> SentinalStatus -> Annex Bool isInodeKnown i s = or <$> runReaderIO ((:[]) <$$> SQL.isInodeKnown i s) -{- Looks at staged changes to find when unlocked files are copied/moved,- - and updates associated files in the keys database.- -- - Since staged changes can be dropped later, does not remove any- - associated files; only adds new associated files.+{- Looks at staged changes to annexed files, and updates the keys database,+ - so that its information is consistent with the state of the repository.  -- - This needs to be run before querying the keys database so that- - information is consistent with the state of the repository.+ - This is run with a lock held, so only one process can be running this at+ - a time.  -  - To avoid unncessary work, the index file is statted, and if it's not  - changed since last time this was run, nothing is done.  -- - Note that this is run with a lock held, so only one process can be- - running this at a time.+ - A tree is generated from the index, and the diff between that tree+ - and the last processed tree is examined for changes.  -  - This also cleans up after a race between eg a git mv and git-annex- - get/drop/similar. If git moves the file between this being run and the- - get/drop, the moved file won't be updated for the get/drop. + - get/drop/similar. If git moves a pointer file between this being run and the+ - get/drop, the moved pointer file won't be updated for the get/drop.   - The next time this runs, it will see the staged change. It then checks- - if the worktree file's content availability does not match the git-annex- - content availablity, and makes changes as necessary to reconcile them.+ - if the pointer file needs to be updated to contain or not contain the+ - annex content.  -- - Note that if a commit happens before this runs again, it won't see- - the staged change. Instead, during the commit, git will run the clean- - filter. If a drop missed the file then the file is added back into the- - annex. If a get missed the file then the clean filter populates the- - file.+ - Note: There is a situation where, after this has run, the database can+ - still contain associated files that have been deleted from the index.+ - That happens when addAssociatedFile is used to record a newly+ - added file, but that file then gets removed from the index before+ - this is run. Eg, "git-annex add foo; git rm foo"+ - So when using getAssociatedFiles, have to make sure the file still+ - is an associated file.  -} reconcileStaged :: H.DbQueue -> Annex () reconcileStaged qh = do 	gitindex <- inRepo currentIndexFile 	indexcache <- fromRawFilePath <$> fromRepo gitAnnexKeysDbIndexCache 	withTSDelta (liftIO . genInodeCache gitindex) >>= \case-		Just cur -> -			liftIO (maybe Nothing readInodeCache <$> catchMaybeIO (readFile indexcache)) >>= \case-				Nothing -> go cur indexcache-				Just prev -> ifM (compareInodeCaches prev cur)-					( noop-					, go cur indexcache-					)+		Just cur -> readindexcache indexcache >>= \case+			Nothing -> go cur indexcache =<< getindextree+			Just prev -> ifM (compareInodeCaches prev cur)+				( noop+				, go cur indexcache =<< getindextree+				) 		Nothing -> noop   where-	go cur indexcache = do-		(l, cleanup) <- inRepo $ pipeNullSplit' diff-		changed <- procdiff l False-		void $ liftIO cleanup-		-- Flush database changes immediately-		-- so other processes can see them.-		when changed $-			liftIO $ H.flushDbQueue qh-		liftIO $ writeFile indexcache $ showInodeCache cur+	lastindexref = Ref "refs/annex/last-index"++	readindexcache indexcache = liftIO $ maybe Nothing readInodeCache+		<$> catchMaybeIO (readFile indexcache)++	getoldtree = fromMaybe emptyTree <$> inRepo (Git.Ref.sha lastindexref) 	-	diff =-		-- Avoid running smudge or clean filters, since we want the-		-- raw output, and they would block trying to access the+	go cur indexcache (Just newtree) = do+		oldtree <- getoldtree+		when (oldtree /= newtree) $ do+			fastDebug "Database.Keys" "reconcileStaged start"+			g <- Annex.gitRepo+			void $ catstream $ \mdfeeder -> +				void $ updatetodiff g+					(Just (fromRef oldtree)) +					(fromRef newtree)+					(procdiff mdfeeder)+			liftIO $ writeFile indexcache $ showInodeCache cur+			-- Storing the tree in a ref makes sure it does not+			-- get garbage collected, and is available to diff+			-- against next time.+			inRepo $ update' lastindexref newtree+			fastDebug "Database.Keys" "reconcileStaged end"+	-- git write-tree will fail if the index is locked or when there is+	-- a merge conflict. To get up-to-date with the current index, +	-- diff --staged with the old index tree. The current index tree+	-- is not known, so not recorded, and the inode cache is not updated,+	-- so the next time git-annex runs, it will diff again, even+	-- if the index is unchanged.+	--+	-- When there is a merge conflict, that will not see the new local+	-- version of the files that are conflicted. So a second diff+	-- is done, with --staged but no old tree.+	go _ _ Nothing = do+		fastDebug "Database.Keys" "reconcileStaged start (in conflict)"+		oldtree <- getoldtree+		g <- Annex.gitRepo+		catstream $ \mdfeeder -> do+			conflicted <- updatetodiff g+				(Just (fromRef oldtree)) "--staged" (procdiff mdfeeder)+			when conflicted $+				void $ updatetodiff g Nothing "--staged"+					(procmergeconflictdiff mdfeeder)+		fastDebug "Database.Keys" "reconcileStaged end"+	+	updatetodiff g old new processor = do+		(l, cleanup) <- pipeNullSplit' (diff old new) g+		processor l False+			`finally` void cleanup+	+	-- Avoid running smudge clean filter, which would block trying to+	-- access the locked database. git write-tree sometimes calls it,+	-- even though it is not adding work tree files to the index,+	-- and so the filter cannot have an effect on the contents of the+	-- index or on the tree that gets written from it.+	getindextree = inRepo $ \r -> writeTreeQuiet $ r+		{ gitGlobalOpts = gitGlobalOpts r ++ bypassSmudgeConfig }+	+	diff old new =+		-- Avoid running smudge clean filter, since we want the+		-- raw output, and it would block trying to access the 		-- locked database. The --raw normally avoids git diff 		-- running them, but older versions of git need this. 		bypassSmudgeConfig ++@@ -247,20 +309,18 @@ 		-- (The -G option may make it be used otherwise.) 		[ Param "-c", Param "diff.external=" 		, Param "diff"-		, Param "--cached"+		] ++ maybeToList (Param <$> old) +++		[ Param new 		, Param "--raw" 		, Param "-z" 		, Param "--no-abbrev"-		-- Optimization: Only find pointer files. This is not-		-- perfect. A file could start with this and not be a-		-- pointer file. And a pointer file that is replaced with-		-- a non-pointer file will match this.-		, Param $ "-G^" ++ fromRawFilePath (toInternalGitPath $+		-- Optimization: Limit to pointer files and annex symlinks.+		-- This is not perfect. A file could contain with this and not+		-- be a pointer file. And a pointer file that is replaced with+		-- a non-pointer file will match this. This is only a+		-- prefilter so that's ok.+		, Param $ "-G" ++ fromRawFilePath (toInternalGitPath $ 			P.pathSeparator `S.cons` objectDir')-		-- Don't include files that were deleted, because this only-		-- wants to update information for files that are present-		-- in the index.-		, Param "--diff-filter=AMUT" 		-- Disable rename detection. 		, Param "--no-renames" 		-- Avoid other complications.@@ -268,32 +328,130 @@ 		, Param "--no-ext-diff" 		] 	-	procdiff (info:file:rest) changed+	procdiff mdfeeder (info:file:rest) conflicted 		| ":" `S.isPrefixOf` info = case S8.words info of-			(_colonsrcmode:dstmode:_srcsha:dstsha:_change:[])-				-- Only want files, not symlinks-				| dstmode /= fmtTreeItemType TreeSymlink -> do-					maybe noop (reconcile (asTopFilePath file))-						=<< catKey (Ref dstsha)-					procdiff rest True-				| otherwise -> procdiff rest changed-			_ -> return changed -- parse failed-	procdiff _ changed = return changed+			(_colonsrcmode:dstmode:srcsha:dstsha:status:[]) -> do+				let conflicted' = status == "U"+				-- avoid removing associated file when+				-- there is a merge conflict+				unless conflicted' $+					send mdfeeder (Ref srcsha) $ \case+						Just oldkey -> do+							liftIO $ SQL.removeAssociatedFile oldkey+								(asTopFilePath file)+								(SQL.WriteHandle qh)+							return True+						Nothing -> return False+				send mdfeeder (Ref dstsha) $ \case+					Just key -> do+						liftIO $ SQL.addAssociatedFile key+							(asTopFilePath file)+							(SQL.WriteHandle qh)+						when (dstmode /= fmtTreeItemType TreeSymlink) $+							reconcilepointerfile (asTopFilePath file) key+						return True+					Nothing -> return False+				procdiff mdfeeder rest+					(conflicted || conflicted')+			_ -> return conflicted -- parse failed+	procdiff _ _ conflicted = return conflicted -	-- Note that database writes done in here will not necessarily -	-- be visible to database reads also done in here.-	reconcile file key = do-		liftIO $ SQL.addAssociatedFileFast key file (SQL.WriteHandle qh)-		caches <- liftIO $ SQL.getInodeCaches key (SQL.ReadHandle qh)-		keyloc <- calcRepo (gitAnnexLocation key)-		keypopulated <- sameInodeCache keyloc caches+	-- Processing a diff --index when there is a merge conflict.+	-- This diff will have the new local version of a file as the+	-- first sha, and a null sha as the second sha, and we only+	-- care about files that are in conflict.+	procmergeconflictdiff mdfeeder (info:file:rest) conflicted+		| ":" `S.isPrefixOf` info = case S8.words info of+			(_colonmode:_mode:sha:_sha:status:[]) -> do+				send mdfeeder (Ref sha) $ \case+					Just key -> do+						liftIO $ SQL.addAssociatedFile key+							(asTopFilePath file)+							(SQL.WriteHandle qh)+						return True+					Nothing -> return False+				let conflicted' = status == "U"+				procmergeconflictdiff mdfeeder rest+					(conflicted || conflicted')+			_ -> return conflicted -- parse failed+	procmergeconflictdiff _ _ conflicted = return conflicted++	reconcilepointerfile file key = do+		ics <- liftIO $ SQL.getInodeCaches key (SQL.ReadHandle qh)+		obj <- calcRepo (gitAnnexLocation key)+		objic <- withTSDelta (liftIO . genInodeCache obj)+		-- Like inAnnex, check the annex object's inode cache+		-- when annex.thin is set.+		keypopulated <- ifM (annexThin <$> Annex.getGitConfig)+			( maybe (pure False) (`elemInodeCaches` ics) objic+			, pure (isJust objic)+			) 		p <- fromRepo $ fromTopFilePath file-		filepopulated <- sameInodeCache p caches+		filepopulated <- sameInodeCache p ics 		case (keypopulated, filepopulated) of 			(True, False) ->-				populatePointerFile (Restage True) key keyloc p >>= \case+				populatePointerFile (Restage True) key obj p >>= \case 					Nothing -> return () 					Just ic -> liftIO $-						SQL.addInodeCaches key [ic] (SQL.WriteHandle qh)+						SQL.addInodeCaches key+							(catMaybes [Just ic, objic])+							(SQL.WriteHandle qh) 			(False, True) -> depopulatePointerFile key p 			_ -> return ()+	+	send :: ((Maybe Key -> Annex a, Ref) -> IO ()) -> Ref -> (Maybe Key -> Annex a) -> IO ()+	send feeder r withk = feeder (withk, r)++	-- Streaming through git cat-file like this is significantly+	-- faster than using catKey.+	catstream a = do+		g <- Annex.gitRepo+		catObjectMetaDataStream g $ \mdfeeder mdcloser mdreader ->+			catObjectStream g $ \catfeeder catcloser catreader -> do+				feedt <- liftIO $ async $+					a mdfeeder+						`finally` void mdcloser+				proct <- liftIO $ async $+					procthread mdreader catfeeder+						`finally` void catcloser+				dbchanged <- dbwriter False largediff catreader+				-- Flush database changes now+				-- so other processes can see them.+				when dbchanged $+					liftIO $ H.flushDbQueue qh+				() <- liftIO $ wait feedt+				liftIO $ wait proct+				return ()+	  where+		procthread mdreader catfeeder = mdreader >>= \case+			Just (ka, Just (sha, size, _type))+				| size < maxPointerSz -> do+					() <- catfeeder (ka, sha)+					procthread mdreader catfeeder+			Just _ -> procthread mdreader catfeeder+			Nothing -> return ()++		dbwriter dbchanged n catreader = liftIO catreader >>= \case+			Just (ka, content) -> do+				changed <- ka (parseLinkTargetOrPointerLazy =<< content)+				!n' <- countdownToMessage n+				dbwriter (dbchanged || changed) n' catreader+			Nothing -> return dbchanged++	-- When the diff is large, the scan can take a while,+	-- so let the user know what's going on.+	countdownToMessage n+		| n < 1 = return 0+		| n == 1 = do+			showSideAction "scanning for annexed files"+			return 0+		| otherwise = return (pred n)++	-- How large is large? Too large and there will be a long+	-- delay before the message is shown; too short and the message+	-- will clutter things up unncessarily. It's uncommon for 1000+	-- files to change in the index, and processing that many files+	-- takes less than half a second, so that seems about right.+	largediff :: Int+	largediff = 1000+
Database/Keys/SQL.hs view
@@ -1,6 +1,6 @@ {- Sqlite database of information about Keys  -- - Copyright 2015-2019 Joey Hess <id@joeyh.name>+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -27,7 +27,6 @@  import Database.Persist.Sql hiding (Key) import Database.Persist.TH-import Data.Time.Clock import Control.Monad import Data.Maybe @@ -37,15 +36,12 @@ -- (Unfortunatly persistent does not support indexes that are not -- uniqueness constraints; https://github.com/yesodweb/persistent/issues/109) ----- KeyFileIndex contains both the key and the file because the combined--- pair is unique, whereas the same key can appear in the table multiple--- times with different files.------ The other benefit to including the file in the index is that it makes--- queries that include the file faster, since it's a covering index.+-- To speed up queries for a key, there's KeyFileIndex, +-- which makes there be a covering index for keys. ----- The KeyFileIndex only speeds up selects for a key, since it comes first.--- To also speed up selects for a file, there's a separate FileKeyIndex.+-- FileKeyIndex speeds up queries that include the file, since+-- it makes there be a covering index for files. Note that, despite the name, it is+-- used as a uniqueness constraint now. share [mkPersist sqlSettings, mkMigrate "migrateKeysDb"] [persistLowerCase| Associated   key Key@@ -77,34 +73,21 @@ queueDb :: SqlPersistM () -> WriteHandle -> IO () queueDb a (WriteHandle h) = H.queueDb h checkcommit a   where-	-- commit queue after 1000 changes or 5 minutes, whichever comes first-	checkcommit sz lastcommittime-		| sz > 1000 = return True-		| otherwise = do-			now <- getCurrentTime-			return $ diffUTCTime now lastcommittime > 300+	-- commit queue after 1000 changes+	checkcommit sz _lastcommittime = pure (sz > 1000) +-- Insert the associated file.+-- When the file was associated with a different key before,+-- update it to the new key. addAssociatedFile :: Key -> TopFilePath -> WriteHandle -> IO ()-addAssociatedFile k f = queueDb $ do-	-- If the same file was associated with a different key before,-	-- remove that.-	deleteWhere [AssociatedFile ==. af, AssociatedKey !=. k]-	void $ insertUnique $ Associated k af-  where-	af = SFilePath (getTopFilePath f)---- Does not remove any old association for a file, but less expensive--- than addAssociatedFile. Calling dropAllAssociatedFiles first and then--- this is an efficient way to update all associated files.-addAssociatedFileFast :: Key -> TopFilePath -> WriteHandle -> IO ()-addAssociatedFileFast k f = queueDb $ void $ insertUnique $ Associated k af+addAssociatedFile k f = queueDb $+	void $ upsertBy+		(FileKeyIndex af k)+		(Associated k af)+		[AssociatedFile =. af, AssociatedKey =. k]   where 	af = SFilePath (getTopFilePath f) -dropAllAssociatedFiles :: WriteHandle -> IO ()-dropAllAssociatedFiles = queueDb $-	deleteWhere ([] :: [Filter Associated])- {- Note that the files returned were once associated with the key, but  - some of them may not be any longer. -} getAssociatedFiles :: Key -> ReadHandle -> IO [TopFilePath]@@ -113,7 +96,7 @@ 	return $ map (asTopFilePath . (\(SFilePath f) -> f) . associatedFile . entityVal) l  {- Gets any keys that are on record as having a particular associated file.- - (Should be one or none but the database doesn't enforce that.) -}+ - (Should be one or none.) -} getAssociatedKey :: TopFilePath -> ReadHandle -> IO [Key] getAssociatedKey f = readDb $ do 	l <- selectList [AssociatedFile ==. af] []@@ -143,6 +126,11 @@ removeInodeCaches :: Key -> WriteHandle -> IO () removeInodeCaches k = queueDb $ 	deleteWhere [ContentKey ==. k]++removeInodeCache :: InodeCache -> WriteHandle -> IO ()+removeInodeCache i = queueDb $ deleteWhere+	[ ContentInodecache ==. i+	]  {- Check if the inode is known to be used for an annexed file. -} isInodeKnown :: InodeCache -> SentinalStatus -> ReadHandle -> IO Bool
Git/Branch.hs view
@@ -1,6 +1,6 @@ {- git branch stuff  -- - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -166,7 +166,7 @@  -} commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha) commit commitmode allowempty message branch parentrefs repo = do-	tree <- getSha "write-tree" $ pipeReadStrict [Param "write-tree"] repo+	tree <- writeTree repo 	ifM (cancommit tree) 		( do 			sha <- commitTree commitmode message parentrefs tree repo@@ -184,6 +184,19 @@ commitAlways :: CommitMode -> String -> Branch -> [Ref] -> Repo -> IO Sha commitAlways commitmode message branch parentrefs repo = fromJust 	<$> commit commitmode True message branch parentrefs repo++-- Throws exception if the index is locked, with an error message output by+-- git on stderr.+writeTree :: Repo -> IO Sha+writeTree repo = getSha "write-tree" $+	pipeReadStrict [Param "write-tree"] repo++-- Avoids error output if the command fails due to eg, the index being locked.+writeTreeQuiet :: Repo -> IO (Maybe Sha)+writeTreeQuiet repo = extractSha <$> withNullHandle go+  where+	go nullh = pipeReadStrict' (\p -> p { std_err = UseHandle nullh }) +		[Param "write-tree"] repo  commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha commitTree commitmode message parentrefs tree repo =
Git/CatFile.hs view
@@ -326,7 +326,7 @@ 		(hClose hin) 		(catObjectReader readObjectContent c hout) 	feeder c h (v, ref) = do-		liftIO $ writeChan c (ref, v)+		writeChan c (ref, v) 		S8.hPutStrLn h (fromRef' ref)  catObjectMetaDataStream
Git/Command.hs view
@@ -70,17 +70,15 @@  - Nonzero exit status is ignored.  -} pipeReadStrict :: [CommandParam] -> Repo -> IO S.ByteString-pipeReadStrict = pipeReadStrict' S.hGetContents+pipeReadStrict = pipeReadStrict' id -{- The reader action must be strict. -}-pipeReadStrict' :: (Handle -> IO a) -> [CommandParam] -> Repo -> IO a-pipeReadStrict' reader params repo = assertLocal repo $ withCreateProcess p go+pipeReadStrict' :: (CreateProcess -> CreateProcess) -> [CommandParam] -> Repo -> IO S.ByteString+pipeReadStrict' fp params repo = assertLocal repo $ withCreateProcess p go   where-	p  = (gitCreateProcess params repo)-		{ std_out = CreatePipe }+	p = fp (gitCreateProcess params repo) { std_out = CreatePipe }  	go _ (Just outh) _ pid = do-		output <- reader outh+		output <- S.hGetContents outh 		hClose outh 		void $ waitForProcess pid 		return output
Git/LsTree.hs view
@@ -28,6 +28,7 @@  import Numeric import Data.Either+import Data.Char import System.Posix.Types import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L@@ -146,9 +147,9 @@  {- 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) ""-	, decodeBS (typeobj ti)-	, fromRef (sha ti)-	] ++ ('\t' : fromRawFilePath (getTopFilePath (file ti)))+formatLsTree :: TreeItem -> S.ByteString+formatLsTree ti = S.intercalate (S.singleton (fromIntegral (ord ' ')))+	[ encodeBS' (showOct (mode ti) "")+	, typeobj ti+	, fromRef' (sha ti)+	] <> (S.cons (fromIntegral (ord '\t')) (getTopFilePath (file ti)))
Git/Ref.hs view
@@ -64,12 +64,17 @@  {- A Ref that can be used to refer to a file in the repository, as staged  - in the index.- -- - Prefixing the file with ./ makes this work even if in a subdirectory- - of a repo.  -}-fileRef :: RawFilePath -> Ref-fileRef f = Ref $ ":./" <> toInternalGitPath f+fileRef :: RawFilePath -> IO Ref+fileRef f = do+	-- The filename could be absolute, or contain eg "../repo/file",+	-- neither of which work in a ref, so convert it to a minimal+	-- relative path.+	f' <- relPathCwdToFile f+ 	-- Prefixing the file with ./ makes this work even when in a+	-- subdirectory of a repo. Eg, ./foo in directory bar refers+	-- to bar/foo, not to foo in the top of the repository.+	return $ Ref $ ":./" <> toInternalGitPath f'  {- A Ref that can be used to refer to a file in a particular branch. -} branchFileRef :: Branch -> RawFilePath -> Ref@@ -81,8 +86,10 @@  {- A Ref that can be used to refer to a file in the repository as it  - appears in a given Ref. -}-fileFromRef :: Ref -> RawFilePath -> Ref-fileFromRef r f = let (Ref fr) = fileRef f in Ref (fromRef' r <> fr)+fileFromRef :: Ref -> RawFilePath -> IO Ref+fileFromRef r f = do+	(Ref fr) <- fileRef f+	return (Ref (fromRef' r <> fr))  {- Checks if a ref exists. Note that it must be fully qualified,  - eg refs/heads/master rather than master. -}
Limit.hs view
@@ -1,10 +1,12 @@ {- user-specified limits on files to act on  -- - 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.  -} +{-# LANGUAGE CPP #-}+ module Limit where  import Annex.Common@@ -29,16 +31,20 @@ import Logs.Group import Logs.Unused import Logs.Location+import Annex.CatFile+import Git.FilePath import Git.Types (RefDate(..)) import Utility.Glob import Utility.HumanTime import Utility.DataUnits+import qualified Database.Keys import qualified Utility.RawFilePath as R import Backend  import Data.Time.Clock.POSIX import qualified Data.Set as S import qualified Data.Map as M+import qualified System.FilePath.ByteString as P  {- Some limits can look at the current status of files on  - disk, or in the annex. This allows controlling which happens. -}@@ -121,6 +127,65 @@ 		Just f -> matchGlob cglob (fromRawFilePath f) 		Nothing -> False 	go (MatchingUserInfo p) = matchGlob cglob <$> getUserInfo (userProvidedFilePath p)++{- Add a limit to skip files when there is no other file using the same+ - content, with a name matching the glob. -}+addIncludeSameContent :: String -> Annex ()+addIncludeSameContent = addLimit . limitIncludeSameContent++limitIncludeSameContent :: MkLimit Annex+limitIncludeSameContent glob = Right $ MatchFiles+	{ matchAction = const $ matchSameContentGlob glob+	, matchNeedsFileName = True+	, matchNeedsFileContent = False+	, matchNeedsKey = False+	, matchNeedsLocationLog = False+	}++{- Add a limit to skip files when there is no other file using the same+ - content, with a name matching the glob. -}+addExcludeSameContent :: String -> Annex ()+addExcludeSameContent = addLimit . limitExcludeSameContent++limitExcludeSameContent :: MkLimit Annex+limitExcludeSameContent glob = Right $ MatchFiles+	{ matchAction = const $ not <$$> matchSameContentGlob glob+	, matchNeedsFileName = True+	, matchNeedsFileContent = False+	, matchNeedsKey = False+	, matchNeedsLocationLog = False+	}++matchSameContentGlob :: String -> MatchInfo -> Annex Bool+matchSameContentGlob glob mi = checkKey (go mi) mi+  where+	go (MatchingFile fi) k = check k (matchFile fi)+	go (MatchingInfo p) k = case providedFilePath p of+		Just f -> check k f+		Nothing -> return False+	go (MatchingUserInfo p) k = +		check k . toRawFilePath+			=<< getUserInfo (userProvidedFilePath p)+	+	cglob = compileGlob glob CaseSensative (GlobFilePath True) -- memoized+	+	matchesglob f = matchGlob cglob (fromRawFilePath f)+#ifdef mingw32_HOST_OS+		|| matchGlob cglob (fromRawFilePath (toInternalGitPath f))+#endif++	check k skipf = do+		-- Find other files with the same content, with filenames+		-- matching the glob.+		g <- Annex.gitRepo+		fs <- filter (/= P.normalise skipf)+			. filter matchesglob+			. map (\f -> P.normalise (fromTopFilePath f g))+			<$> Database.Keys.getAssociatedFiles k+		-- Some associated files in the keys database may no longer+		-- correspond to files in the repository. This is checked+		-- last as it's most expensive.+		anyM (\f -> maybe False (== k) <$> catKeyFile f) fs  addMimeType :: String -> Annex () addMimeType = addMagicLimit "mimetype" getMagicMimeType providedMimeType userProvidedMimeType
Limit/Wanted.hs view
@@ -19,7 +19,7 @@  addWantDrop :: Annex () addWantDrop = addPreferredContentLimit $-	checkWant $ wantDrop False Nothing Nothing+	checkWant $ \af -> wantDrop False Nothing Nothing af (Just [])  addPreferredContentLimit :: (MatchInfo -> Annex Bool) -> Annex () addPreferredContentLimit a = do
Logs.hs view
@@ -1,6 +1,6 @@ {- git-annex log file names  -- - Copyright 2013-2020 Joey Hess <id@joeyh.name>+ - Copyright 2013-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -20,7 +20,8 @@ 	= OldUUIDBasedLog 	| NewUUIDBasedLog 	| ChunkLog Key-	| PresenceLog Key+	| LocationLog Key+	| UrlLog Key 	| RemoteMetaDataLog 	| OtherLog 	deriving (Show)@@ -33,10 +34,11 @@ 	| f `elem` topLevelNewUUIDBasedLogs = Just NewUUIDBasedLog 	| isRemoteStateLog f = Just NewUUIDBasedLog 	| isRemoteContentIdentifierLog f = Just NewUUIDBasedLog-	| isChunkLog f = ChunkLog <$> extLogFileKey chunkLogExt f 	| isRemoteMetaDataLog f = Just RemoteMetaDataLog-	| isMetaDataLog f || f `elem` otherLogs = Just OtherLog-	| otherwise = PresenceLog <$> firstJust (presenceLogs config f)+	| isMetaDataLog f || f `elem` otherTopLevelLogs = Just OtherLog+	| otherwise = (LocationLog <$> locationLogFileKey config f)+		<|> (ChunkLog <$> extLogFileKey chunkLogExt f)+		<|> (UrlLog  <$> urlLogFileKey f)  {- Typical number of log files that may be read while processing a single  - key. This is used to size a cache.@@ -58,6 +60,22 @@ logFilesToCache :: Int logFilesToCache = 2 +{- All the log files that might contain information about a key. -}+keyLogFiles :: GitConfig -> Key -> [RawFilePath]+keyLogFiles config k = +	[ locationLogFile config k+	, urlLogFile config k+	, remoteStateLogFile config k+	, metaDataLogFile config k+	, remoteMetaDataLogFile config k+	, remoteContentIdentifierLogFile config k+	, chunkLogFile config k+	] ++ oldurlLogs config k++{- All uuid-based logs stored in the top of the git-annex branch. -}+topLevelUUIDBasedLogs :: [RawFilePath]+topLevelUUIDBasedLogs = topLevelNewUUIDBasedLogs ++ topLevelOldUUIDBasedLogs+ {- All the old-format uuid-based logs stored in the top of the git-annex branch. -} topLevelOldUUIDBasedLogs :: [RawFilePath] topLevelOldUUIDBasedLogs =@@ -79,18 +97,12 @@ 	[ exportLog 	] -{- All the ways to get a key from a presence log file -}-presenceLogs :: GitConfig -> RawFilePath -> [Maybe Key]-presenceLogs config f =-	[ urlLogFileKey f-	, locationLogFileKey config f-	]--{- Top-level logs that are neither UUID based nor presence logs. -}-otherLogs :: [RawFilePath]-otherLogs =+{- Other top-level logs. -}+otherTopLevelLogs :: [RawFilePath]+otherTopLevelLogs = 	[ numcopiesLog 	, mincopiesLog+	, configLog 	, groupPreferredContentLog 	] @@ -190,9 +202,6 @@  chunkLogExt :: S.ByteString chunkLogExt = ".log.cnk"--isChunkLog :: RawFilePath -> Bool-isChunkLog path = chunkLogExt `S.isSuffixOf` path  {- The filename of the metadata log for a given key. -} metaDataLogFile :: GitConfig -> Key -> RawFilePath
Logs/Activity.hs view
@@ -1,6 +1,6 @@ {- git-annex activity log  -- - Copyright 2015-2019 Joey Hess <id@joeyh.name>+ - Copyright 2015-2021 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -8,6 +8,7 @@ module Logs.Activity ( 	Log, 	Activity(..),+	allActivities, 	recordActivity, 	lastActivities, ) where@@ -23,30 +24,38 @@  data Activity  	= Fsck-	deriving (Eq, Read, Show, Enum, Bounded)+	-- Allow for unknown activities to be added later.+	| UnknownActivity S.ByteString+	deriving (Eq, Read, Show) +allActivities :: [Activity]+allActivities = [Fsck]++-- Record an activity. This takes the place of previously recorded activity+-- for the UUID. recordActivity :: Activity -> UUID -> Annex () recordActivity act uuid = do 	c <- currentVectorClock 	Annex.Branch.change (Annex.Branch.RegardingUUID [uuid]) activityLog $ 		buildLogOld buildActivity-			. changeLog c uuid (Right act)+			. changeLog c uuid act 			. parseLogOld parseActivity +-- Most recent activity for each UUID. lastActivities :: Maybe Activity -> Annex (Log Activity) lastActivities wantact = parseLogOld (onlywanted =<< parseActivity) 	<$> Annex.Branch.get activityLog   where-	onlywanted (Right a) | wanted a = pure a-	onlywanted _ = fail "unwanted activity"+	onlywanted a +		| wanted a = pure a+		| otherwise = fail "unwanted activity" 	wanted a = maybe True (a ==) wantact -buildActivity :: Either S.ByteString Activity -> Builder-buildActivity (Right a) = byteString $ encodeBS $ show a-buildActivity (Left b) = byteString b+buildActivity :: Activity -> Builder+buildActivity (UnknownActivity b) = byteString b+buildActivity a = byteString $ encodeBS $ show a --- Allow for unknown activities to be added later by preserving them.-parseActivity :: A.Parser (Either S.ByteString Activity)+parseActivity :: A.Parser Activity parseActivity = go <$> A.takeByteString   where-	go b = maybe (Left b) Right $ readish $ decodeBS b+	go b = fromMaybe (UnknownActivity b) (readish $ decodeBS b)
Logs/Export.hs view
@@ -23,6 +23,7 @@ ) where  import qualified Data.Map as M+import qualified Data.ByteString as B  import Annex.Common import qualified Annex.Branch@@ -119,10 +120,10 @@ logExportExcluded u a = do 	logf <- fromRepo $ gitAnnexExportExcludeLog u 	withLogHandle logf $ \logh -> do-		liftIO $ hSetNewlineMode logh noNewlineTranslation 		a (writer logh)   where-	writer logh = hPutStrLn logh+	writer logh = B.hPutStr logh+		. flip B.snoc (fromIntegral (ord '\n')) 		. Git.LsTree.formatLsTree 		. Git.Tree.treeItemToLsTreeItem
Logs/PreferredContent.hs view
@@ -46,8 +46,8 @@ import Types.StandardGroups import Limit -{- Checks if a file is preferred content for the specified repository- - (or the current repository if none is specified). -}+{- Checks if a file is preferred content (or required content) for the+ - specified repository (or the current repository if none is specified). -} isPreferredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool isPreferredContent = checkMap preferredContentMap
Messages.hs view
@@ -124,12 +124,12 @@   where 	go st 		| sideActionBlock st == StartBlock = do-			p+			go' 			let st' = st { sideActionBlock = InBlock } 			Annex.changeState $ \s -> s { Annex.output = st' } 		| sideActionBlock st == InBlock = return ()-		| otherwise = p-	p = outputMessage JSON.none $ encodeBS' $ "(" ++ m ++ "...)\n"+		| otherwise = go'+	go' = outputMessage JSON.none $ encodeBS' $ "(" ++ m ++ "...)\n" 			 showStoringStateAction :: Annex () showStoringStateAction = showSideAction "recording state in git"
Messages/Internal.hs view
@@ -25,8 +25,12 @@ outputMessage' :: (JSONBuilder -> MessageState -> Annex Bool) -> JSONBuilder -> S.ByteString -> Annex () outputMessage' jsonoutputter jsonbuilder msg = withMessageState $ \s -> case outputType s of 	NormalOutput-		| concurrentOutputEnabled s -> concurrentMessage s False (decodeBS msg) q-		| otherwise -> liftIO $ flushed $ S.putStr msg+		| concurrentOutputEnabled s -> do+			liftIO $ clearProgressMeter s+			concurrentMessage s False (decodeBS msg) q+		| otherwise -> do+			liftIO $ clearProgressMeter s+			liftIO $ flushed $ S.putStr msg 	JSONOutput _ -> void $ jsonoutputter jsonbuilder s 	QuietOutput -> q 	SerializedOutput h _ -> do
Messages/Progress.hs view
@@ -11,6 +11,7 @@ module Messages.Progress where  import Common+import qualified Annex import Messages import Utility.Metered import Types@@ -66,7 +67,7 @@  {- Shows a progress meter while performing an action.  - The action is passed the meter and a callback to use to update the meter.- --}+ -} metered 	:: MeterSize sizer 	=> Maybe MeterUpdate@@ -75,28 +76,38 @@ 	-> Annex a metered othermeter sizer a = withMessageState $ \st -> do 	sz <- getMeterSize sizer-	metered' st othermeter sz showOutput a+	metered' st setclear othermeter sz showOutput a+  where+	setclear c = Annex.changeState $ \st -> st+		{ Annex.output = (Annex.output st) { clearProgressMeter = c } }  metered' 	:: (Monad m, MonadIO m, MonadMask m) 	=> MessageState+	-> (IO () -> m ())+	-- ^ This should set clearProgressMeter when progress meters+	-- are being displayed; not needed when outputType is not+	-- NormalOutput. 	-> Maybe MeterUpdate 	-> Maybe TotalSize 	-> m () 	-- ^ this should run showOutput 	-> (Meter -> MeterUpdate -> m a) 	-> m a-metered' st othermeter msize showoutput a = go st+metered' st setclear othermeter msize showoutput a = go st   where 	go (MessageState { outputType = QuietOutput }) = nometer 	go (MessageState { outputType = NormalOutput, concurrentOutputEnabled = False }) = do 		showoutput 		meter <- liftIO $ mkMeter msize $  			displayMeterHandle stdout bandwidthMeter+		let clear = clearMeterHandle meter stdout+		setclear clear 		m <- liftIO $ rateLimitMeterUpdate consoleratelimit meter $ 			updateMeter meter 		r <- a meter (combinemeter m)-		liftIO $ clearMeterHandle meter stdout+		setclear noop+		liftIO clear 		return r 	go (MessageState { outputType = NormalOutput, concurrentOutputEnabled = True }) = 		withProgressRegion st $ \r -> do@@ -149,7 +160,7 @@ 	jsonratelimit = 0.1  	minratelimit = min consoleratelimit jsonratelimit-+		 {- Poll file size to display meter. -} meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a meteredFile file combinemeterupdate key a =
Messages/Serialized.hs view
@@ -65,9 +65,10 @@ 			loop st 		Left BeginProgressMeter -> do 			ost <- runannex (Annex.getState Annex.output)+			let setclear = const noop 			-- Display a progress meter while running, until 			-- the meter ends or a final value is returned.-			metered' ost Nothing Nothing (runannex showOutput) +			metered' ost setclear Nothing Nothing (runannex showOutput)  				(\meter meterupdate -> loop (Just (meter, meterupdate))) 				>>= \case 					Right r -> return (Right r)
Test.hs view
@@ -340,6 +340,8 @@ 	, testCase "fsck (local untrusted)" test_fsck_localuntrusted 	, testCase "fsck (remote untrusted)" test_fsck_remoteuntrusted 	, testCase "fsck --from remote" test_fsck_fromremote+	, testCase "conversion git to annexed" test_conversion_git_to_annexed+	, testCase "conversion annexed to git" test_conversion_annexed_to_git 	, testCase "migrate" test_migrate 	, testCase "migrate (via gitattributes)" test_migrate_via_gitattributes 	, testCase "unused" test_unused@@ -374,6 +376,7 @@ 	, testCase "bup remote" test_bup_remote 	, testCase "crypto" test_crypto 	, testCase "preferred content" test_preferred_content+	, testCase "required_content" test_required_content 	, testCase "add subdirs" test_add_subdirs 	, testCase "addurl" test_addurl 	]@@ -545,11 +548,10 @@ 	key <- Key.serializeKey <$> getKey backendSHA1 tmp 	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 for dup"-		annexed_present_locked sha1annexedfiledup+	git_annex "fromkey" [key, sha1annexedfiledup] "fromkey for dup"+	whenM (unlockedFiles <$> getTestMode) $+		git_annex "unlock" [sha1annexedfiledup] "unlock"+	annexed_present sha1annexedfiledup   where 	tmp = "tmpfile" @@ -748,6 +750,27 @@ 	git_annex "get" ["--auto", annexedfile] "get --auto of file with exclude=*" 	annexed_notpresent annexedfile +test_required_content :: Assertion+test_required_content = intmpclonerepo $ do+	git_annex "get" [annexedfile] "get"+	annexed_present annexedfile+	git_annex "required" [".", "include=" ++ annexedfile] "annexedfile required"++	git_annex_shouldfail "drop" [annexedfile] "drop of required content should fail"+	annexed_present annexedfile++	git_annex "drop" ["--auto", annexedfile] "drop --auto of required content skips it"+	annexed_present annexedfile+	+	writecontent annexedfiledup $ content annexedfiledup+	add_annex annexedfiledup "add of second file with same content failed"+	annexed_present annexedfiledup+	annexed_present annexedfile++	git_annex_shouldfail "drop" [annexedfiledup] "drop of file sharing required content should fail"+	annexed_present annexedfiledup+	annexed_present annexedfile+ test_lock :: Assertion test_lock = intmpclonerepo $ do 	annexed_notpresent annexedfile@@ -926,6 +949,28 @@ fsck_should_fail :: String -> Assertion fsck_should_fail m = git_annex_shouldfail "fsck" [] 	("fsck should not succeed with " ++ m)++-- Make sure that the "converting git to annexed" recipe in+-- doc/tips/largefiles.mdwn continues to work.+test_conversion_git_to_annexed :: Assertion+test_conversion_git_to_annexed = intmpclonerepo $ do+	git "rm" ["--cached", ingitfile] "git rm --cached"+	git_annex "add" ["--force-large", ingitfile] "add --force-large"+	git "commit" ["-q", "-m", "commit", ingitfile] "git commit"+	whenM (unlockedFiles <$> getTestMode) $+		git_annex "unlock" [ingitfile] "unlock"+	annexed_present ingitfile++-- Make sure that the "converting annexed to git" recipe in+-- doc/tips/largefiles.mdwn continues to work.+test_conversion_annexed_to_git :: Assertion+test_conversion_annexed_to_git = intmpclonerepo $ do	+	git_annex "get" [annexedfile] "get"+	git_annex "unlock" [annexedfile] "unlock"+	git "rm" ["--cached", annexedfile] "git rm --cached"+	git_annex "add" ["--force-small", annexedfile] "add --force-small"+	git "commit" ["-q", "-m", "commit", annexedfile] "git commit"+	unannexed_in_git annexedfile  test_migrate :: Assertion test_migrate = test_migrate' False
Test/Framework.hs view
@@ -415,6 +415,16 @@ unannexed :: FilePath -> Assertion unannexed = runchecks [checkregularfile, checkcontent, checkwritable] +-- Check that a file is unannexed, but also that what's recorded in git+-- is not an annexed file.+unannexed_in_git :: FilePath -> Assertion+unannexed_in_git f = do+	unannexed f+	r <- annexeval $ Annex.WorkTree.lookupKey (toRawFilePath f)+	case r of+		Just _k -> assertFailure $ f ++ " is annexed in git"+		Nothing -> return ()+ add_annex :: FilePath -> String -> Assertion add_annex f faildesc = ifM (unlockedFiles <$> getTestMode) 	( git "add" [f] faildesc
Types/FileMatcher.hs view
@@ -47,6 +47,16 @@ 	, providedLinkType :: Maybe LinkType 	} +keyMatchInfoWithoutContent :: Key -> RawFilePath -> MatchInfo+keyMatchInfoWithoutContent key file = MatchingInfo $ ProvidedInfo+	{ providedFilePath = Just file+	, providedKey = Just key+	, providedFileSize = Nothing+	, providedMimeType = Nothing+	, providedMimeEncoding = Nothing+	, providedLinkType = Nothing+	}+ -- This is used when testing a matcher, with values to match against -- provided by the user. data UserProvidedInfo = UserProvidedInfo
Types/GitConfig.hs view
@@ -139,6 +139,7 @@ 	, gpgCmd :: GpgCmd 	, mergeDirectoryRenames :: Maybe String 	, annexPrivateRepos :: S.Set UUID+	, annexAdviceNoSshCaching :: Bool 	}  extractGitConfig :: ConfigSource -> Git.Repo -> GitConfig@@ -255,6 +256,7 @@ 			| otherwise = Nothing 		  in mapMaybe get (M.toList (Git.config r)) 		]+	, annexAdviceNoSshCaching = getbool (annexConfig "adviceNoSshCaching") True 	}   where 	getbool k d = fromMaybe d $ getmaybebool k
Types/Messages.hs view
@@ -47,6 +47,7 @@ 	, consoleRegionErrFlag :: Bool 	, jsonBuffer :: Maybe Aeson.Object 	, promptLock :: MVar () -- left full when not prompting+	, clearProgressMeter :: IO () 	}  newMessageState :: IO MessageState@@ -60,6 +61,7 @@ 		, consoleRegionErrFlag = False 		, jsonBuffer = Nothing 		, promptLock = promptlock+		, clearProgressMeter = return () 		}  -- | When communicating with a child process over a pipe while it is
Upgrade/V5.hs view
@@ -47,7 +47,7 @@ 		, do 			checkGitVersionForIndirectUpgrade 		)-	scanUnlockedFiles+	scanAnnexedFiles True 	configureSmudgeFilter 	-- Inode sentinal file was only used in direct mode and when 	-- locking down files as they were added. In v6, it's used more
Upgrade/V7.hs view
@@ -115,7 +115,7 @@ 				Just k -> do 					topf <- inRepo $ toTopFilePath $ toRawFilePath f 					Database.Keys.runWriter $ \h -> liftIO $ do-						Database.Keys.SQL.addAssociatedFileFast k topf h+						Database.Keys.SQL.addAssociatedFile k topf h 						Database.Keys.SQL.addInodeCaches k [ic] h 	liftIO $ void cleanup 	Database.Keys.closeDb
Utility/Daemon.hs view
@@ -1,6 +1,6 @@ {- daemon support  -- - Copyright 2012-2014 Joey Hess <id@joeyh.name>+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -20,53 +20,57 @@ import Utility.PID #ifndef mingw32_HOST_OS import Utility.LogFile+import Utility.Env #else import System.Win32.Process (terminateProcessById) import Utility.LockFile #endif  #ifndef mingw32_HOST_OS-import System.Posix-import Control.Concurrent.Async+import System.Posix hiding (getEnv, getEnvironment) #endif  #ifndef mingw32_HOST_OS-{- Run an action as a daemon, with all output sent to a file descriptor.+{- Run an action as a daemon, with all output sent to a file descriptor,+ - and in a new session.  -- - Can write its pid to a file, to guard against multiple instances- - running and allow easy termination.+ - Can write its pid to a file.  -- - When successful, does not return. -}-daemonize :: Fd -> Maybe FilePath -> Bool -> IO () -> IO ()-daemonize logfd pidfile changedirectory a = do+ - This does not double-fork to background, because forkProcess is+ - rather fragile and highly unused in haskell programs, so likely to break.+ - Instead, it runs the cmd with provided params, in the background,+ - which the caller should arrange to run this again.+ -}+daemonize :: String -> [CommandParam] -> IO Fd -> Maybe FilePath -> Bool -> IO () -> IO ()+daemonize cmd params openlogfd pidfile changedirectory a = do 	maybe noop checkalreadyrunning pidfile-	_ <- forkProcess child1-	out+	getEnv envvar >>= \case+		Just s | s == cmd -> do+			maybe noop lockPidFile pidfile +			a+		_ -> do+			nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags+			redir nullfd stdInput+			redirLog =<< openlogfd+			environ <- getEnvironment+			_ <- createProcess $+				(proc cmd (toCommand params))+				{ env = Just (addEntry envvar cmd environ)+				, create_group = True+				, new_session = True+				, cwd = if changedirectory then Just "/" else Nothing+				}+			return ()   where 	checkalreadyrunning f = maybe noop (const alreadyRunning)  		=<< checkDaemon f-	child1 = do-		_ <- tryIO createSession-		_ <- forkProcess child2-		out-	child2 = do-		maybe noop lockPidFile pidfile -		when changedirectory $-			setCurrentDirectory "/"-		nullfd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags-		redir nullfd stdInput-		redirLog logfd-		{- In old versions of ghc, forkProcess masks async exceptions;-		 - unmask them inside the action. -}-		wait =<< asyncWithUnmask (\unmask -> unmask a)-		out-	out = exitImmediately ExitSuccess+	envvar = "DAEMONIZED" #endif  {- To run an action that is normally daemonized in the forground. -} #ifndef mingw32_HOST_OS-foreground :: Fd -> Maybe FilePath -> IO () -> IO ()-foreground logfd pidfile a = do+foreground :: IO Fd -> Maybe FilePath -> IO () -> IO ()+foreground openlogfd pidfile a = do #else foreground :: Maybe FilePath -> IO () -> IO () foreground pidfile a = do@@ -74,7 +78,7 @@ 	maybe noop lockPidFile pidfile #ifndef mingw32_HOST_OS 	_ <- tryIO createSession-	redirLog logfd+	redirLog =<< openlogfd #endif 	a #ifndef mingw32_HOST_OS
Utility/Metered.hs view
@@ -425,7 +425,8 @@ 		hPutStr h ('\r':s ++ padding) 		hFlush h --- | Clear meter displayed by displayMeterHandle.+-- | Clear meter displayed by displayMeterHandle. May be called before+-- outputting something else, followed by more calls to displayMeterHandle. clearMeterHandle :: Meter -> Handle -> IO () clearMeterHandle (Meter _ _ v _) h = do 	olds <- readMVar v
Utility/Path/AbsRel.hs view
@@ -1,6 +1,6 @@ {- absolute and relative path manipulation  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -19,6 +19,7 @@ ) where  import System.FilePath.ByteString+import qualified Data.ByteString as B #ifdef mingw32_HOST_OS import System.Directory (getCurrentDirectory) #else@@ -64,22 +65,27 @@ #endif 		return $ absPathFrom cwd file -{- Constructs a relative path from the CWD to a file.+{- Constructs the minimal relative path from the CWD to a file.  -  - For example, assuming CWD is /tmp/foo/bar:  -    relPathCwdToFile "/tmp/foo" == ".."  -    relPathCwdToFile "/tmp/foo/bar" == "" + -    relPathCwdToFile "../bar/baz" == "baz"  -} relPathCwdToFile :: RawFilePath -> IO RawFilePath-relPathCwdToFile f = do+relPathCwdToFile f+	-- Optimisation: Avoid doing any IO when the path is relative+	-- and does not contain any ".." component.+	| isRelative f && not (".." `B.isInfixOf` f) = return f+	| otherwise = do #ifdef mingw32_HOST_OS-	c <- toRawFilePath <$> getCurrentDirectory+		c <- toRawFilePath <$> getCurrentDirectory #else-	c <- getWorkingDirectory+		c <- getWorkingDirectory #endif-	relPathDirToFile c f+		relPathDirToFile c f -{- Constructs a relative path from a directory to a file. -}+{- Constructs a minimal relative path from a directory to a file. -} relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
Utility/ThreadScheduler.hs view
@@ -15,6 +15,7 @@ 	threadDelaySeconds, 	waitForTermination, 	oneSecond,+	unboundDelay, ) where  import Control.Monad
doc/git-annex-add.mdwn view
@@ -106,6 +106,8 @@   Makes the `--batch` input be delimited by nulls instead of the usual   newlines. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-addunused.mdwn view
@@ -13,6 +13,10 @@  The files will have names starting with "unused." +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-addurl.mdwn view
@@ -130,6 +130,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # CAVEATS  If annex.largefiles is configured, and does not match a file, `git annex
doc/git-annex-adjust.mdwn view
@@ -109,6 +109,8 @@   set the `annex.adjustedbranchrefresh` config. Or use `git-annex sync   --content`, which updates the branch after transferring content. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-assistant.mdwn view
@@ -40,6 +40,8 @@   The complement to --autostart; stops all running daemons in the   repositories listed in the autostart file. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-calckey.mdwn view
@@ -34,6 +34,8 @@   Makes the `--batch` input be delimited by nulls instead of the usual   newlines. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-checkpresentkey.mdwn view
@@ -27,6 +27,8 @@   read from stdin, and a line is output with "1" if the key is verified to   be present, and "0" otherwise. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-config.mdwn view
@@ -80,7 +80,7 @@  * `annex.synconlyannex` -  Set to true to make git-annex sync default to only sincing the git-annex+  Set to true to make git-annex sync default to only sync the git-annex   branch and annexed content.  * `annex.securehashesonly`@@ -99,6 +99,22 @@   `git annex init`, and is copied to the corresponding git config setting.    So, changes to the value in the git-annex branch won't affect a   repository once it has been initialized.++# OPTIONS++* `--set name value`++  Set a value.++* `--get name`++  Get a value.++* `--unset`++  Unset a value.++* Also the [[git-annex-common-options]](1) can be used.  # EXAMPLE
doc/git-annex-contentlocation.mdwn view
@@ -23,6 +23,8 @@   Note that if a key's content is not present, an empty line is output to   stdout instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-copy.mdwn view
@@ -112,6 +112,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-dead.mdwn view
@@ -4,7 +4,7 @@  # SYNOPSIS -git annex dead `[repository ...] [--key key]`+git annex dead `[repository ...] [--key somekey]`  # DESCRIPTION @@ -21,6 +21,14 @@ from complaining about it; `--all` will not operate on the key anymore. (To undo, add the key's content back to the repository,  by using eg, `git-annex reinject`.)++# OPTIONS++* `--key=somekey`++  Use to specify a key that is dead.++* Also the [[git-annex-common-options]](1) can be used.  # SEE ALSO
doc/git-annex-describe.mdwn view
@@ -18,6 +18,10 @@ They are most useful when git-annex knows about a repository, but there is no git remote corresponding to it. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-diffdriver.mdwn view
@@ -26,6 +26,13 @@  For example, set `GIT_EXTERNAL_DIFF=git-annex diffdriver -- j-c-diff --` +# OPTIONS++Normally "--" followed by the diff driver command, its options, +and another "--"++Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-drop.mdwn view
@@ -125,6 +125,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-dropkey.mdwn view
@@ -34,6 +34,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-dropunused.mdwn view
@@ -28,6 +28,8 @@   the last repository that is storing their content. Data loss can   result from using this option. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-enable-tor.mdwn view
@@ -21,6 +21,10 @@ tor hidden service, and then `git-annex p2p --gen-address` can be run to give other users access to your repository via the tor hidden service. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-enableremote.mdwn view
@@ -57,6 +57,13 @@ has found didn't work before and gave up on using, setting  `remote.<name>.annex-ignore`.) +# OPTIONS++Most options are not prefixed by a dash, and set parameters of the remote,+as shown above. ++Also, the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-examinekey.mdwn view
@@ -74,6 +74,8 @@   In order to also provide the name of a file associated with the key, the   line can be in the format "$key $file" +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-expire.mdwn view
@@ -48,6 +48,8 @@   The first version of git-annex that recorded fsck activity was   5.20150405. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-export.mdwn view
@@ -113,6 +113,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # EXAMPLE  	git annex initremote myremote type=directory directory=/mnt/myremote \
doc/git-annex-find.mdwn view
@@ -77,6 +77,8 @@   Makes the `--batch` input be delimited by nulls instead of the usual   newlines. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-fix.mdwn view
@@ -24,6 +24,8 @@   The [[git-annex-matching-options]](1)   can be used to specify files to fix. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-forget.mdwn view
@@ -26,9 +26,13 @@    Also prune references to repositories that have been marked as dead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)++[[git-annex-filter-branch]](1)  # AUTHOR
doc/git-annex-fromkey.mdwn view
@@ -47,6 +47,8 @@   Enable JSON output. This is intended to be parsed by programs that use   git-annex. Each line of output is a JSON object. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-fsck.mdwn view
@@ -110,6 +110,15 @@   Messages that would normally be output to standard error are included in   the json instead. +* `--quiet`++  Like all git-annex commands, this option makes only error and warning+  messages be displayed. This is particularly useful with fsck, which+  normally displays all the files it's checking even when there is no+  problem with them.++* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-fuzztest.mdwn view
@@ -12,6 +12,10 @@ for use in testing the assistant. This is dangerous, so it will not do anything unless --forced. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-get.mdwn view
@@ -133,6 +133,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-group.mdwn view
@@ -18,6 +18,10 @@  A repository can be in multiple groups at the same time. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-groupwanted.mdwn view
@@ -25,6 +25,10 @@ amoung all the groups that a repository is in; if there's more than one, none of them will be used. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-import.mdwn view
@@ -205,6 +205,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # CAVEATS  Note that using `--deduplicate` or `--clean-duplicates` with the WORM
doc/git-annex-importfeed.mdwn view
@@ -95,6 +95,8 @@   url to a file that would be ignored. This makes such files be added   despite any ignores. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-info.mdwn view
@@ -51,6 +51,8 @@   can be used to select the files in the directory that are included   in the statistics. +* Also the [[git-annex-common-options]](1) can be used.+ # EXAMPLES  Suppose you want to run "git annex get .", but
doc/git-annex-init.mdwn view
@@ -53,6 +53,8 @@   Only enable any special remotes that were configured with   autoenable=true, do not otherwise initialize anything. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-initremote.mdwn view
@@ -80,6 +80,8 @@   branch. The special remote will only be usable from the repository where   it was created. +* Also the [[git-annex-common-options]](1) can be used.+ # COMMON CONFIGURATION PARAMETERS  * `encryption`
doc/git-annex-inprogress.mdwn view
@@ -49,6 +49,8 @@   The [[git-annex-matching-options]](1)   can be used to specify files to access. +* Also the [[git-annex-common-options]](1) can be used.+ # EXIT STATUS  If any of the requested items are not currently being downloaded,
doc/git-annex-list.mdwn view
@@ -23,6 +23,8 @@   The [[git-annex-matching-options]](1)   can be used to specify files to list. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-lock.mdwn view
@@ -33,6 +33,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-log.mdwn view
@@ -50,6 +50,8 @@   In this mode, the names of files are not available and keys are displayed   instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-lookupkey.mdwn view
@@ -28,6 +28,8 @@   Makes the `--batch` input be delimited by nulls instead of the usual   newlines. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-map.mdwn view
@@ -39,6 +39,8 @@    Don't display the generated Graphviz file, but save it for later use. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-matchexpression.mdwn view
@@ -53,6 +53,8 @@   Tell what the mime encoding of the file is. Only needed when using   --largefiles with a mimeencoding= expression. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-matching-options.mdwn view
@@ -22,7 +22,7 @@   Skips files matching the glob pattern. The glob is matched relative to   the current directory. For example: -        	--exclude='*.mp3' --exclude='subdir/*'+        	git annex get --exclude='*.mp3' --exclude='subdir/*'    Note that this will not match anything when using --all or --unused. @@ -31,10 +31,31 @@   Skips files not matching the glob pattern.  (Same as `--not --exclude`.)   For example, to include only mp3 and ogg files: -        	--include='*.mp3' --or --include='*.ogg'+        	git annex get --include='*.mp3' --or --include='*.ogg'    Note that this will not skip anything when using --all or --unused. +* `--excludesamecontent=glob`++  Skips a file when there is another file with the same content,+  whose name matches the glob. The glob is matched relative to the current+  directory.++  For example, to drop files in the archive directory, but not when the same+  content is used by a file in the work directory:++        	git annex drop archive/ --excludesamecontent='work/*'++* `--includesamecontent=glob`++  Skips files when there is no other file with the same content+  whose name matches the glob. (Same as `--not --includesamecontent`)++  For example, if you have inbox and outbox directories, and want to find+  anything in the inbox that has the same content as something in the outbox:++        	git annex find inbox --includesamecontent='outbox/*'+ * `--in=repository`    Matches only files that git-annex believes have their contents present@@ -134,16 +155,17 @@   Matches files that the preferred content settings for the repository   make it want to get. Note that this will match even files that are   already present, unless limited with e.g., `--not --in .`-  -  Note that this will not match anything when using --all or --unused.  * `--want-drop`    Matches files that the preferred content settings for the repository   make it want to drop. Note that this will match even files that have   already been dropped, unless limited with e.g., `--in .`-  -  Note that this will not match anything when using --all or --unused.++  Files that this matches will not necessarily be dropped by+  `git-annex drop --auto`. This does not check that there are enough copies+  to drop. Also the same content may be used by a file that is not wanted+  to be dropped.  * `--accessedwithin=interval`
doc/git-annex-merge.mdwn view
@@ -20,6 +20,10 @@ When annex.resolvemerge is set to false, merge conflict resolution will not be done. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-metadata.mdwn view
@@ -162,6 +162,8 @@   Note that file matching options do not affect the files that are   processed when in batch mode. +* Also the [[git-annex-common-options]](1) can be used.+ # EXAMPLES  To set some tags on a file and also its author:
doc/git-annex-migrate.mdwn view
@@ -37,6 +37,8 @@   The [[git-annex-matching-options]](1)   can be used to specify files to migrate. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-mirror.mdwn view
@@ -82,6 +82,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-move.mdwn view
@@ -112,6 +112,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-multicast.mdwn view
@@ -59,6 +59,8 @@  	git annex multicast send -U-R -U50000 +* Also the [[git-annex-common-options]](1) can be used.+ # EXAMPLE  Suppose a teacher wants to multicast files to students in a classroom.
doc/git-annex-numcopies.mdwn view
@@ -28,6 +28,10 @@ guarantees at least 1 copy is preserved. This can be configured by using [[git-annex-mincopies]](1) +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-p2p.mdwn view
@@ -63,6 +63,8 @@   Specify a name to use when setting up a git remote with `--link`   or `--pair`. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-pre-commit.mdwn view
@@ -17,6 +17,10 @@ When in a view, updates metadata to reflect changes made to files in the view. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-readpresentkey.mdwn view
@@ -17,6 +17,10 @@ Note that this does not do an active check to verify if the key is present. To do such a check, use [[git-annex-checkpresentkey]](1) +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-registerurl.mdwn view
@@ -37,6 +37,8 @@    (Note that for this to be used, you have to explicitly enable batch mode    with `--batch`) +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-reinit.mdwn view
@@ -23,6 +23,10 @@ Like `git annex init`, this attempts to enable any special remotes that are configured with autoenable=true. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-reinject.mdwn view
@@ -54,6 +54,8 @@   Specify the key-value backend to use when checking if a file is known   with the `--known` option. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-rekey.mdwn view
@@ -31,6 +31,8 @@   Makes the `--batch` input be delimited by nulls instead of the usual   newlines. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-remotedaemon.mdwn view
@@ -31,13 +31,15 @@  * `--foreground` -Don't fork to the background, and communicate on stdin/stdout using a-simple textual protocol. The assistant runs the remotedaemon this way.+  Don't fork to the background, and communicate on stdin/stdout using a+  simple textual protocol. The assistant runs the remotedaemon this way. -Commands in the protocol include LOSTNET, which tells the remotedaemon-that the network connection has been lost, and causes it to stop any TCP-connctions. That can be followed by RESUME when the network connection-comes back up.+  Commands in the protocol include LOSTNET, which tells the remotedaemon+  that the network connection has been lost, and causes it to stop any TCP+  connctions. That can be followed by RESUME when the network connection+  comes back up.++* Also the [[git-annex-common-options]](1) can be used.  # SEE ALSO
doc/git-annex-renameremote.mdwn view
@@ -26,6 +26,10 @@ for the special remote to use the new name, but of course you can edit the git config if you want to rename it there. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-repair.mdwn view
@@ -44,6 +44,8 @@   Enable repair actions that involve deleting data that has been   lost due to git repository corruption. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-required.mdwn view
@@ -26,6 +26,10 @@ Also, `git-annex fsck` will warn about required contents that are not present. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # NOTES  The `required` command was added in git-annex 5.20150420.
doc/git-annex-resolvemerge.mdwn view
@@ -55,6 +55,10 @@ variant of the file and either rename it back to `bar`, or decide to delete it too. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-rmurl.mdwn view
@@ -26,6 +26,8 @@   Makes the `--batch` input be delimited by nulls instead of the usual   newlines. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-schedule.mdwn view
@@ -36,6 +36,10 @@ 	fsck self 1h on day 1 of every month at any time 	fsck self 1h every week divisible by 2 at any time +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-semitrust.mdwn view
@@ -13,6 +13,10 @@ Repositories can be specified using their remote name, their description, or their UUID. For the current repository, use "here". +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-setkey.mdwn view
@@ -14,6 +14,10 @@ It's generally a better idea to use [[git-annex-reinject]](1) instead of this command. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-setpresentkey.mdwn view
@@ -21,6 +21,8 @@   Enables batch mode, in which lines are read from stdin.   The line format is "key uuid [1|0]" +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-shell.mdwn view
@@ -109,6 +109,8 @@   git-annex uses this to specify the UUID of the repository it was expecting   git-annex-shell to access, as a sanity check. +* Also the [[git-annex-common-options]](1) can be used.+ * -- fields=val fields=val.. --    Additional fields may be specified this way, to retain compatibility with
doc/git-annex-smudge.mdwn view
@@ -51,6 +51,10 @@ you can manually run `git annex smudge --update` to update the working tree. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-status.mdwn view
@@ -31,6 +31,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-sync.mdwn view
@@ -175,6 +175,8 @@   around and still has the change in it. Cleaning up the `synced/` branches   prevents that problem. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-testremote.mdwn view
@@ -43,6 +43,8 @@    Tune the base size of generated objects. The default is 1MiB. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-transferkey.mdwn view
@@ -26,6 +26,8 @@   Provides a hint about the name of the file associated with the key.   (This name is only used in progress displays.) +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-transferkeys.mdwn view
@@ -16,6 +16,10 @@ to transfer using an internal stdio protocol, which is intentionally not documented (as it may change at any time). +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-trust.mdwn view
@@ -21,6 +21,10 @@ which trusts A to still contain the content, so the drop succeeds. Now the content has been lost. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-unannex.mdwn view
@@ -33,6 +33,8 @@   The [[git-annex-matching-options]](1)   can be used to specify files to unannex. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-undo.mdwn view
@@ -22,6 +22,10 @@ Note that this does not undo get/drop of a file's content; it only operates on the file tree committed to git. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-ungroup.mdwn view
@@ -10,6 +10,10 @@  Removes a repository from a group. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-uninit.mdwn view
@@ -12,6 +12,10 @@ repository, and remove all of git-annex's other data, leaving you with a git repository plus the previously annexed files. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-unlock.mdwn view
@@ -60,6 +60,8 @@   Messages that would normally be output to standard error are included in   the json instead. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-unregisterurl.mdwn view
@@ -26,6 +26,8 @@    When in batch mode, the input is delimited by nulls instead of the usual    newlines. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-untrust.mdwn view
@@ -14,6 +14,10 @@ Repositories can be specified using their remote name, their description, or their UUID. To untrust the current repository, use "here". +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-unused.mdwn view
@@ -9,7 +9,8 @@ # DESCRIPTION  Checks the annex for data that does not correspond to any files present-in any tag or branch, and prints a numbered list of the data.+in any tag or branch, or in the git index, and prints a numbered list+of the data.  After running this command, you can use the `--unused` option with many  other git-annex commands to operate on all the unused data that was found.@@ -33,14 +34,16 @@  * `--used-refspec=+ref:-ref` -  By default, any data that the work tree uses, or that any refs in the git+  By default, any data that the git index uses, or that any refs in the git   repository point to is considered to be used. If you only want to use   some refs, you can use this option to specify the ones to use. Data that-  is not in the specified refs (and not used by the work tree) will then be+  is not in the specified refs (and not used by the index) will then be   considered unused.    The git configuration annex.used-refspec can be used to configure   this in a more permanent fashion.++* Also the [[git-annex-common-options]](1) can be used.  # REFSPEC FORMAT
doc/git-annex-upgrade.mdwn view
@@ -31,6 +31,8 @@   Only do whatever automatic upgrade can be done, don't necessarily   upgrade to the latest version. This is used internally by git-annex. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-vadd.mdwn view
@@ -17,6 +17,10 @@ So will `vadd year=2014 year=2013`, but limiting the years in view to only those two. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-vcycle.mdwn view
@@ -13,6 +13,10 @@ For example, when the view is by year/author/tag, `vcycle` will switch it to author/tag/year. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-version.mdwn view
@@ -25,6 +25,8 @@    Causes only git-annex's version to be output, and nothing else. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-vfilter.mdwn view
@@ -11,6 +11,10 @@ Filters the current view to only the files that have the specified field values and tags. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-vicfg.mdwn view
@@ -15,6 +15,10 @@ Unlike git config settings, these configuration settings can be seen by all clones of the repository. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-view.mdwn view
@@ -36,6 +36,10 @@ so `field!="*"` will enter a view containing only files that do not have the field set to any value. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-vpop.mdwn view
@@ -13,6 +13,10 @@    The optional number tells how many views to pop. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-wanted.mdwn view
@@ -18,6 +18,10 @@ Without an expression, displays the current preferred content setting of the repository. +# OPTIONS++* The [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-watch.mdwn view
@@ -32,6 +32,8 @@    Stop a running daemon in the current repository. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex-webapp.mdwn view
@@ -28,6 +28,8 @@   Set annex.listen in the git config to make the webapp always   listen on an address. +* Also the [[git-annex-common-options]](1) can be used.+ # USING HTTPS  When using the webapp on a remote computer, you'll almost certainly
doc/git-annex-whereis.mdwn view
@@ -97,6 +97,8 @@   The same applies when the url variable is used and a file has multiple   recorded urls. +* Also the [[git-annex-common-options]](1) can be used.+ # SEE ALSO  [[git-annex]](1)
doc/git-annex.mdwn view
@@ -404,6 +404,12 @@      See [[git-annex-forget]](1) for details. +* `filter-branch`++  Produces a filtered version of the git-annex branch.+  +  See [[git-annex-filter-branch]](1) for details.+ * `repair`    This can repair many of the problems with git repositories that `git fsck`@@ -753,126 +759,6 @@ git-annex by dropping commands named like "git-annex-foo" into a directory in the PATH. -# COMMON OPTIONS--These common options are accepted by all git-annex commands, and-may not be explicitly listed on their individual man pages.-(Many commands also accept the [[git-annex-matching-options]](1).)--* `--force`--  Force unsafe actions, such as dropping a file's content when no other-  source of it can be verified to still exist, or adding ignored files.-  Use with care.--* `--fast`--  Enable less expensive, but also less thorough versions of some commands.-  What is avoided depends on the command.--* `--quiet`--  Avoid the default verbose display of what is done; only show errors.--* `--verbose`--  Enable verbose display.--* `--debug`--  Display debug messages.--* `--no-debug`--  Disable display of debug messages.--* `--debugfilter=name[,name..]`--  When debug message display has been enabled by `--debug`, this filters-  the debug messages that are displayed to ones coming from modules with-  the specified names.-  -  To find the names of modules, see the full debug output, which includes-  the module name, eg "(Utility.Process)"--  The full module name does not need to be-  specified when using this, a substring of the name will do.--  For example, `--debugfilter=Process,External` will display debugging-  output when git-annex runs processes, and when it communicates with-  external special remotes.--* `--numcopies=n`--  Overrides the numcopies setting.--  Note that setting numcopies to 0 is very unsafe.--* `--mincopies=n`--  Overrides the mincopies setting.--  Note that setting mincopies to 0 is very unsafe.--* `--time-limit=time`--  Limits how long a git-annex command runs. The time can be something-  like "5h", or "30m" or even "45s" or "10d".--  Note that git-annex may continue running a little past the specified-  time limit, in order to finish processing a file.--  Also, note that if the time limit prevents git-annex from doing all it-  was asked to, it will exit with a special code, 101.--* `--semitrust=repository`-* `--untrust=repository`--  Overrides trust settings for a repository. May be specified more than once.--  The repository should be specified using the name of a configured remote,-  or the UUID or description of a repository.--* `--trust=repository`--  This used to override trust settings for a repository, but now will-  not do so, because trusting a repository can lead to data loss,-  and data loss is now only enabled when using the `--force` option.--* `--trust-glacier`--  This used to override trust settings for Glacier special remotes,-  but now will not do so, because it could lead to data loss,-  and data loss is now only enabled when using the `--force` option.--* `--backend=name`--  Specifies which key-value backend to use. This can be used when-  adding a file to the annex, or migrating a file. Once files-  are in the annex, their backend is known and this option is not-  necessary.--* `--user-agent=value`--  Overrides the User-Agent to use when downloading files from the web.--* `--notify-finish`--  Caused a desktop notification to be displayed after each successful-  file download and upload.--  (Only supported on some platforms, e.g. Linux with dbus. A no-op when-  not supported.)--* `--notify-start`--  Caused a desktop notification to be displayed when a file upload-  or download has started, or when a file is dropped.--* `-c name=value`--  Overrides git configuration settings. May be specified multiple times.- # CONFIGURATION  Like other git commands, git-annex is configured via `.git/config`.@@ -1116,6 +1002,15 @@   ControlMaster and ControlPersist settings   (if built using a new enough ssh). To disable this, set to `false`. +* `annex.adviceNoSshCaching`++  When git-annex is unable to use ssh connection caching, or has been+  configured not to, and concurrency is enabled, it will warn that+  this might result in multiple ssh processes prompting for passwords+  at the same time. To disable that warning, eg if you have configured ssh+  connection caching yourself, or have ssh agent caching passwords, +  set this to `false`.+ * `annex.alwayscommit`    By default, git-annex automatically commits data to the git-annex branch@@ -1128,7 +1023,7 @@ * `annex.commitmessage`    When git-annex updates the git-annex branch, it usually makes up-  its own commit message ("update"), since users rarely look at or+  its own commit message (eg "update"), since users rarely look at or   care about changes to that branch. If you do care, you can   specify this setting by running commands with   `-c annex.commitmessage=whatever`@@ -1858,6 +1753,10 @@   seconds before adding a newly created file to the annex. Normally this   is not needed, because they already wait for all writers of the file   to close it.++  Note that this only delays adding files created while the daemon is+  running. Changes made when it is not running will be added the next time+  it is started up.  * `annex.expireunused`
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 8.20210428+Version: 8.20210621 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -394,6 +394,8 @@       GHC-Options: -O2 -optlo-O2     else       GHC-Options: -O2+  else+    GHC-Options: -O0    -- Avoid linking with unused dynamic libaries.   -- (Only tested on Linux).@@ -740,6 +742,7 @@     Command.ExamineKey     Command.Expire     Command.Export+    Command.FilterBranch     Command.Find     Command.FindRef     Command.Fix