git-annex 10.20220525 → 10.20220623

raw patch · 43 files changed

+415/−270 lines, 43 files

Files

• Annex/AdjustedBranch/Merge.hs +4/−5
• Annex/Content.hs +7/−10
• Annex/Content/PointerFile.hs +1/−1
• Annex/Ingest.hs +16/−32
• Annex/Init.hs +8/−7
• Annex/Journal.hs +4/−3
• Annex/Link.hs +7/−7
• Annex/Locations.hs +4/−8
• Annex/ReplaceFile.hs +3/−3
• Annex/SpecialRemote.hs +23/−8
• CHANGELOG +27/−0
• Command/Add.hs +105/−65
• Command/AddUnused.hs +1/−3
• Command/AddUrl.hs +3/−6
• Command/Fix.hs +7/−11
• Command/Fsck.hs +3/−3
• Command/Import.hs +6/−9
• Command/Info.hs +22/−1
• Command/Init.hs +7/−1
• Command/Lock.hs +1/−2
• Command/Move.hs +37/−17
• Command/ReKey.hs +1/−2
• Command/SetKey.hs +1/−1
• Database/Handle.hs +14/−6
• Database/Keys.hs +1/−1
• Database/Keys/Handle.hs +5/−4
• Database/Queue.hs +12/−8
• Git/Config.hs +7/−2
• Git/Repair.hs +1/−1
• Logs/Trust.hs +6/−2
• Remote/Borg.hs +1/−1
• Remote/GCrypt.hs +2/−2
• Remote/Git.hs +14/−15
• Remote/Helper/Chunked.hs +2/−2
• Remote/Rsync.hs +2/−2
• Utility/CopyFile.hs +4/−3
• Utility/IPAddress.hs +15/−1
• Utility/MoveFile.hs +15/−10
• Utility/RawFilePath.hs +4/−0
• doc/git-annex-info.mdwn +5/−0
• doc/git-annex-init.mdwn +5/−1
• doc/git-annex-smudge.mdwn +0/−1
• git-annex.cabal +2/−3

@@ -82,15 +82,14 @@ 				refs <- liftIO $ dirContentsRecursive $ 					git_dir' </> "refs" 				let refs' = (git_dir' </> "packed-refs") : refs-				liftIO $ forM_ refs' $ \src ->+				liftIO $ forM_ refs' $ \src -> do+					let src' = toRawFilePath src 					whenM (doesFileExist src) $ do-						dest <- relPathDirToFile git_dir-							(toRawFilePath src)+						dest <- relPathDirToFile git_dir src' 						let dest' = toRawFilePath tmpgit P.</> dest 						createDirectoryUnder git_dir 							(P.takeDirectory dest')-						void $ createLinkOrCopy src-							(fromRawFilePath dest')+						void $ createLinkOrCopy src' dest' 				-- This reset makes git merge not care 				-- that the work tree is empty; otherwise 				-- it will think that all the files have

@@ -410,9 +410,7 @@ 	storeobject dest = ifM (liftIO $ R.doesPathExist dest) 		( alreadyhave 		, adjustedBranchRefresh af $ modifyContentDir dest $ do-			liftIO $ moveFile-				(fromRawFilePath src)-				(fromRawFilePath dest)+			liftIO $ moveFile src dest 			-- Freeze the object file now that it is in place. 			-- Waiting until now to freeze it allows for freeze 			-- hooks that prevent moving the file.@@ -641,7 +639,7 @@   where 	-- Check associated pointer file for modifications, and reset if 	-- it's unmodified.-	resetpointer file = unlessM (liftIO $ isSymbolicLink <$> getSymbolicLinkStatus (fromRawFilePath file)) $+	resetpointer file = unlessM (liftIO $ isSymbolicLink <$> R.getSymbolicLinkStatus file) $ 		ifM (isUnmodified key file) 			( adjustedBranchRefresh (AssociatedFile (Just file)) $ 				depopulatePointerFile key file@@ -654,17 +652,16 @@  {- Moves a key out of .git/annex/objects/ into .git/annex/bad, and  - returns the file it was moved to. -}-moveBad :: Key -> Annex FilePath+moveBad :: Key -> Annex RawFilePath moveBad key = do 	src <- calcRepo (gitAnnexLocation key) 	bad <- fromRepo gitAnnexBadDir 	let dest = bad P.</> P.takeFileName src-	let dest' = fromRawFilePath dest 	createAnnexDirectory (parentDir dest) 	cleanObjectLoc key $-		liftIO $ moveFile (fromRawFilePath src) dest'+		liftIO $ moveFile src dest 	logStatus key InfoMissing-	return dest'+	return dest  data KeyLocation = InAnnex | InAnywhere @@ -898,12 +895,12 @@ 		then KeyUnlockedThin 		else KeyPresent -getKeyFileStatus :: Key -> FilePath -> Annex KeyStatus+getKeyFileStatus :: Key -> RawFilePath -> Annex KeyStatus getKeyFileStatus key file = do 	s <- getKeyStatus key 	case s of 		KeyUnlockedThin -> catchDefaultIO KeyUnlockedThin $-			ifM (isJust <$> isAnnexLink (toRawFilePath file))+			ifM (isJust <$> isAnnexLink file) 				( return KeyLockedThin 				, return KeyUnlockedThin 				)

@@ -68,5 +68,5 @@ 			(\t -> touch tmp' t False) 			(fmap Posix.modificationTimeHiRes st) #endif-		withTSDelta (liftIO . genInodeCache (toRawFilePath tmp))+		withTSDelta (liftIO . genInodeCache tmp') 	maybe noop (restagePointerFile (Restage True) file) ic

@@ -1,6 +1,6 @@ {- git-annex content ingestion  -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -16,7 +16,7 @@ 	ingest', 	finishIngestUnlocked, 	cleanOldKeys,-	addLink,+	addSymlink, 	makeLink, 	addUnlocked, 	CheckGitIgnore(..),@@ -37,7 +37,6 @@ import Annex.CheckIgnore import Logs.Location import qualified Annex-import qualified Annex.Queue import qualified Database.Keys import Config import Utility.InodeCache@@ -145,19 +144,19 @@  {- Ingests a locked down file into the annex. Updates the work tree and  - index. -}-ingestAdd :: CheckGitIgnore -> MeterUpdate -> Maybe LockedDown -> Annex (Maybe Key)-ingestAdd ci meterupdate ld = ingestAdd' ci meterupdate ld Nothing+ingestAdd :: MeterUpdate -> Maybe LockedDown -> Annex (Maybe Key)+ingestAdd meterupdate ld = ingestAdd' meterupdate ld Nothing -ingestAdd' :: CheckGitIgnore -> MeterUpdate -> Maybe LockedDown -> Maybe Key -> Annex (Maybe Key)-ingestAdd' _ _ Nothing _ = return Nothing-ingestAdd' ci meterupdate ld@(Just (LockedDown cfg source)) mk = do+ingestAdd' :: MeterUpdate -> Maybe LockedDown -> Maybe Key -> Annex (Maybe Key)+ingestAdd' _ Nothing _ = return Nothing+ingestAdd' meterupdate ld@(Just (LockedDown cfg source)) mk = do 	(mk', mic) <- ingest meterupdate ld mk 	case mk' of 		Nothing -> return Nothing 		Just k -> do 			let f = keyFilename source 			if lockingFile cfg-				then addLink ci f k mic+				then addSymlink f k mic 				else do 					mode <- liftIO $ catchMaybeIO $ 						fileMode <$> R.getFileStatus (contentLocation source)@@ -314,26 +313,11 @@   where 	file' = fromRawFilePath file -{- Creates the symlink to the annexed content, and stages it in git.- -- - As long as the filesystem supports symlinks, we use- - git add, rather than directly staging the symlink to git.- - Using git add is best because it allows the queuing to work- - and is faster (staging the symlink runs hash-object commands each time).- - Also, using git add allows it to skip gitignored files, unless forced- - to include them.- -}-addLink :: CheckGitIgnore -> RawFilePath -> Key -> Maybe InodeCache -> Annex ()-addLink ci file key mcache = ifM (coreSymlinks <$> Annex.getGitConfig)-	( do-		_ <- makeLink file key mcache-		ps <- gitAddParams ci-		Annex.Queue.addCommand [] "add" (ps++[Param "--"])-			[fromRawFilePath file]-	, do-		l <- makeLink file key mcache-		addAnnexLink l file-	)+{- Creates the symlink to the annexed content, and stages it in git. -}+addSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex ()+addSymlink file key mcache = do+	linktarget <- makeLink file key mcache+	stageSymlink file =<< hashSymlink linktarget  {- Parameters to pass to git add, forcing addition of ignored files.  -@@ -375,8 +359,8 @@  -  - When the content of the key is not accepted into the annex, returns False.  -}-addAnnexedFile :: CheckGitIgnore -> AddUnlockedMatcher -> RawFilePath -> Key -> Maybe RawFilePath -> Annex Bool-addAnnexedFile ci matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mtmp))+addAnnexedFile :: AddUnlockedMatcher -> RawFilePath -> Key -> Maybe RawFilePath -> Annex Bool+addAnnexedFile matcher file key mtmp = ifM (addUnlocked matcher mi (isJust mtmp)) 	( do 		mode <- maybe 			(pure Nothing)@@ -394,7 +378,7 @@ 				, writepointer mode >> return True 				) 	, do-		addLink ci file key Nothing+		addSymlink file key Nothing 		case mtmp of 			Just tmp -> moveAnnex key af tmp 			Nothing -> return True

@@ -229,19 +229,20 @@ 	return (not exists)  guardSafeToUseRepo :: Annex a -> Annex a-guardSafeToUseRepo a = do-	repopath <- fromRepo Git.repoPath-	ifM (inRepo Git.Config.checkRepoConfigInaccessible)-		( giveup $ unlines $+guardSafeToUseRepo a = ifM (inRepo Git.Config.checkRepoConfigInaccessible)+	( do+		repopath <- fromRepo Git.repoPath+		p <- liftIO $ absPath repopath+		giveup $ unlines $ 			[ "Git refuses to operate in this repository," 			, "probably because it is owned by someone else." 			, "" 			-- This mirrors git's wording. 			, "To add an exception for this directory, call:"-			, "\tgit config --global --add safe.directory " ++ fromRawFilePath repopath+			, "\tgit config --global --add safe.directory " ++ fromRawFilePath p 			]-		, a-		)+	, a+	)  {- Initialize if it can do so automatically. Avoids failing if it cannot.  -

@@ -84,10 +84,11 @@ 	createAnnexDirectory jd 	-- journal file is written atomically 	let jfile = journalFile file-	let tmpfile = fromRawFilePath (tmp P.</> jfile)+	let tmpfile = tmp P.</> jfile 	liftIO $ do-		withFile tmpfile WriteMode $ \h -> writeJournalHandle h content-		moveFile tmpfile (fromRawFilePath (jd P.</> jfile))+		withFile (fromRawFilePath tmpfile) WriteMode $ \h ->+			writeJournalHandle h content+		moveFile tmpfile (jd P.</> jfile)  data JournalledContent 	= NoJournalledContent

@@ -147,7 +147,7 @@ writePointerFile :: RawFilePath -> Key -> Maybe FileMode -> IO () writePointerFile file k mode = do 	S.writeFile (fromRawFilePath file) (formatPointer k)-	maybe noop (setFileMode $ fromRawFilePath file) mode+	maybe noop (R.setFileMode file) mode  newtype Restage = Restage Bool @@ -218,10 +218,10 @@ 		    showwarning = warning $ unableToRestage Nothing 		    go Nothing = showwarning 		    go (Just _) = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex" $ \tmpdir -> do-			let tmpindex = tmpdir </> "index"+			let tmpindex = toRawFilePath (tmpdir </> "index") 			let updatetmpindex = do 				r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv-					=<< Git.Index.indexEnvVal (toRawFilePath tmpindex)+					=<< Git.Index.indexEnvVal tmpindex 				-- Avoid git warning about CRLF munging. 				let r'' = r' { gitGlobalOpts = gitGlobalOpts r' ++ 					[ Param "-c"@@ -233,9 +233,9 @@ 							whenM checkunmodified $ 								feed f' 			let replaceindex = catchBoolIO $ do-				moveFile tmpindex (fromRawFilePath realindex)+				moveFile tmpindex realindex 				return True-			ok <- liftIO (createLinkOrCopy (fromRawFilePath realindex) tmpindex)+			ok <- liftIO (createLinkOrCopy realindex tmpindex) 				<&&> updatetmpindex 				<&&> liftIO replaceindex 			unless ok showwarning@@ -362,7 +362,7 @@ formatPointer :: Key -> S.ByteString formatPointer k = prefix <> keyFile k <> nl   where-	prefix = toInternalGitPath $ P.pathSeparator `S.cons` objectDir'+	prefix = toInternalGitPath $ P.pathSeparator `S.cons` objectDir 	nl = S8.singleton '\n'  {- Maximum size of a file that could be a pointer to a key.@@ -430,7 +430,7 @@ 	|| p' `S.isInfixOf` s #endif   where-	p = P.pathSeparator `S.cons` objectDir'+	p = P.pathSeparator `S.cons` objectDir #ifdef mingw32_HOST_OS 	p' = toInternalGitPath p #endif

@@ -14,7 +14,6 @@ 	keyPath, 	annexDir, 	objectDir,-	objectDir', 	gitAnnexLocation, 	gitAnnexLocation', 	gitAnnexLocationDepth,@@ -133,11 +132,8 @@  {- The directory git annex uses for locally available object content,  - relative to the .git directory -}-objectDir :: FilePath-objectDir = fromRawFilePath objectDir'--objectDir' :: RawFilePath-objectDir' = P.addTrailingPathSeparator $ annexDir P.</> "objects"+objectDir :: RawFilePath+objectDir = P.addTrailingPathSeparator $ annexDir P.</> "objects"  {- Annexed file's possible locations relative to the .git directory  - in a non-bare repository.@@ -155,7 +151,7 @@ 	map (annexLocation config key) [hashDirLower, hashDirMixed]  annexLocation :: GitConfig -> Key -> (HashLevels -> Hasher) -> RawFilePath-annexLocation config key hasher = objectDir' P.</> keyPath key (hasher $ objectHashLevels config)+annexLocation config key hasher = objectDir P.</> keyPath key (hasher $ objectHashLevels config)  {- Number of subdirectories from the gitAnnexObjectDir  - to the gitAnnexLocation. -}@@ -268,7 +264,7 @@ {- The part of the annex directory where file contents are stored. -} gitAnnexObjectDir :: Git.Repo -> RawFilePath gitAnnexObjectDir r = P.addTrailingPathSeparator $-	Git.localGitDir r P.</> objectDir'+	Git.localGitDir r P.</> objectDir  {- .git/annex/tmp/ is used for temp files for key's contents -} gitAnnexTmpObjectDir :: Git.Repo -> RawFilePath

@@ -75,13 +75,13 @@ 		let tmpfile = tmpdir </> basetmp 		r <- action tmpfile 		when (checkres r) $-			replaceFileFrom tmpfile file createdirectory+			replaceFileFrom (toRawFilePath tmpfile) (toRawFilePath file) createdirectory 		return r -replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex ()+replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex () replaceFileFrom src dest createdirectory = go `catchIO` fallback   where 	go = liftIO $ moveFile src dest 	fallback _ = do-		createdirectory (parentDir (toRawFilePath dest))+		createdirectory (parentDir dest) 		go

@@ -63,7 +63,10 @@ specialRemoteMap :: Annex (M.Map UUID RemoteName) specialRemoteMap = do 	m <- Logs.Remote.remoteConfigMap-	return $ M.fromList $ mapMaybe go (M.toList m)+	return $ specialRemoteNameMap m++specialRemoteNameMap :: M.Map UUID RemoteConfig -> M.Map UUID RemoteName+specialRemoteNameMap = M.fromList . mapMaybe go . M.toList   where 	go (u, c) = case lookupName c of 		Nothing -> Nothing@@ -85,14 +88,14 @@  autoEnable :: Annex () autoEnable = do-	remotemap <- M.filter configured <$> remoteConfigMap+	m <- autoEnableable 	enabled <- getenabledremotes-	forM_ (M.toList remotemap) $ \(cu, c) -> unless (cu `M.member` enabled) $ do+	forM_ (M.toList m) $ \(cu, c) -> unless (cu `M.member` enabled) $ do 		let u = case findSameasUUID c of 			Just (Sameas u') -> u' 			Nothing -> cu 		case (lookupName c, findType c) of-			(Just name, Right t) -> whenM (canenable u) $ do+			(Just name, Right t) -> do 				showSideAction $ "Auto enabling special remote " ++ name 				dummycfg <- liftIO dummyRemoteGitConfig 				tryNonAsync (setup t (AutoEnable c) (Just u) Nothing c dummycfg) >>= \case@@ -102,13 +105,25 @@ 							setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu) 			_ -> return ()   where-	configured rc = fromMaybe False $-		trueFalseParser' . fromProposedAccepted-			=<< M.lookup autoEnableField rc-	canenable u = (/= DeadTrusted) <$> lookupTrust u 	getenabledremotes = M.fromList 		. map (\r -> (getcu r, r)) 		<$> remoteList 	getcu r = fromMaybe 		(Remote.uuid r) 		(remoteAnnexConfigUUID (Remote.gitconfig r))++autoEnableable :: Annex (M.Map UUID RemoteConfig)+autoEnableable = do+	tm <- trustMap+	(M.filterWithKey (notdead tm) . M.filter configured)+		<$> remoteConfigMap+  where+	configured c = fromMaybe False $+		trueFalseParser' . fromProposedAccepted+			=<< M.lookup autoEnableField c+	notdead tm cu c = +		let u = case findSameasUUID c of+			Just (Sameas u') -> u'+			Nothing -> cu+		in lookupTrust' u tm /= DeadTrusted+

@@ -1,3 +1,30 @@+git-annex (10.20220623) upstream; urgency=medium++  * init: Added --no-autoenable option.+  * info: Added --autoenable option.+  * initremote: Improve handling of type=git special remotes.+    The location value no longer needs to match the url of an existing+    git remote, and locations not using ssh:// will work now, including+    both paths and host:/path+  * Fix retrival of an empty file that is stored in a special remote with +    chunking enabled.+    (Fixes a reversion in 8.20201103)+  * move: Improve resuming a move that succeeded in transferring the+    content, but where dropping failed due to eg a network problem, +    in cases where numcopies checks prevented the resumed+    move from dropping the object from the source repository.+  * add, fix, lock, rekey: When several files were being processed, +    replacing an annex symlink of a file that was already processed+    with a new large file could sometimes cause that large file to be+    added to git. These races have been fixed.+  * add: Also fix a similar race that could cause a large file be added+    to git when a small file was modified or overwritten while it was+    being added.+  * add --batch: Fix handling of a file that is skipped due to being+    gitignored.++ -- Joey Hess <id@joeyh.name>  Thu, 23 Jun 2022 13:31:22 -0400+ git-annex (10.20220525) upstream; urgency=medium    * Special remotes with importtree=yes or exporttree=yes are once again

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -17,15 +17,21 @@ import Annex.FileMatcher import Annex.Link import Annex.Tmp+import Annex.HashObject import Messages.Progress import Git.FilePath+import Git.Types+import Git.UpdateIndex import Config.GitConfig-import Config.Smudge import Utility.OptParse import Utility.InodeCache import Annex.InodeSentinal+import Annex.CheckIgnore import qualified Utility.RawFilePath as R+import qualified System.FilePath.ByteString as P +import System.PosixCompat.Files+ cmd :: Command cmd = notBareRepo $  	withGlobalOptions opts $@@ -79,26 +85,31 @@ 	addunlockedmatcher <- addUnlockedMatcher 	annexdotfiles <- getGitConfigVal annexDotFiles  	let gofile includingsmall (si, file) = case largeFilesOverride o of-		Nothing -> +		Nothing -> do+			s <- liftIO $ R.getSymbolicLinkStatus file 			ifM (pure (annexdotfiles || not (dotfile file)) 				<&&> (checkFileMatcher largematcher file  				<||> Annex.getState Annex.force))-				( start o si file addunlockedmatcher+				( start si file addunlockedmatcher 				, if includingsmall 					then ifM (annexAddSmallFiles <$> Annex.getGitConfig)-						( startSmall o si file+						( startSmall si file s 						, stop 						) 					else stop 				)-		Just True -> start o si file addunlockedmatcher-		Just False -> startSmallOverridden o si file+		Just True -> start si file addunlockedmatcher+		Just False -> startSmallOverridden si file 	case batchOption o of 		Batch fmt 			| updateOnly o -> 				giveup "--update --batch is not supported" 			| otherwise -> batchOnly Nothing (addThese o) $-				batchFiles fmt (gofile True)+				batchFiles fmt $ \v@(_si, file) -> +					ifM (checkIgnored (checkGitIgnoreOption o) file)+						( stop+						, gofile True v+						) 		NoBatch -> do 			-- Avoid git ls-files complaining about files that 			-- are not known to git yet, since this will add@@ -116,78 +127,107 @@ 			go False withUnmodifiedUnlockedPointers  {- Pass file off to git-add. -}-startSmall :: AddOptions -> SeekInput -> RawFilePath -> CommandStart-startSmall o si file =+startSmall :: SeekInput -> RawFilePath -> FileStatus -> CommandStart+startSmall si file s = 	starting "add" (ActionItemTreeFile file) si $-		next $ addSmall (checkGitIgnoreOption o) file+		next $ addSmall file s -addSmall :: CheckGitIgnore -> RawFilePath -> Annex Bool-addSmall ci file = do+addSmall :: RawFilePath -> FileStatus -> Annex Bool+addSmall file s = do 	showNote "non-large file; adding content to git repository"-	addFile Small ci file+	addFile Small file s -startSmallOverridden :: AddOptions -> SeekInput -> RawFilePath -> CommandStart-startSmallOverridden o si file = -	starting "add" (ActionItemTreeFile file) si $ next $ do-		showNote "adding content to git repository"-		addFile Small (checkGitIgnoreOption o) file+startSmallOverridden :: SeekInput -> RawFilePath -> CommandStart+startSmallOverridden si file = +	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case+		Just s -> starting "add" (ActionItemTreeFile file) si $ next $ do+			+			showNote "adding content to git repository"+			addFile Small file s+		Nothing -> stop  data SmallOrLarge = Small | Large -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--start :: AddOptions -> SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart-start o si file addunlockedmatcher = do-	mk <- liftIO $ isPointerFile file-	maybe go fixuppointer mk+addFile :: SmallOrLarge -> RawFilePath -> FileStatus -> Annex Bool+addFile smallorlarge file s = do+	sha <- if isSymbolicLink s+		then hashBlob =<< liftIO (R.readSymbolicLink file)+		else if isRegularFile s+			then hashFile file+			else giveup $ fromRawFilePath file ++ " is not a regular file"+	let treetype = if isSymbolicLink s+		then TreeSymlink+		else if intersectFileModes ownerExecuteMode (fileMode s) /= 0+			then TreeExecutable+			else TreeFile+	s' <- liftIO $ catchMaybeIO $ R.getSymbolicLinkStatus file+	if maybe True (changed s) s'+		then do+			warning $ fromRawFilePath file ++ " changed while it was being added"+			return False+		else do+			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.+				Small -> maybe noop Database.Keys.removeInodeCache+					=<< withTSDelta (liftIO . genInodeCache file)+				Large -> noop+			Annex.Queue.addUpdateIndex =<<+				inRepo (stageFile sha treetype (fromRawFilePath file))+			return True   where-	go = ifAnnexed file addpresent add-	add = liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case+	changed a b =+		deviceID a /= deviceID b ||+		fileID a /= fileID b ||+		fileSize a /= fileSize b ||+		modificationTime a /= modificationTime b ||+		isRegularFile a /= isRegularFile b ||+		isSymbolicLink a /= isSymbolicLink b++start :: SeekInput -> RawFilePath -> AddUnlockedMatcher -> CommandStart+start si file addunlockedmatcher = +	liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case 		Nothing -> stop-		Just s +		Just s 			| not (isRegularFile s) && not (isSymbolicLink s) -> stop-			| otherwise -> -				starting "add" (ActionItemTreeFile file) si $-					if isSymbolicLink s-						then next $ addFile Small (checkGitIgnoreOption o) file-						else perform o file addunlockedmatcher-	addpresent key = -		liftIO (catchMaybeIO $ R.getSymbolicLinkStatus file) >>= \case-			Just s | isSymbolicLink s -> fixuplink key-			_ -> add+			| otherwise -> do+				mk <- liftIO $ isPointerFile file+				maybe (go s) (fixuppointer s) mk+  where+	go s = ifAnnexed file (addpresent s) (add s)+	add s = starting "add" (ActionItemTreeFile file) si $+		if isSymbolicLink s+			then next $ addFile Small file s+			else perform file addunlockedmatcher+	addpresent s key+		| isSymbolicLink s = fixuplink key+		| otherwise = add s 	fixuplink key =  		starting "add" (ActionItemTreeFile file) si $-			addingExistingLink file key $ do-				liftIO $ removeFile (fromRawFilePath file)-				addLink (checkGitIgnoreOption o) file key Nothing-				next $ cleanup key =<< inAnnex key-	fixuppointer key =+			addingExistingLink file key $+				withOtherTmp $ \tmp -> do+					let tmpf = tmp P.</> file+					liftIO $ moveFile file tmpf+					ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf))+						( do+							liftIO $ R.removeLink tmpf+							addSymlink file key Nothing+							next $ cleanup key =<< inAnnex key+						, do+							liftIO $ moveFile tmpf file+							next $ return True+						)+	fixuppointer s key = 		starting "add" (ActionItemTreeFile file) si $ 			addingExistingLink file key $ do 				Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath file)-				next $ addFile Large (checkGitIgnoreOption o) file+				next $ addFile Large file s -perform :: AddOptions -> RawFilePath -> AddUnlockedMatcher -> CommandPerform-perform o file addunlockedmatcher = withOtherTmp $ \tmpdir -> do+perform :: RawFilePath -> AddUnlockedMatcher -> CommandPerform+perform file addunlockedmatcher = withOtherTmp $ \tmpdir -> do 	lockingfile <- not <$> addUnlocked addunlockedmatcher 		(MatchingFile (FileInfo file file Nothing)) 		True@@ -199,7 +239,7 @@ 	ld <- lockDown cfg (fromRawFilePath file) 	let sizer = keySource <$> ld 	v <- metered Nothing sizer Nothing $ \_meter meterupdate ->-		ingestAdd (checkGitIgnoreOption o) meterupdate ld+		ingestAdd meterupdate ld 	finish v   where 	finish (Just key) = next $ cleanup key True

@@ -30,9 +30,7 @@ perform :: Key -> CommandPerform perform key = next $ do 	logStatus key InfoPresent-	-- Ignore the usual git ignores because the user has explictly-	-- asked to add these files.-	addLink (CheckGitIgnore False) file key Nothing+	addSymlink file key Nothing 	return True   where 	file = "unused." <> keyFile key

@@ -453,6 +453,7 @@ addWorkTree _ addunlockedmatcher u url file key mtmp = case mtmp of 	Nothing -> go 	Just tmp -> do+		s <- liftIO $ R.getSymbolicLinkStatus tmp 		-- Move to final location for large file check. 		pruneTmpWorkDirBefore tmp $ \_ -> do 			createWorkTreeDirectory (P.takeDirectory file)@@ -470,22 +471,18 @@ 					(fromRawFilePath file) 					(fromRawFilePath tmp) 				go-			else void $ Command.Add.addSmall noci file+			else void $ Command.Add.addSmall file s   where 	go = do 		maybeShowJSON $ JSONChunk [("key", serializeKey key)] 		setUrlPresent key url 		logChange key u InfoPresent-		ifM (addAnnexedFile noci addunlockedmatcher file key mtmp)+		ifM (addAnnexedFile addunlockedmatcher file key mtmp) 			( do 				when (isJust mtmp) $ 					logStatus key InfoPresent 			, maybe noop (\tmp -> pruneTmpWorkDirBefore tmp (liftIO . removeWhenExistsWith R.removeLink)) mtmp 			)-	-	-- git does not need to check ignores, because that has already-	-- been done, as witnessed by the CannAddFile.-	noci = CheckGitIgnore False  nodownloadWeb :: AddUnlockedMatcher -> DownloadOptions -> URLString -> Url.UrlInfo -> RawFilePath -> Annex (Maybe Key) nodownloadWeb addunlockedmatcher o url urlinfo file

@@ -15,7 +15,7 @@ import Annex.ReplaceFile import Annex.Content import Annex.Perms-import qualified Annex.Queue+import Annex.Link import qualified Database.Keys import qualified Utility.RawFilePath as R @@ -97,15 +97,11 @@ 	mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes 		<$> R.getSymbolicLinkStatus file #endif-	createWorkTreeDirectory (parentDir file)-	liftIO $ R.removeLink file-	liftIO $ R.createSymbolicLink link file+	replaceWorkTreeFile (fromRawFilePath file) $ \tmpfile -> do+		let tmpfile' = toRawFilePath tmpfile+		liftIO $ R.createSymbolicLink link tmpfile' #if ! defined(mingw32_HOST_OS)-	liftIO $ maybe noop (\t -> touch file t False) mtime+		liftIO $ maybe noop (\t -> touch tmpfile' t False) mtime #endif-	next $ cleanupSymlink (fromRawFilePath file)--cleanupSymlink :: FilePath -> CommandCleanup-cleanupSymlink file = do-	Annex.Queue.addCommand [] "add" [Param "--force", Param "--"] [file]-	return True+	stageSymlink file =<< hashSymlink link+	next $ return True

@@ -132,7 +132,7 @@  perform :: Key -> RawFilePath -> Backend -> NumCopies -> Annex Bool perform key file backend numcopies = do-	keystatus <- getKeyFileStatus key (fromRawFilePath file)+	keystatus <- getKeyFileStatus key file 	check 		-- order matters 		[ fixLink key file@@ -613,7 +613,7 @@ badContent :: Key -> Annex String badContent key = do 	dest <- moveBad key-	return $ "moved to " ++ dest+	return $ "moved to " ++ fromRawFilePath dest  {- Bad content is dropped from the remote. We have downloaded a copy  - from the remote to a temp file already (in some cases, it's just a@@ -633,7 +633,7 @@ 				ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy) 					( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad' 					, do-						moveFile (fromRawFilePath localcopy) destbad'+						moveFile localcopy destbad 						return True 					) 		)

@@ -207,12 +207,8 @@ 					(fromRawFilePath destfile) 				return $ removeWhenExistsWith R.removeLink destfile 			else do-				moveFile -					(fromRawFilePath srcfile)-					(fromRawFilePath destfile)-				return $ moveFile-					(fromRawFilePath destfile)-					(fromRawFilePath srcfile)+				moveFile srcfile destfile+				return $ moveFile destfile srcfile 		-- Make sure that the dest file has its write permissions 		-- removed; the src file normally already did, but may 		-- have imported it from a filesystem that does not allow@@ -229,7 +225,8 @@ 		-- weakly the same as the originally locked down file's 		-- inode cache. (Since the file may have been copied, 		-- its inodes may not be the same.)-		newcache <- withTSDelta $ liftIO . genInodeCache destfile+		s <- liftIO $ R.getSymbolicLinkStatus destfile+		newcache <- withTSDelta $ \d -> liftIO $ toInodeCache d destfile s 		let unchanged = case (newcache, inodeCache (keySource ld)) of 			(_, Nothing) -> True 			(Just newc, Just c) | compareWeak c newc -> True@@ -246,11 +243,11 @@ 				} 			} 		ifM (checkFileMatcher largematcher destfile)-			( ingestAdd' (checkGitIgnoreOption o) nullMeterUpdate (Just ld') (Just k)+			( ingestAdd' nullMeterUpdate (Just ld') (Just k) 				>>= maybe 					stop 					(\addedk -> next $ Command.Add.cleanup addedk True)-			, next $ Command.Add.addSmall (checkGitIgnoreOption o) destfile+			, next $ Command.Add.addSmall destfile s 			) 	notoverwriting why = do 		warning $ "not overwriting existing " ++ fromRawFilePath destfile ++ " " ++ why

@@ -22,6 +22,7 @@ import qualified Annex import qualified Remote import qualified Types.Remote as Remote+import qualified Annex.SpecialRemote as SpecialRemote import Utility.DataUnits import Utility.DiskFree import Annex.Content@@ -105,6 +106,7 @@ 	{ infoFor :: CmdParams 	, bytesOption :: Bool 	, batchOption :: BatchMode+	, autoenableOption :: Bool 	}  optParser :: CmdParamsDesc -> Parser InfoOptions@@ -115,6 +117,10 @@ 		<> help "display file sizes in bytes" 		) 	<*> parseBatchOption False+	<*> switch+		( long "autoenable"+		<> help "list special remotes that are configured to autoenable"+		)  seek :: InfoOptions -> CommandSeek seek o = case batchOption o of@@ -124,7 +130,9 @@  start :: InfoOptions -> [String] -> CommandStart start o [] = do-	globalInfo o+	if autoenableOption o+		then autoenableInfo+		else globalInfo o 	stop start o ps = do 	mapM_ (\p -> itemInfo o (SeekInput [p], p)) ps@@ -139,6 +147,19 @@ 	showCustom "info" (SeekInput []) $ do 		evalStateT (mapM_ showStat stats) (emptyStatInfo o) 		return True++autoenableInfo :: Annex ()+autoenableInfo = showCustom "info" (SeekInput []) $ do+	m <- SpecialRemote.specialRemoteNameMap+		<$> SpecialRemote.autoEnableable+	descm <- M.unionWith Remote.addName+		<$> uuidDescMap+		<*> pure (M.map toUUIDDesc m)+	s <- Remote.prettyPrintUUIDsDescs+		"autoenable special remotes"+		descm (M.keys m)+	showRaw (encodeBS s)+	return True  itemInfo :: InfoOptions -> (SeekInput, String) -> Annex () itemInfo o (si, p) = ifM (isdir p)

@@ -25,6 +25,7 @@ 	{ initDesc :: String 	, initVersion :: Maybe RepoVersion 	, autoEnableOnly :: Bool+	, noAutoEnable :: Bool 	}  optParser :: CmdParamsDesc -> Parser InitOptions@@ -38,6 +39,10 @@ 		( long "autoenable" 		<> help "only enable special remotes configured with autoenable=true" 		)+	<*> switch+		( long "no-autoenable"+		<> help "do not enable special remotes configured with autoenable=true"+		)  parseRepoVersion :: MonadFail m => String -> m RepoVersion parseRepoVersion s = case RepoVersion <$> readish s of@@ -73,7 +78,8 @@ 	initialize False 		(if null (initDesc os) then Nothing else Just (initDesc os)) 		(initVersion os)-	Annex.SpecialRemote.autoEnable+	unless (noAutoEnable os)+		Annex.SpecialRemote.autoEnable 	next $ return True  performAutoEnableOnly :: CommandPerform

@@ -60,8 +60,7 @@ perform :: RawFilePath -> Key -> CommandPerform perform file key = do 	lockdown =<< calcRepo (gitAnnexLocation key)-	addLink (CheckGitIgnore False) file key-		=<< withTSDelta (liftIO . genInodeCache file)+	addSymlink file key =<< withTSDelta (liftIO . genInodeCache file) 	next $ return True   where 	lockdown obj = do

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -150,6 +150,7 @@ 				then finish deststartedwithcopy $ 					Remote.logStatus dest key InfoPresent 				else do+					logMoveCleanup deststartedwithcopy 					when fastcheck $ 						warning "This could have failed because --fast is enabled." 					stop@@ -162,10 +163,11 @@ 	finish deststartedwithcopy setpresentremote = case removewhen of 		RemoveNever -> do 			setpresentremote+			logMoveCleanup deststartedwithcopy 			next $ return True 		RemoveSafe -> lockContentForRemoval key lockfailed $ \contentlock -> do 			srcuuid <- getUUID-			willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case+			r <- willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case 				DropAllowed -> drophere setpresentremote contentlock "moved" 				DropCheckNumCopies -> do 					(numcopies, mincopies) <- getSafestNumMinCopies afile key@@ -176,6 +178,8 @@ 						 (drophere setpresentremote contentlock . showproof) 						 (faileddrophere setpresentremote) 				DropWorse -> faileddrophere setpresentremote+			logMoveCleanup deststartedwithcopy+			return r 	showproof proof = "proof: " ++ show proof 	drophere setpresentremote contentlock reason = do 		fastDebug "Command.Move" $ unwords@@ -240,35 +244,42 @@ 	get = notifyTransfer Download afile $ 		download src key afile stdRetry 	-	dispatch _ _ False = stop -- failed-	dispatch RemoveNever _ True = next $ return True -- copy complete+	dispatch _ deststartedwithcopy False = do+		logMoveCleanup deststartedwithcopy+		stop -- copy failed+	dispatch RemoveNever deststartedwithcopy True = do+		logMoveCleanup deststartedwithcopy+		next $ return True -- copy complete 	dispatch RemoveSafe deststartedwithcopy True = lockContentShared key $ \_lck -> do 		destuuid <- getUUID 		willDropMakeItWorse srcuuid destuuid deststartedwithcopy key afile >>= \case-			DropAllowed -> dropremote "moved"+			DropAllowed -> dropremote deststartedwithcopy "moved" 			DropCheckNumCopies -> do 				(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-			DropWorse -> faileddropremote		+					tocheck (dropremote deststartedwithcopy . showproof) (faileddropremote deststartedwithcopy)+			DropWorse -> faileddropremote deststartedwithcopy 	 	srcuuid = Remote.uuid src 	 	showproof proof = "proof: " ++ show proof 	-	dropremote reason = do+	dropremote deststartedwithcopy reason = do 		fastDebug "Command.Move" $ unwords 			[ "Dropping from remote" 			, show src 			, "(" ++ reason ++ ")" 			] 		ok <- Remote.action (Remote.removeKey src key)+		when ok $+			logMoveCleanup deststartedwithcopy 		next $ Command.Drop.cleanupRemote key src (Command.Drop.DroppingUnused False) ok 	-	faileddropremote = do+	faileddropremote deststartedwithcopy = do 		showLongNote "(Use --force to override this check, or adjust numcopies.)" 		showLongNote $ "Content not dropped from " ++ Remote.name src ++ "."+		logMoveCleanup deststartedwithcopy 		next $ return False  {- Moves (or copies) the content of an annexed file from reachable remotes@@ -312,7 +323,7 @@  - repository already had a copy of the file before the move began.  -} willDropMakeItWorse :: UUID -> UUID -> DestStartedWithCopy -> Key -> AssociatedFile -> Annex DropCheck-willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy) key afile =+willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy _) key afile = 	ifM (Command.Drop.checkRequiredContent (Command.Drop.PreferredContentChecked False) srcuuid key afile) 		( if deststartedwithcopy 			then unlessforced DropCheckNumCopies@@ -334,10 +345,18 @@  data DropCheck = DropWorse | DropAllowed | DropCheckNumCopies -newtype DestStartedWithCopy = DestStartedWithCopy Bool+data DestStartedWithCopy = DestStartedWithCopy Bool (Annex ()) +{- This should be called once the move has succeeded, or if it failed+ - without doing anything. It should not be called if the move transferred+ - the content but failed to drop due to eg a network error. In such a+ - case, the move can be restarted later, so the move log should be+ - preserved. -}+logMoveCleanup :: DestStartedWithCopy -> Annex ()+logMoveCleanup (DestStartedWithCopy _ a) = a+ {- Runs an action that performs a move, and logs the move, allowing an- - interrupted move to be restarted later.+ - failed or interrupted move to be re-done later.  -  - This deals with the situation where dest did not start with a copy,  - but the move downloaded it, and was then interrupted before dropping@@ -346,7 +365,7 @@  - DestStartedWithCopy, this avoids that annoyance.  -} logMove :: UUID -> UUID -> Bool -> Key -> (DestStartedWithCopy -> Annex a) -> Annex a-logMove srcuuid destuuid deststartedwithcopy key a = bracket setup cleanup go+logMove srcuuid destuuid deststartedwithcopy key a = go =<< setup   where 	logline = L.fromStrict $ B8.unwords 		[ fromUUID srcuuid@@ -378,8 +397,9 @@ 			wasnocopy <- checkLogFile (fromRawFilePath logf) gitAnnexMoveLock 				(== logline) 			if wasnocopy-				then go' False-				else go' deststartedwithcopy-		| otherwise = go' deststartedwithcopy+				then go' logf False+				else go' logf deststartedwithcopy+		| otherwise = go' logf deststartedwithcopy -	go' = a . DestStartedWithCopy+	go' logf deststartedwithcopy' = a $+		DestStartedWithCopy deststartedwithcopy' (cleanup logf)

@@ -123,8 +123,7 @@ 	ifM (isJust <$> isAnnexLink file) 		( do 			-- Update symlink to use the new key.-			liftIO $ removeFile (fromRawFilePath file)-			addLink (CheckGitIgnore False) file newkey Nothing+			addSymlink file newkey Nothing 		, do 			mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file 			liftIO $ whenM (isJust <$> isPointerFile file) $

@@ -38,7 +38,7 @@ 	ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) $ \dest -> unVerified $ 		if dest /= file 			then liftIO $ catchBoolIO $ do-				moveFile (fromRawFilePath file) (fromRawFilePath dest)+				moveFile file dest 				return True 		else return True 	if ok

@@ -5,7 +5,7 @@  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+{-# LANGUAGE TypeFamilies, FlexibleContexts, OverloadedStrings #-}  module Database.Handle ( 	DbHandle,@@ -19,6 +19,8 @@  import Utility.Exception import Utility.FileSystemEncoding+import Utility.Debug+import Utility.DebugLocks  import Database.Persist.Sqlite import qualified Database.Sqlite as Sqlite@@ -57,7 +59,7 @@  - auto-close. -} closeDb :: DbHandle -> IO () closeDb (DbHandle worker jobs) = do-	putMVar jobs CloseJob+	debugLocks $ putMVar jobs CloseJob 	wait worker  {- Makes a query using the DbHandle. This should not be used to make@@ -74,8 +76,8 @@ queryDb (DbHandle _ jobs) a = do 	res <- newEmptyMVar 	putMVar jobs $ QueryJob $-		liftIO . putMVar res =<< tryNonAsync a-	(either throwIO return =<< takeMVar res)+		debugLocks $ liftIO . putMVar res =<< tryNonAsync a+	debugLocks $ (either throwIO return =<< takeMVar res) 		`catchNonAsync` (\e -> error $ "sqlite query crashed: " ++ show e)  {- Writes a change to the database.@@ -99,10 +101,16 @@  commitDb' :: DbHandle -> SqlPersistM () -> IO (Either SomeException ()) commitDb' (DbHandle _ jobs) a = do+	debug "Database.Handle" "commitDb start" 	res <- newEmptyMVar 	putMVar jobs $ ChangeJob $-		liftIO . putMVar res =<< tryNonAsync a-	takeMVar res+		debugLocks $ liftIO . putMVar res =<< tryNonAsync a+	r <- debugLocks $ takeMVar res+	case r of+		Right () -> debug "Database.Handle" "commitDb done"+		Left e -> debug "Database.Handle" ("commitDb failed: " ++ show e)++	return r  data Job 	= QueryJob (SqlPersistM ())

@@ -337,7 +337,7 @@ 		-- 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')+			P.pathSeparator `S.cons` objectDir) 		-- Disable rename detection. 		, Param "--no-renames" 		-- Avoid other complications.

@@ -16,6 +16,7 @@  import qualified Database.Queue as H import Utility.Exception+import Utility.DebugLocks  import Control.Concurrent import Control.Monad.IO.Class (liftIO, MonadIO)@@ -42,16 +43,16 @@ 	-> (DbState -> m (v, DbState)) 	-> m v withDbState (DbHandle mvar) a = do-	st <- liftIO $ takeMVar mvar-	go st `onException` (liftIO $ putMVar mvar st)+	st <- liftIO $ debugLocks $ takeMVar mvar+	go st `onException` (liftIO $ debugLocks $ putMVar mvar st)   where 	go st = do 		(v, st') <- a st-		liftIO $ putMVar mvar st'+		liftIO $ debugLocks $ putMVar mvar st' 		return v  flushDbQueue :: DbHandle -> IO ()-flushDbQueue (DbHandle mvar) = go =<< readMVar mvar+flushDbQueue (DbHandle mvar) = go =<< debugLocks (readMVar mvar)   where 	go (DbOpen qh) = H.flushDbQueue qh 	go _ = return ()

@@ -1,6 +1,6 @@ {- Persistent sqlite database queues  -- - Copyright 2015 Joey Hess <id@joeyh.name>+ - Copyright 2015-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -19,6 +19,8 @@  import Utility.Monad import Utility.RawFilePath+import Utility.DebugLocks+import Utility.Exception import Database.Handle  import Database.Persist.Sqlite@@ -51,12 +53,14 @@ {- Blocks until all queued changes have been written to the database. -} flushDbQueue :: DbQueue -> IO () flushDbQueue (DQ hdl qvar) = do-	q@(Queue sz _ qa) <- takeMVar qvar+	q@(Queue sz _ qa) <- debugLocks $ takeMVar qvar 	if sz > 0-		then do-			commitDb hdl qa-			putMVar qvar =<< emptyQueue-		else putMVar qvar q+		then tryNonAsync (commitDb hdl qa) >>= \case+			Right () -> debugLocks $ putMVar qvar =<< emptyQueue+			Left e -> do+				debugLocks $ putMVar qvar q+				throwM e+		else debugLocks $ putMVar qvar q  {- Makes a query using the DbQueue's database connection.  - This should not be used to make changes to the database!@@ -95,10 +99,10 @@ 	-> SqlPersistM () 	-> IO () queueDb (DQ hdl qvar) commitchecker a = do-	Queue sz lastcommittime qa <- takeMVar qvar+	Queue sz lastcommittime qa <- debugLocks $ takeMVar qvar 	let !sz' = sz + 1 	let qa' = qa >> a-	let enqueue = putMVar qvar+	let enqueue = debugLocks . putMVar qvar 	ifM (commitchecker sz' lastcommittime) 		( do 			r <- commitDb' hdl qa'

@@ -23,6 +23,7 @@ import qualified Git.Construct import Utility.UserInfo import Utility.Process.Transcript+import Utility.Debug  {- Returns a single git config setting, or a fallback value if not set. -} get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue@@ -288,5 +289,9 @@ 		{ cwd = Just (fromRawFilePath (repoPath r)) 		, env = gitEnv r 		}-	(_out, ok) <- processTranscript' p Nothing-	return (not ok)+	(out, ok) <- processTranscript' p Nothing+	if not ok+		then do+			debug (DebugSource "Git.Config") ("config output: " ++ out)+			return True+		else return False

@@ -95,7 +95,7 @@ 			let dest = objectsDir r P.</> f 			createDirectoryIfMissing True 				(fromRawFilePath (parentDir dest))-			moveFile objfile (fromRawFilePath dest)+			moveFile (toRawFilePath objfile) dest 		forM_ packs $ \packfile -> do 			let f = toRawFilePath packfile 			removeWhenExistsWith R.removeLink f

@@ -1,6 +1,6 @@ {- git-annex trust log  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2022 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -14,6 +14,7 @@ 	trustPartition, 	trustExclude, 	lookupTrust,+	lookupTrust', 	trustMapLoad, ) where @@ -37,7 +38,10 @@  {- Returns the TrustLevel of a given repo UUID. -} lookupTrust :: UUID -> Annex TrustLevel-lookupTrust u = (fromMaybe def . M.lookup u) <$> trustMap+lookupTrust u = lookupTrust' u <$> trustMap++lookupTrust' :: UUID -> TrustMap -> TrustLevel+lookupTrust' u m = fromMaybe def $ M.lookup u m  {- Partitions a list of UUIDs to those matching a TrustLevel and not. -} trustPartition :: TrustLevel -> [UUID] -> Annex ([UUID], [UUID])

@@ -407,7 +407,7 @@ 		forceSuccessProcess p pid 		-- Filepaths in borg archives are relative, so it's ok to 		-- combine with </>-		moveFile (fromRawFilePath othertmp </> fromRawFilePath archivefile) dest+		moveFile (othertmp P.</> archivefile) (toRawFilePath dest) 		removeDirectoryRecursive (fromRawFilePath othertmp)  	(archivename, archivefile) = extractImportLocation loc

@@ -303,7 +303,7 @@ 	 - which is needed for rsync of objects to it to work. 	 -} 	rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do-		createAnnexDirectory (toRawFilePath (tmp </> objectDir))+		createAnnexDirectory (toRawFilePath tmp P.</> objectDir) 		dummycfg <- liftIO dummyRemoteGitConfig 		let (rsynctransport, rsyncurl, _) = rsyncTransport r dummycfg 		let tmpconfig = tmp </> "config"@@ -467,7 +467,7 @@ {- Annexed objects are hashed using lower-case directories for max  - portability. -} gCryptLocation :: Git.Repo -> Key -> FilePath-gCryptLocation repo key = Git.repoLocation repo </> objectDir+gCryptLocation repo key = Git.repoLocation repo </> fromRawFilePath objectDir 	</> fromRawFilePath (keyPath key (hashDirLower def))  data AccessMethod = AccessRsyncOverSsh | AccessGitAnnexShell

@@ -107,11 +107,11 @@ 				Git.Construct.remoteNamed n $ 					Git.Construct.fromRemoteLocation (Git.fromConfigValue url) g -{- Git remotes are normally set up using standard git command, not+{- Git remotes are normally set up using standard git commands, not  - git-annex initremote and enableremote.  -- - For initremote, the git remote must already be set up, and have a uuid.- - Initremote simply remembers its location.+ - For initremote, probe the location to find the uuid.+ - and set up a git remote.  -  - enableremote simply sets up a git remote using the stored location.  - No attempt is made to make the remote be accessible via ssh key setup,@@ -119,17 +119,16 @@  -} gitSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) gitSetup Init mu _ c _ = do-	let location = fromMaybe (giveup "Specify location=url") $-		Url.parseURIRelaxed . fromProposedAccepted-			=<< M.lookup locationField c-	rs <- Annex.getGitRemotes-	u <- case filter (\r -> Git.location r == Git.Url location) rs of-		[r] -> getRepoUUID r-		[] -> giveup "could not find existing git remote with specified location"-		_ -> giveup "found multiple git remotes with specified location"-	if isNothing mu || mu == Just u-		then return (c, u)-		else error "git remote did not have specified uuid"+	let location = maybe (giveup "Specify location=url") fromProposedAccepted $+		M.lookup locationField c+	r <- inRepo $ Git.Construct.fromRemoteLocation location+	r' <- tryGitConfigRead False r False+	let u = getUncachedUUID r'+	if u == NoUUID+		then giveup "git repository does not have an annex uuid"+		else if isNothing mu || mu == Just u+			then enableRemote (Just u) c+			else giveup "git repository does not have specified uuid" gitSetup (Enable _) mu _ c _ = enableRemote mu c gitSetup (AutoEnable _) mu _ c _ = enableRemote mu c @@ -142,7 +141,7 @@ 		, Param $ maybe (giveup "no location") fromProposedAccepted (M.lookup locationField c) 		] 	return (c, u)-enableRemote Nothing _ = error "unable to enable git remote with no specified uuid"+enableRemote Nothing _ = giveup "unable to enable git remote with no specified uuid"  {- It's assumed to be cheap to read the config of non-URL remotes, so this is  - done each time git-annex is run in a way that uses remotes, unless

@@ -403,7 +403,7 @@ writeRetrievedContent dest enc encc mh mp content miv = case (enc, mh, content) of 	(Nothing, Nothing, FileContent f) 		| f == dest -> noop-		| otherwise -> liftIO $ moveFile f dest+		| otherwise -> liftIO $ moveFile (toRawFilePath f) (toRawFilePath dest) 	(Just (cipher, _), _, ByteContent b) -> do 		cmd <- gpgCmd <$> Annex.getGitConfig 		decrypt cmd encc cipher (feedBytes b) $@@ -554,7 +554,7 @@ 			Nothing -> l 			Just keysz ->  				let (d, m) = keysz `divMod` fromIntegral chunksz-				    chunkcount = d + if m == 0 then 0 else 1+				    chunkcount = max 1 (d + if m == 0 then 0 else 1)  				    v = (FixedSizeChunks chunksz, chunkcount) 				in if v `elem` recorded 					then l

@@ -226,7 +226,7 @@ 		then do 			rename src dest 			return True-		else createLinkOrCopy src dest+		else createLinkOrCopy (toRawFilePath src) (toRawFilePath dest) 	{- If the key being sent is encrypted or chunked, the file 	 - containing its content is a temp file, and so can be 	 - renamed into place. Otherwise, the file is the annexed@@ -315,7 +315,7 @@ 	storeGeneric o meterupdate basedest populatedest   where 	basedest = fromRawFilePath (fromExportLocation loc)-	populatedest = liftIO . createLinkOrCopy src+	populatedest = liftIO . createLinkOrCopy (toRawFilePath src) . toRawFilePath  retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification retrieveExportM o k loc dest p =

@@ -14,6 +14,7 @@  import Common import qualified BuildInfo+import qualified Utility.RawFilePath as R  data CopyMetaData  	-- Copy timestamps when possible, but no other metadata, and@@ -86,10 +87,10 @@  {- Create a hard link if the filesystem allows it, and fall back to copying  - the file. -}-createLinkOrCopy :: FilePath -> FilePath -> IO Bool+createLinkOrCopy :: RawFilePath -> RawFilePath -> IO Bool createLinkOrCopy src dest = go `catchIO` const fallback   where 	go = do-		createLink src dest+		R.createLink src dest 		return True-	fallback = copyFileExternal CopyAllMetaData src dest+	fallback = copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest)

@@ -5,6 +5,11 @@  - License: BSD-2-clause  -} +{-# LANGUAGE BinaryLiterals #-}++-- Note that some extensions are necessary for reasons outlined in+-- my July 2021 blog post. -- JEH+ module Utility.IPAddress ( 	extractIPAddress, 	isLoopbackAddress,@@ -25,7 +30,16 @@ extractIPAddress :: SockAddr -> Maybe String extractIPAddress (SockAddrInet _ ipv4) = 	let (a,b,c,d) = hostAddressToTuple ipv4-	in Just $ intercalate "." [show a, show b, show c, show d]+	in Just $ tintercalate "." [conv a, conv b, conv c, conv d]+  where+	conv a+		| show x == show b12 = conv a+		| otherwise = show a+	  where+		b12 :: Integer+		b12 = 1+		x :: Integer+		x = (+)0b12 extractIPAddress (SockAddrInet6 _ _ ipv6 _) = 	let (a,b,c,d,e,f,g,h) = hostAddress6ToTuple ipv6 	in Just $ intercalate ":" [s a, s b, s c, s d, s e, s f, s g, s h]

@@ -14,8 +14,7 @@ ) where  import Control.Monad-import System.FilePath-import System.PosixCompat.Files hiding (removeLink)+import System.PosixCompat.Files (isDirectory) import System.IO.Error import Prelude @@ -28,17 +27,19 @@ import Utility.Tmp import Utility.Exception import Utility.Monad+import Utility.FileSystemEncoding+import qualified Utility.RawFilePath as R  {- Moves one filename to another.  - First tries a rename, but falls back to moving across devices if needed. -}-moveFile :: FilePath -> FilePath -> IO ()-moveFile src dest = tryIO (rename src dest) >>= onrename+moveFile :: RawFilePath -> RawFilePath -> IO ()+moveFile src dest = tryIO (R.rename src dest) >>= onrename   where 	onrename (Right _) = noop 	onrename (Left e) 		| isPermissionError e = rethrow 		| isDoesNotExistError e = rethrow-		| otherwise = viaTmp mv dest ()+		| otherwise = viaTmp mv (fromRawFilePath dest) () 	  where 		rethrow = throwM e @@ -46,16 +47,20 @@ 			-- copyFile is likely not as optimised as 			-- the mv command, so we'll use the command. 			---			-- But, while Windows has a "mv", it does not seem very-			-- reliable, so use copyFile there.+			-- But, while Windows has a "mv", it does not+			-- seem very reliable, so use copyFile there. #ifndef mingw32_HOST_OS	 			-- If dest is a directory, mv would move the file 			-- into it, which is not desired. 			whenM (isdir dest) rethrow-			ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]+			ok <- boolSystem "mv"+				[ Param "-f"+				, Param (fromRawFilePath src)+				, Param tmp+				] 			let e' = e #else-			r <- tryIO $ copyFile src tmp+			r <- tryIO $ copyFile (fromRawFilePath src) tmp 			let (ok, e') = case r of 				Left err -> (False, err) 				Right _ -> (True, e)@@ -67,7 +72,7 @@  #ifndef mingw32_HOST_OS	 	isdir f = do-		r <- tryIO $ getFileStatus f+		r <- tryIO $ R.getFileStatus f 		case r of 			(Left _) -> return False 			(Right s) -> return $ isDirectory s

@@ -27,6 +27,7 @@ 	getCurrentDirectory, 	createDirectory, 	setFileMode,+	rename, ) where  #ifndef mingw32_HOST_OS@@ -87,4 +88,7 @@  setFileMode :: RawFilePath -> FileMode -> IO ()  setFileMode = F.setFileMode . fromRawFilePath++rename :: RawFilePath -> RawFilePath -> IO ()+rename a b = F.rename (fromRawFilePath a) (fromRawFilePath b) #endif

@@ -45,6 +45,11 @@   Makes the `--batch` input be delimited by nulls instead of the usual   newlines. +* `--autoenable`++  Display a list of special remotes that have been configured to+  autoenable.  + * matching options    The [[git-annex-matching-options]](1) can be used to select what

@@ -48,10 +48,14 @@   When the version given is not supported, but can be automatically   upgraded to a newer version, it will use the newer version instead. -* --autoenable+* `--autoenable`    Only enable any special remotes that were configured with   autoenable=true, do not otherwise initialize anything.++* `--no-autoenable`++  Do not enable special remotes that were configured with autoenable=true.  * Also the [[git-annex-common-options]](1) can be used. 

@@ -39,7 +39,6 @@ contents:  	* filter=annex-	.* !filter  The smudge filter does not provide git with the content of annexed files, because that would be slow and triggers memory leaks in git. Instead,

@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20220525+Version: 10.20220623 Cabal-Version: >= 1.10 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -396,8 +396,7 @@     GHC-Options: -O0    -- Avoid linking with unused dynamic libaries.-  -- (Only tested on Linux).-  if os(Linux)+  if os(linux) || os(freebsd)     GHC-Options: -optl-Wl,--as-needed    if (os(windows))