packages feed

git-annex 10.20250520 → 10.20250605

raw patch · 16 files changed

+376/−203 lines, 16 files

Files

Annex/CopyFile.hs view
@@ -1,6 +1,6 @@ {- Copying files.  -- - Copyright 2011-2022 Joey Hess <id@joeyh.name>+ - Copyright 2011-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -10,6 +10,7 @@ module Annex.CopyFile where  import Annex.Common+import qualified Annex import Utility.Metered import Utility.CopyFile import Utility.FileMode@@ -30,7 +31,7 @@ newCopyCoWTried :: IO CopyCoWTried newCopyCoWTried = CopyCoWTried <$> newEmptyMVar -{- Copies a file is copy-on-write is supported. Otherwise, returns False.+{- Copies a file if copy-on-write is supported. Otherwise, returns False.  -  - The destination file must not exist yet (or may exist but be empty),   - or it will fail to make a CoW copy, and will return false.@@ -77,6 +78,23 @@  data CopyMethod = CopiedCoW | Copied +-- Should cp be allowed to copy the file with --reflink=auto?+--+-- The benefit is that this lets it use the copy_file_range+-- syscall, which is not used with --reflink=always. The drawback is that+-- the IncrementalVerifier is not updated, so verification, if it is done,+-- will need to re-read the whole content of the file. And, interrupted+-- copies are not resumed but are restarted from the beginning.+-- +-- Using this will result in CopiedCow being returned even in cases+-- where cp fell back to a slow copy.+newtype FastCopy = FastCopy Bool++getFastCopy :: RemoteGitConfig -> Annex FastCopy+getFastCopy gc = case remoteAnnexFastCopy gc of+	False -> FastCopy . annexFastCopy <$> Annex.getGitConfig+	True -> return (FastCopy True)+ {- Copies from src to dest, updating a meter. Preserves mode and mtime.  - Uses copy-on-write if it is supported. If the the destination already  - exists, an interrupted copy will resume where it left off.@@ -94,38 +112,49 @@  - (eg when isStableKey is false), and doing this avoids getting a  - corrupted file in such cases.  -}-fileCopier :: CopyCoWTried -> OsPath -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO CopyMethod+fileCopier :: CopyCoWTried -> FastCopy -> OsPath -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO CopyMethod+fileCopier copycowtried (FastCopy True) src dest meterupdate iv = do+	ok <- watchFileSize dest meterupdate $ const $+		copyFileExternal CopyTimeStamps src dest+	if ok+		then do+			maybe noop unableIncrementalVerifier iv+			return CopiedCoW+		else fileCopier copycowtried (FastCopy False) src dest meterupdate iv #ifdef mingw32_HOST_OS-fileCopier _ src dest meterupdate iv = docopy+fileCopier _ _ src dest meterupdate iv =+	fileCopier' src dest meterupdate iv #else-fileCopier copycowtried src dest meterupdate iv =+fileCopier copycowtried _ src dest meterupdate iv = 	ifM (tryCopyCoW copycowtried src dest meterupdate) 		( do 			maybe noop unableIncrementalVerifier iv 			return CopiedCoW-		, docopy+		, fileCopier' src dest meterupdate iv 		) #endif-  where-	docopy = do-		-- The file might have had the write bit removed,-		-- so make sure we can write to it.-		void $ tryIO $ allowWrite dest -		F.withBinaryFile src ReadMode $ \hsrc ->-			fileContentCopier hsrc dest meterupdate iv+fileCopier' :: OsPath -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO CopyMethod+fileCopier' src dest meterupdate iv = do+	-- The file might have had the write bit removed,+	-- so make sure we can write to it.+	void $ tryIO $ allowWrite dest++	F.withBinaryFile src ReadMode $ \hsrc ->+		fileContentCopier hsrc dest meterupdate iv 		-		-- Copy src mode and mtime.-		mode <- fileMode <$> R.getFileStatus (fromOsPath src)-		mtime <- utcTimeToPOSIXSeconds <$> getModificationTime src-		let dest' = fromOsPath dest-		R.setFileMode dest' mode-		touch dest' mtime False+	-- Copy src mode and mtime.+	mode <- fileMode <$> R.getFileStatus (fromOsPath src)+	mtime <- utcTimeToPOSIXSeconds <$> getModificationTime src+	let dest' = fromOsPath dest+	R.setFileMode dest' mode+	touch dest' mtime False -		return Copied+	return Copied  {- Copies content from a handle to a destination file. Does not  - use copy-on-write, and does not copy file mode and mtime.+ - Updates the IncementalVerifier with the content it copies.  -} fileContentCopier :: Handle -> OsPath -> MeterUpdate -> Maybe IncrementalVerifier -> IO () fileContentCopier hsrc dest meterupdate iv =
Annex/Hook.hs view
@@ -106,44 +106,55 @@  runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex () runAnnexHook hook commandcfg = runAnnexHook' hook commandcfg >>= \case-	Nothing -> noop-	Just failedcommanddesc -> +	HookSuccess -> noop+	HookFailed failedcommanddesc ->  		warning $ UnquotedString $ failedcommanddesc ++ " failed" --- Returns Nothing if the hook or GitConfig command succeeded, or a--- description of what failed.-runAnnexHook' :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String)+data HookResult+	= HookSuccess+	| HookFailed String+	-- ^ A description of the hook command that failed.+	deriving (Eq, Show)++runAnnexHook' :: Git.Hook -> (GitConfig -> Maybe String) -> Annex HookResult runAnnexHook' hook commandcfg = ifM (doesAnnexHookExist hook) 	( runhook 	, runcommandcfg 	)   where 	runhook = ifM (inRepo $ Git.runHook boolSystem hook [])-		( return Nothing+		( return HookSuccess 		, do 			h <- fromRepo (Git.hookFile hook)-			commandfailed (fromOsPath h)+			return $ HookFailed $ fromOsPath h 		) 	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case-		Nothing -> return Nothing+		Nothing -> return HookSuccess 		Just command -> 			ifM (liftIO $ boolSystem "sh" [Param "-c", Param command])-				( return Nothing-				, commandfailed $ "git configured command '" ++  command ++ "'"+				( return HookSuccess+				, return $ HookFailed $ "git configured command '" ++  command ++ "'" 				)-	commandfailed c = return $ Just c -runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> OsPath -> Annex Bool+runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> OsPath -> Annex HookResult runAnnexPathHook pathtoken hook commandcfg p = ifM (doesAnnexHookExist hook) 	( runhook 	, runcommandcfg 	)   where-	runhook = inRepo $ Git.runHook boolSystem hook [ File p' ]+	runhook = ifM (inRepo $ Git.runHook boolSystem hook [ File p' ])+		( return HookSuccess+		, do+			h <- fromRepo (Git.hookFile hook)+			return $ HookFailed $ fromOsPath h+		) 	runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case-		Nothing -> return True-		Just basecmd -> liftIO $-			boolSystem "sh" [Param "-c", Param $ gencmd basecmd]+		Nothing -> return HookSuccess+		Just basecmd -> +			ifM (liftIO $ boolSystem "sh" [Param "-c", Param (gencmd basecmd)])+				( return HookSuccess+				, return $ HookFailed $ "git configured command '" ++ basecmd ++ "'"+				) 	gencmd = massReplace [ (pathtoken, shellEscape p') ] 	p' = fromOsPath p
Annex/Init.hs view
@@ -19,6 +19,7 @@ 	uninitialize, 	probeCrippledFileSystem, 	probeCrippledFileSystem',+	isCrippledFileSystem, ) where  import Annex.Common@@ -75,10 +76,10 @@ checkInitializeAllowed :: (InitializeAllowed -> Annex a) -> Annex a checkInitializeAllowed a = guardSafeToUseRepo $ noAnnexFileContent' >>= \case 	Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case-		Nothing -> do+		HookSuccess -> do 			checkSqliteWorks 			a InitializeAllowed-		Just failedcommanddesc -> do+		HookFailed failedcommanddesc -> do 			initpreventedby failedcommanddesc 			notinitialized 	Just noannexmsg -> do@@ -94,8 +95,8 @@ initializeAllowed :: Annex Bool initializeAllowed = noAnnexFileContent' >>= \case 	Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case-		Nothing -> return True-		Just _ -> return False+		HookSuccess -> return True+		HookFailed _ -> return False 	Just _ -> return False  noAnnexFileContent' :: Annex (Maybe String)@@ -288,73 +289,116 @@ isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion  {- A crippled filesystem is one that does not allow making symlinks,- - or removing write access from files. -}-probeCrippledFileSystem :: Annex Bool-probeCrippledFileSystem = withEventuallyCleanedOtherTmp $ \tmp -> do-	(r, warnings) <- probeCrippledFileSystem' tmp+ - or removing write access from files.+ -+ - This displays messages about problems detected with the filesystem.+ -+ - If a freeze or thaw hook is configured, but exits nonzero,+ - this returns Nothing after displaying a message to the user about the+ - problem. Such a hook can in some cases make a filesystem+ - that would otherwise be detected as crippled work ok, so this avoids+ - a false positive.+ -}+probeCrippledFileSystem :: Annex (Maybe Bool)+probeCrippledFileSystem = do+	(r, warnings) <- isCrippledFileSystem'+	mapM_ (warning . UnquotedString) warnings+	return r++isCrippledFileSystem :: Annex Bool+isCrippledFileSystem = do+	(r, _warnings) <- isCrippledFileSystem'+	return (fromMaybe True r)++isCrippledFileSystem' :: Annex (Maybe Bool, [String])+isCrippledFileSystem' = withEventuallyCleanedOtherTmp $ \tmp ->+	probeCrippledFileSystem' tmp 		(Just (freezeContent' UnShared)) 		(Just (thawContent' UnShared)) 		=<< hasFreezeHook-	mapM_ (warning . UnquotedString) warnings-	return r  probeCrippledFileSystem' 	:: (MonadIO m, MonadCatch m) 	=> OsPath-	-> Maybe (OsPath -> m ())-	-> Maybe (OsPath -> m ())+	-> Maybe (OsPath -> m HookResult)+	-> Maybe (OsPath -> m HookResult) 	-> Bool-	-> m (Bool, [String])+	-> m (Maybe Bool, [String]) #ifdef mingw32_HOST_OS-probeCrippledFileSystem' _ _ _ _ = return (True, [])+probeCrippledFileSystem' _ _ _ _ = return (Just True, []) #else probeCrippledFileSystem' tmp freezecontent thawcontent hasfreezehook = do 	let f = tmp </> literalOsPath "gaprobe" 	liftIO $ F.writeFile' f ""-	r <- probe f-	void $ tryNonAsync $ (fromMaybe (liftIO . allowWrite) thawcontent) f+	r <- freezethaw f probe 	liftIO $ removeFile f 	return r   where-	probe f = catchDefaultIO (True, []) $ do+	fallbackfreezecontent f = do+		liftIO $ preventWrite f+		return HookSuccess+	+	fallbackthawcontent f = do+		liftIO $ allowWrite f+		return HookSuccess+	+	freezethaw f cont =+		(fromMaybe fallbackfreezecontent freezecontent) f >>= \case+			HookFailed failedcommanddesc ->+				return (Nothing, [hookfailed failedcommanddesc])+			HookSuccess -> do+				r <- cont f+				tryNonAsync ((fromMaybe fallbackthawcontent thawcontent) f)+					>>= return . \case+						Right (HookFailed failedcommanddesc) ->+							let (_, warnings) = r+							in (Nothing, hookfailed failedcommanddesc : warnings)+						_ -> r++	hookfailed failedcommanddesc = "Failed to run " ++ failedcommanddesc +		++ ". Unable to initialize until this is fixed."++	probe f = catchDefaultIO (Just True, []) $ do 		let f2 = f <> literalOsPath "2" 		liftIO $ removeWhenExistsWith removeFile f2 		liftIO $ R.createSymbolicLink (fromOsPath f) (fromOsPath f2) 		liftIO $ removeWhenExistsWith removeFile f2-		(fromMaybe (liftIO . preventWrite) freezecontent) f 		-- Should be unable to write to the file (unless 		-- running as root). But some crippled 		-- filesystems ignore write bit removals or ignore 		-- permissions entirely. 		ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared f Nothing hasfreezehook))-			( return (True, ["Filesystem does not allow removing write bit from files."])+			( return (Just True, ["Filesystem does not allow removing write bit from files."]) 			, liftIO $ ifM ((== 0) <$> getRealUserID)-				( return (False, [])+				( return (Just False, []) 				, do 					r <- catchBoolIO $ do 						F.writeFile' f "2" 						return True 					if r-						then return (True, ["Filesystem allows writing to files whose write bit is not set."])-						else return (False, [])+						then return (Just True, ["Filesystem allows writing to files whose write bit is not set."])+						else return (Just False, []) 				) 			) #endif  checkCrippledFileSystem :: Annex ()-checkCrippledFileSystem = whenM probeCrippledFileSystem $ do-	warning "Detected a crippled filesystem."-	setCrippledFileSystem True+checkCrippledFileSystem = probeCrippledFileSystem >>= \case+	Just True -> do+		warning "Detected a crippled filesystem."+		setCrippledFileSystem True -	{- Normally git disables core.symlinks itself when the:w-	 --	 - filesystem does not support them. But, even if symlinks are-	 - supported, we don't use them by default in a crippled-	 - filesystem. -}-	whenM (coreSymlinks <$> Annex.getGitConfig) $ do-		warning "Disabling core.symlinks."-		setConfig "core.symlinks"-			(Git.Config.boolConfig False)+		{- Normally git disables core.symlinks itself when the+		 -+		 - filesystem does not support them. But, even if symlinks are+		 - supported, we don't use them by default in a crippled+		 - filesystem. -}+		whenM (coreSymlinks <$> Annex.getGitConfig) $ do+			warning "Disabling core.symlinks."+			setConfig "core.symlinks"+				(Git.Config.boolConfig False)+	Just False -> noop+	Nothing -> giveup "Not initialized."  probeLockSupport :: Annex Bool #ifdef mingw32_HOST_OS
Annex/Perms.hs view
@@ -161,13 +161,12 @@  - that happens with write permissions.  -} freezeContent :: OsPath -> Annex ()-freezeContent file =-	withShared $ \sr -> freezeContent' sr file+freezeContent file = withShared $ \sr -> void $ freezeContent' sr file -freezeContent' :: SharedRepository -> OsPath -> Annex ()+freezeContent' :: SharedRepository -> OsPath -> Annex HookResult freezeContent' sr file = freezeContent'' sr file =<< getVersion -freezeContent'' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Annex ()+freezeContent'' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Annex HookResult freezeContent'' sr file rv = do 	fastDebug "Annex.Perms" ("freezing content " ++ fromOsPath file) 	unlessM crippledFileSystem $ go sr@@ -255,9 +254,9 @@ {- Allows writing to an annexed file that freezeContent was called on  - before. -} thawContent :: OsPath -> Annex ()-thawContent file = withShared $ \sr -> thawContent' sr file+thawContent file = withShared $ \sr -> void $ thawContent' sr file -thawContent' :: SharedRepository -> OsPath -> Annex ()+thawContent' :: SharedRepository -> OsPath -> Annex HookResult thawContent' sr file = do 	fastDebug "Annex.Perms" ("thawing content " ++ fromOsPath file) 	thawPerms (go sr) (thawHook file)@@ -272,10 +271,10 @@  - fail on a crippled filesystem. But, if file modes are supported on a  - crippled filesystem, the file may be frozen, so try to thaw its  - permissions. -}-thawPerms :: Annex () -> Annex () -> Annex ()+thawPerms :: Annex () -> Annex HookResult -> Annex HookResult thawPerms a hook = ifM crippledFileSystem-	( hook >> void (tryNonAsync a)-	, hook >> a+	( void (tryNonAsync a) `after` hook+	, a `after` hook 	)  {- Blocks writing to the directory an annexed file is in, to prevent the@@ -287,7 +286,7 @@ freezeContentDir file = do 	fastDebug "Annex.Perms" ("freezing content directory " ++ fromOsPath dir) 	unlessM crippledFileSystem $ withShared go-	freezeHook dir+	void $ freezeHook dir   where 	dir = parentDir file 	go UnShared = liftIO $ preventWrite dir@@ -303,7 +302,7 @@ thawContentDir :: OsPath -> Annex () thawContentDir file = do 	fastDebug "Annex.Perms" ("thawing content directory " ++ fromOsPath dir)-	thawPerms (withShared (liftIO . go)) (thawHook dir)+	void $ thawPerms (withShared (liftIO . go)) (thawHook dir)   where 	dir = parentDir file 	go UnShared = allowWrite dir@@ -318,7 +317,7 @@ 	unlessM (liftIO $ doesDirectoryExist dir) $ 		createAnnexDirectory dir  	-- might have already existed with restricted perms-	thawHook dir+	void $ thawHook dir 	unlessM crippledFileSystem $ liftIO $ allowWrite dir   where 	dir = parentDir dest@@ -354,12 +353,12 @@ 		<||> 	(doesAnnexHookExist thawContentAnnexHook) -freezeHook :: OsPath -> Annex ()-freezeHook = void . runAnnexPathHook "%path"+freezeHook :: OsPath -> Annex HookResult+freezeHook = runAnnexPathHook "%path" 	freezeContentAnnexHook annexFreezeContentCommand -thawHook :: OsPath -> Annex ()-thawHook = void . runAnnexPathHook "%path"+thawHook :: OsPath -> Annex HookResult+thawHook = runAnnexPathHook "%path" 	thawContentAnnexHook annexThawContentCommand  {- Calculate mode to use for a directory from the mode to use for a file.
Assistant/Repair.hs view
@@ -147,17 +147,10 @@ 		<$> getFileSize lf 	getsizes = liftIO $ catMaybes <$> mapM getsize lockfiles 	go [] = return ()-	go l = ifM (liftIO $ null <$> Lsof.query ("--" : map (fromOsPath . fst) l))-		( do-			waitforit "to check stale git lock file"-			l' <- getsizes-			if l' == l-				then liftIO $ mapM_ (removeWhenExistsWith removeFile . fst) l-				else go l'-		, do-			waitforit "for git lock file writer"-			go =<< getsizes-		)-	waitforit why = do-		debug ["Waiting for 60 seconds", why]+	go l = whenM (liftIO $ null <$> Lsof.query ("--" : map (fromOsPath . fst) l)) $ do+		debug ["Waiting for 60 seconds to check stale git lock file"] 		liftIO $ threadDelaySeconds $ Seconds 60+		l' <- getsizes+		if l' == l+			then liftIO $ mapM_ (removeWhenExistsWith removeFile . fst) l+			else go l'
CHANGELOG view
@@ -1,3 +1,26 @@+git-annex (10.20250605) upstream; urgency=medium++  * sync: Push the current branch first, rather than a synced branch,+    to better support git forges (gitlab, gitea, forgejo, etc.) which+    use push-to-create with the first pushed branch becoming the default+    branch.+  * Added annex.fastcopy and remote.name.annex-fastcopy config setting.+    When set, this allows the copy_file_range syscall to be used, which+    can eg allow for server-side copies on NFS. (For fastest copying, +    also disable annex.verify or remote.name.annex-verify.)+  * map: Support --json option.+  * map: Improve display of remote names.+  * When annex.freezecontent-command or annex.thawcontent-command is+    configured but fails, prevent initialization. This allows the user to+    fix their configuration and avoid crippled filesystem detection+    entering an adjusted branch.+  * assistant: Avoid hanging at startup when a process has a *.lock file+    open in the .git directory.+  * Windows: Fix duplicate file bug that could occur when files were+    supposed to be moved across devices.++ -- Joey Hess <id@joeyh.name>  Thu, 05 Jun 2025 14:10:36 -0400+ git-annex (10.20250520) upstream; urgency=medium    * Preferred content now supports "balanced=groupname:lackingcopies"
CmdLine/GitRemoteAnnex.hs view
@@ -1204,7 +1204,7 @@ 			_ -> noop 		void $ liftIO $ tryIO $ removeDirectory annexobjectdir -	notcrippledfilesystem = not <$> probeCrippledFileSystem+	notcrippledfilesystem = not <$> isCrippledFileSystem  	nonbuggygitversion = liftIO $ 		flip notElem buggygitversions <$> Git.Version.installed
Command/Map.hs view
@@ -9,8 +9,6 @@  module Command.Map where -import qualified Data.Map as M- import Command import qualified Git import qualified Git.Url@@ -25,12 +23,17 @@ import Types.TrustLevel import qualified Remote.Helper.Ssh as Ssh import qualified Utility.Dot as Dot+import qualified Messages.JSON as JSON+import Messages.JSON ((.=))+import Utility.Aeson (packString) +import qualified Data.Map as M+ -- a repo and its remotes type RepoRemotes = (Git.Repo, [Git.Repo])  cmd :: Command-cmd = dontCheck repoExists $+cmd = dontCheck repoExists $ withAnnexOptions [jsonOptions] $ 	command "map" SectionQuery 		"generate map of repositories" 		paramNothing (withParams seek)@@ -44,20 +47,24 @@  	umap <- uuidDescMap 	trustmap <- trustMapLoad-		-	file <- (</>)-		<$> fromRepo gitAnnexDir-		<*> pure (literalOsPath "map.dot")+	+	ifM (outputJSONMap rs trustmap umap)+		( next $ return True+		, do+			file <- (</>)+				<$> fromRepo gitAnnexDir+				<*> pure (literalOsPath "map.dot") -	liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap)-	next $-		ifM (Annex.getRead Annex.fast)-			( runViewer file []-			, runViewer file-	 			[ ("xdot", [File (fromOsPath file)])-				, ("dot", [Param "-Tx11", File (fromOsPath file)])-				]	-			)+			liftIO $ writeFile (fromOsPath file) (drawMap rs trustmap umap)+			next $+				ifM (Annex.getRead Annex.fast)+					( runViewer file []+					, runViewer file+			 			[ ("xdot", [File (fromOsPath file)])+						, ("dot", [Param "-Tx11", File (fromOsPath file)])+						]	+					)+		)  runViewer :: OsPath -> [(String, [CommandParam])] -> Annex Bool runViewer file [] = do@@ -101,10 +108,10 @@ basehostname :: Git.Repo -> String basehostname r = fromMaybe "" $ headMaybe $ splitc '.' $ hostname r -{- A name to display for a repo. Uses the name from uuid.log if available,- - or the remote name if not. -}-repoName :: UUIDDescMap -> Git.Repo -> String-repoName umap r+{- A description to display for a repo. Uses the description + - from uuid.log if available, or the remote name if not. -}+repoDesc :: UUIDDescMap -> Git.Repo -> String+repoDesc umap r 	| repouuid == NoUUID = fallback 	| otherwise = maybe fallback fromUUIDDesc $ M.lookup repouuid umap   where@@ -124,7 +131,7 @@   where 	n = Dot.subGraph (hostname r) (basehostname r) "lightblue" $ 		trustDecorate trustmap (getUncachedUUID r) $-			Dot.graphNode (nodeId r) (repoName umap r)+			Dot.graphNode (nodeId r) (repoDesc umap r) 	edges = map (edge umap fullinfo r) rs  {- An edge between two repos. The second repo is a remote of the first. -}@@ -143,7 +150,7 @@ 	 - different from its hostname. (This reduces visual clutter.) -} 	edgename = maybe Nothing calcname $ Git.remoteName to 	calcname n-		| n `elem` [repoName umap fullto, hostname fullto] = Nothing+		| n `elem` [repoDesc umap fullto, hostname fullto] = Nothing 		| otherwise = Just n  trustDecorate :: TrustMap -> UUID -> String -> String@@ -182,7 +189,9 @@ 	| otherwise = liftIO $ do 		r' <- Git.Construct.fromPath =<< absPath (Git.repoPath r) 		r'' <- safely $ flip Annex.eval Annex.gitRepo =<< Annex.new r'-		return (fromMaybe r' r'')+		return $ (fromMaybe r' r'')+			{ Git.remoteName = Git.remoteName r+			}  {- Checks if two repos are the same. -} same :: Git.Repo -> Git.Repo -> Bool@@ -198,7 +207,8 @@ {- reads the config of a remote, with progress display -} scan :: Git.Repo -> Annex Git.Repo scan r = do-	showStartMessage (StartMessage "map" (ActionItemOther (Just $ UnquotedString $ Git.repoDescribe r)) (SeekInput []))+	unlessM jsonOutputEnabled $+		showStartMessage (StartMessage "map" (ActionItemOther (Just $ UnquotedString $ Git.repoDescribe r)) (SeekInput [])) 	v <- tryScan r 	case v of 		Just r' -> do@@ -269,7 +279,7 @@ 				configlist 			ok -> return ok -	sshnote = do+	sshnote = unlessM jsonOutputEnabled $ do 		showAction "sshing" 		showOutput @@ -287,3 +297,33 @@ 	case result of 		Left _ -> return Nothing 		Right r' -> return $ Just r'++outputJSONMap :: [RepoRemotes] -> TrustMap -> UUIDDescMap -> Annex Bool+outputJSONMap rs trustmap umap = +	showFullJSON $ JSON.AesonObject $ case mapo of+		JSON.Object obj -> obj+		_ -> error "internal"+  where+	mapo = JSON.object+		[ "nodes" .= map mknode (filterdead fst rs)+		]+	+	mknode (r, remotes) = JSON.object+		[ "description" .= packString (repoDesc umap r)+		, "uuid" .= mkuuid (getUncachedUUID r)+		, "url" .= packString (Git.repoLocation r)+		, "remotes" .= map mkremote (filterdead id remotes)+		]+	+	mkremote r = JSON.object+		[ "remote" .= (packString <$> Git.remoteName r)+		, "uuid" .= mkuuid (getUncachedUUID r)+		, "url" .= packString (Git.repoLocation r)+		]+	+	mkuuid NoUUID = Nothing+	mkuuid u = Just $ packString $ fromUUID u+	+	filterdead f = filter+		(\i -> M.lookup (getUncachedUUID (f i)) trustmap /= Just DeadTrusted)+
Command/Sync.hs view
@@ -83,7 +83,6 @@ import qualified Database.Export as Export import Utility.Bloom import Utility.OptParse-import Utility.Process.Transcript import Utility.Tuple import Utility.Matcher @@ -706,20 +705,13 @@  - Git offers no way to tell if a remote is bare or not, so both methods  - are tried.  -- - The direct push is likely to spew an ugly error message, so its stderr is- - often elided. Since git progress display goes to stderr too, the - - sync push is done first, and actually sends the data. Then the- - direct push is tried, with stderr discarded, to update the branch ref- - on the remote.+ - The direct push is done first, because some hosting providers like+ - github may treat the first branch pushed to a new repository as the+ - default branch for that repository.  -  - The sync push first sends the synced/master branch,  - and then forces the update of the remote synced/git-annex branch.  -- - Since some providers like github may treat the first branch sent- - as the default branch, it's better to make that be synced/master than- - synced/git-annex. (Although neither is ideal, it's the best that- - can be managed given the constraints on order.)- -  - The forcing is necessary if a transition has rewritten the git-annex branch.  - Normally any changes to the git-annex branch get pulled and merged before  - this push, so this forcing is unlikely to overwrite new data pushed@@ -728,34 +720,59 @@  - But overwriting of data on synced/git-annex can happen, in a race.  - The only difference caused by using a forced push in that case is that  - the last repository to push wins the race, rather than the first to push.+ -+ - The git-annex branch is pushed last. This push may fail if the remote+ - has other changes in the git-annex branch, and that is not treated as an+ - error, since the synced/git-annex branch has been sent already. Since no+ - new data is usually sent in this push (due to synced/git-annex already+ - having been pushed), it's ok to hide git's output to avoid displaying+ - a push error.  -} pushBranch :: Remote -> Maybe Git.Branch -> MessageState -> Git.Repo -> IO Bool-pushBranch remote mbranch ms g = directpush `after` annexpush `after` syncpush+pushBranch remote mbranch ms g = do+	directpush+	annexpush `after` syncpush   where-	syncpush = flip Git.Command.runBool g $ pushparams $ catMaybes-		[ (refspec . origBranch) <$> mbranch-		, Just $ Git.Branch.forcePush $ refspec Annex.Branch.name-		]-	annexpush = void $ tryIO $ flip Git.Command.runQuiet g $ pushparams-		[ Git.fromRef $ Git.Ref.base $ Annex.Branch.name ] 	directpush = case mbranch of-		Nothing -> noop-		-- Git prints out an error message when this fails.-		-- In the default configuration of receive.denyCurrentBranch,-		-- the error message mentions that config setting-		-- (and should even if it is localized), and is quite long,-		-- and the user was not intending to update the checked out-		-- branch, so in that case, avoid displaying the error-		-- message. Do display other error messages though,-		-- including the error displayed when-		-- receive.denyCurrentBranch=updateInstead -- the user-		-- will want to see that one. 		Just branch -> do 			let p = flip Git.Command.gitCreateProcess g $ pushparams 				[ Git.fromRef $ Git.Ref.base $ origBranch branch ]-			(transcript, ok) <- processTranscript' p Nothing-			when (not ok && not ("denyCurrentBranch" `isInfixOf` transcript)) $-				hPutStr stderr transcript+			let p' = p { std_err = CreatePipe }+			bracket (createProcess p') cleanupProcess $ \h -> do+				filterstderr [] (stderrHandle h) (processHandle h)+				void $ waitForProcess (processHandle h)+		Nothing -> noop+				+	syncpush = flip Git.Command.runBool g $ pushparams $ catMaybes+		[ (syncrefspec . origBranch) <$> mbranch+		, Just $ Git.Branch.forcePush $ syncrefspec Annex.Branch.name+		]+	+	annexpush = void $ tryIO $ flip Git.Command.runQuiet g $ pushparams+		[ Git.fromRef $ Git.Ref.base $ Annex.Branch.name ]+	+	-- In the default configuration of receive.denyCurrentBranch,+	-- git's stderr message mentions that config setting+	-- (and should even if it is localized), and is quite long,+	-- and the user was not intending to update the checked out+	-- branch, so in that case, avoid displaying the error+	-- message. Do display other error messages though,+	-- including the error displayed when+	-- receive.denyCurrentBranch=updateInstead; the user+	-- will want to see that one. Also display progress messages.+	filterstderr buf herr pid = hGetLineUntilExitOrEOF pid herr >>= \case+		Just l+			| "remote: " `isPrefixOf` l || not (null buf)-> +				filterstderr (l:buf) herr pid+			| otherwise -> do+				hPutStrLn stderr l+				filterstderr [] herr pid+		Nothing -> displaybuf+	  where+		displaybuf = +			unless (any ("receive.denyCurrentBranch" `isInfixOf`) buf) $+				mapM_ (hPutStrLn stderr) (reverse buf)+	 	pushparams branches = catMaybes 		[ Just $ Param "push" 		, if commandProgressDisabled' ms@@ -763,7 +780,8 @@ 			else Nothing 		, Just $ Param $ Remote.name remote 		] ++ map Param branches-	refspec b = concat +	+	syncrefspec b = concat  		[ Git.fromRef $ Git.Ref.base b 		,  ":" 		, Git.fromRef $ Git.Ref.base $ syncBranch b@@ -1139,9 +1157,9 @@   where 	showwarning = earlyWarning $ 		"git-annex sync will change default behavior in the future to"-		<> " send content to repositories that have"+		<> " sync content with repositories that have" 		<> " preferred content configured. If you do not want this to"-		<> " send any content, use --no-content (or -g)"+		<> " sync any content, use --no-content (or -g)" 		<> " to prepare for that change." 		<> " (Or you can configure annex.synccontent)" 	preferredcontentconfigured m u =
Remote/Directory.hs view
@@ -84,11 +84,12 @@ 	cst <- remoteCost gc c cheapRemoteCost 	let chunkconfig = getChunkConfig c 	cow <- liftIO newCopyCoWTried+	fastcopy <- getFastCopy gc 	let ii = IgnoreInodes $ fromMaybe True $ 		getRemoteConfigValue ignoreinodesField c 	return $ Just $ specialRemote c-		(storeKeyM dir chunkconfig cow)-		(retrieveKeyFileM dir chunkconfig cow)+		(storeKeyM dir chunkconfig cow fastcopy)+		(retrieveKeyFileM dir chunkconfig cow fastcopy) 		(removeKeyM dir) 		(checkPresentM dir chunkconfig) 		Remote@@ -105,8 +106,8 @@ 			, checkPresent = checkPresentDummy 			, checkPresentCheap = True 			, exportActions = ExportActions-				{ storeExport = storeExportM dir cow-				, retrieveExport = retrieveExportM dir cow+				{ storeExport = storeExportM dir cow fastcopy+				, retrieveExport = retrieveExportM dir cow fastcopy 				, removeExport = removeExportM dir 				, checkPresentExport = checkPresentExportM dir 				-- Not needed because removeExportLocation@@ -118,7 +119,7 @@ 				{ listImportableContents = listImportableContentsM ii dir 				, importKey = Just (importKeyM ii dir) 				, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM ii dir cow-				, storeExportWithContentIdentifier = storeExportWithContentIdentifierM ii dir cow+				, storeExportWithContentIdentifier = storeExportWithContentIdentifierM ii dir cow fastcopy 				, removeExportWithContentIdentifier = removeExportWithContentIdentifierM ii dir 				-- Not needed because removeExportWithContentIdentifier 				-- auto-removes empty directories.@@ -189,8 +190,8 @@  {- Check if there is enough free disk space in the remote's directory to  - store the key. Note that the unencrypted key size is checked. -}-storeKeyM :: OsPath -> ChunkConfig -> CopyCoWTried -> Storer-storeKeyM d chunkconfig cow k c m = +storeKeyM :: OsPath -> ChunkConfig -> CopyCoWTried -> FastCopy -> Storer+storeKeyM d chunkconfig cow fastcopy k c m =  	ifM (checkDiskSpaceDirectory d k) 		( do 			void $ liftIO $ tryIO $ createDirectoryUnder [d] tmpdir@@ -210,7 +211,7 @@ 			in byteStorer go k c m 		NoChunks -> 			let go _k src p = liftIO $ do-				void $ fileCopier cow src tmpf p Nothing+				void $ fileCopier cow fastcopy src tmpf p Nothing 				finalizeStoreGeneric d tmpdir destdir 			in fileStorer go k c m 		_ -> @@ -247,12 +248,12 @@ 		mapM_ preventWrite =<< dirContents dest 		preventWrite dest -retrieveKeyFileM :: OsPath -> ChunkConfig -> CopyCoWTried -> Retriever-retrieveKeyFileM d (LegacyChunks _) _ = Legacy.retrieve locations' d-retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do+retrieveKeyFileM :: OsPath -> ChunkConfig -> CopyCoWTried -> FastCopy -> Retriever+retrieveKeyFileM d (LegacyChunks _) _ _ = Legacy.retrieve locations' d+retrieveKeyFileM d NoChunks cow fastcopy = fileRetriever' $ \dest k p iv -> do 	src <- liftIO $ getLocation d k-	void $ liftIO $ fileCopier cow src dest p iv-retrieveKeyFileM d _ _ = byteRetriever $ \k sink ->+	void $ liftIO $ fileCopier cow fastcopy src dest p iv+retrieveKeyFileM d _ _ _ = byteRetriever $ \k sink -> 	sink =<< liftIO (F.readFile =<< getLocation d k)  retrieveKeyFileCheapM :: OsPath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> OsPath -> Annex ())@@ -327,8 +328,8 @@ 		) 	) -storeExportM :: OsPath -> CopyCoWTried -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex ()-storeExportM d cow src _k loc p = do+storeExportM :: OsPath -> CopyCoWTried -> FastCopy -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportM d cow fastcopy src _k loc p = do 	liftIO $ createDirectoryUnder [d] (takeDirectory dest) 	-- Write via temp file so that checkPresentGeneric will not 	-- see it until it's fully stored.@@ -336,12 +337,12 @@   where 	dest = exportPath d loc 	go tmp () = void $ liftIO $-		fileCopier cow src tmp p Nothing+		fileCopier cow fastcopy src tmp p Nothing -retrieveExportM :: OsPath -> CopyCoWTried -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification-retrieveExportM d cow k loc dest p = +retrieveExportM :: OsPath -> CopyCoWTried -> FastCopy -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification+retrieveExportM d cow fastcopy k loc dest p =  	verifyKeyContentIncrementally AlwaysVerify k $ \iv -> -		void $ liftIO $ fileCopier cow src dest p iv+		void $ liftIO $ fileCopier cow fastcopy src dest p iv   where 	src = exportPath d loc @@ -533,13 +534,13 @@ 			=<< R.getSymbolicLinkStatus f' 		guardSameContentIdentifiers cont cids currcid -storeExportWithContentIdentifierM :: IgnoreInodes -> OsPath -> CopyCoWTried -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier-storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do+storeExportWithContentIdentifierM :: IgnoreInodes -> OsPath -> CopyCoWTried -> FastCopy -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier+storeExportWithContentIdentifierM ii dir cow fastcopy src _k loc overwritablecids p = do 	liftIO $ createDirectoryUnder [dir] destdir 	withTmpFileIn destdir template $ \tmpf tmph -> do 		let tmpf' = fromOsPath tmpf 		liftIO $ hClose tmph-		void $ liftIO $ fileCopier cow src tmpf p Nothing+		void $ liftIO $ fileCopier cow fastcopy src tmpf p Nothing 		resetAnnexFilePerm tmpf 		liftIO (R.getSymbolicLinkStatus tmpf') >>= liftIO . mkContentIdentifier ii tmpf >>= \case 			Nothing -> giveup "unable to generate content identifier"
Remote/Git.hs view
@@ -440,7 +440,7 @@ 	inAnnex' repo rmt st key  inAnnex' :: Git.Repo -> Remote -> State -> Key -> Annex Bool-inAnnex' repo rmt st@(State connpool duc _ _ _) key+inAnnex' repo rmt st@(State connpool duc _ _ _ _) key 	| isP2PHttp rmt = checkp2phttp 	| Git.repoIsHttp repo = checkhttp 	| Git.repoIsUrl repo = checkremote@@ -482,7 +482,7 @@ 	dropKey' repo r st proof key  dropKey' :: Git.Repo -> Remote -> State -> Maybe SafeDropProof -> Key -> Annex ()-dropKey' repo r st@(State connpool duc _ _ _) proof key+dropKey' repo r st@(State connpool duc _ _ _ _) proof key 	| isP2PHttp r =  		clientRemoveWithProof proof key unabletoremove r >>= \case 			RemoveResultPlus True fanoutuuids ->@@ -531,7 +531,7 @@ 	lockKey' repo r st key callback  lockKey' :: Git.Repo -> Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r-lockKey' repo r st@(State connpool duc _ _ _) key callback+lockKey' repo r st@(State connpool duc _ _ _ _) key callback 	| isP2PHttp r = do	 		showLocking r 		p2pHttpClient r giveup (clientLockContent key) >>= \case@@ -566,7 +566,7 @@ 	copyFromRemote'' repo r st key file dest meterupdate vc  copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> OsPath -> MeterUpdate -> VerifyConfig -> Annex Verification-copyFromRemote'' repo r st@(State connpool _ _ _ _) key af dest meterupdate vc+copyFromRemote'' repo r st@(State connpool _ _ _ _ _) key af dest meterupdate vc 	| isP2PHttp r = copyp2phttp 	| Git.repoIsHttp repo = verifyKeyContentIncrementally vc key $ \iv -> do 		gc <- Annex.getGitConfig@@ -642,7 +642,7 @@ 	copyToRemote' repo r st key af o meterupdate  copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()-copyToRemote' repo r st@(State connpool duc _ _ _) key af o meterupdate+copyToRemote' repo r st@(State connpool duc _ _ _ _) key af o meterupdate 	| isP2PHttp r = prepsendwith copyp2phttp 	| not $ Git.repoIsUrl repo = ifM duc 		( guardUsable repo (giveup "cannot access remote") $ commitOnCleanup repo r st $@@ -753,7 +753,7 @@  - when possible.  -} onLocal :: State -> Annex a -> Annex a-onLocal (State _ _ _ _ lra) = onLocal' lra+onLocal (State _ _ _ _ _ lra) = onLocal' lra  onLocalRepo :: Git.Repo -> Annex a -> Annex a onLocalRepo repo a = do@@ -830,7 +830,7 @@ -- done. Also returns Verified if the key's content is verified while -- copying it. mkFileCopier :: Bool -> State -> Annex FileCopier-mkFileCopier remotewanthardlink (State _ _ copycowtried _ _) = do+mkFileCopier remotewanthardlink (State _ _ copycowtried fastcopy _ _) = do 	localwanthardlink <- wantHardLink 	let linker = \src dest -> R.createLink (fromOsPath src) (fromOsPath dest) >> return True 	if remotewanthardlink || localwanthardlink@@ -848,7 +848,7 @@   where 	copier src dest k p check verifyconfig = do 		iv <- startVerifyKeyContentIncrementally verifyconfig k-		liftIO (fileCopier copycowtried src dest p iv) >>= \case+		liftIO (fileCopier copycowtried fastcopy src dest p iv) >>= \case 			Copied -> ifM check 				( finishVerifyKeyContentIncrementally iv 				, do@@ -864,24 +864,25 @@  - This returns False when the repository UUID is not as expected. -} type DeferredUUIDCheck = Annex Bool -data State = State Ssh.P2PShellConnectionPool DeferredUUIDCheck CopyCoWTried (Annex (Git.Repo, GitConfig)) LocalRemoteAnnex+data State = State Ssh.P2PShellConnectionPool DeferredUUIDCheck CopyCoWTried FastCopy (Annex (Git.Repo, GitConfig)) LocalRemoteAnnex  getRepoFromState :: State -> Annex Git.Repo-getRepoFromState (State _ _ _ a _) = fst <$> a+getRepoFromState (State _ _ _ _ a _) = fst <$> a  #ifndef mingw32_HOST_OS {- The config of the remote git repository, cached for speed. -} getGitConfigFromState :: State -> Annex GitConfig-getGitConfigFromState (State _ _ _ a _) = snd <$> a+getGitConfigFromState (State _ _ _ _ a _) = snd <$> a #endif  mkState :: Git.Repo -> UUID -> RemoteGitConfig -> Annex State mkState r u gc = do 	pool <- Ssh.mkP2PShellConnectionPool 	copycowtried <- liftIO newCopyCoWTried+	fastcopy <- getFastCopy gc 	lra <- mkLocalRemoteAnnex r 	(duc, getrepo) <- go-	return $ State pool duc copycowtried getrepo lra+	return $ State pool duc copycowtried fastcopy getrepo lra   where 	go 		| remoteAnnexCheckUUID gc = return
Test/Framework.hs view
@@ -804,9 +804,10 @@  	go Nothing = summarizeresults $ withConcurrentOutput $ do 		ensuredir tmpdir-		crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem'-			(toOsPath tmpdir)-			Nothing Nothing False+		crippledfilesystem <- fromMaybe False . fst +			<$> Annex.Init.probeCrippledFileSystem'+				(toOsPath tmpdir)+				Nothing Nothing False 		adjustedbranchok <- Annex.AdjustedBranch.isGitVersionSupported 		let ts = mkts numparts crippledfilesystem adjustedbranchok opts 		let warnings = fst (tastyParser ts)
Types/GitConfig.hs view
@@ -1,6 +1,6 @@ {- git-annex configuration  -- - Copyright 2012-2024 Joey Hess <id@joeyh.name>+ - Copyright 2012-2025 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -135,6 +135,7 @@ 	, annexDifferences :: Differences 	, annexUsedRefSpec :: Maybe RefSpec 	, annexVerify :: Bool+	, annexFastCopy :: Bool 	, annexPidLock :: Bool 	, annexPidLockTimeout :: Seconds 	, annexDbDir :: Maybe OsPath@@ -241,6 +242,7 @@ 	, annexUsedRefSpec = either (const Nothing) Just . parseRefSpec  		=<< getmaybe (annexConfig "used-refspec") 	, annexVerify = getbool (annexConfig "verify") True+	, annexFastCopy = getbool (annexConfig "fastcopy") False 	, annexPidLock = getbool (annexConfig "pidlock") False 	, annexPidLockTimeout = Seconds $ fromMaybe 300 $ 		getmayberead (annexConfig "pidlocktimeout")@@ -387,6 +389,7 @@ 	, remoteAnnexPush :: Bool 	, remoteAnnexReadOnly :: Bool 	, remoteAnnexVerify :: Bool+	, remoteAnnexFastCopy :: Bool 	, remoteAnnexCheckUUID :: Bool 	, remoteAnnexTrackingBranch :: Maybe Git.Ref 	, remoteAnnexTrustLevel :: Maybe String@@ -466,6 +469,7 @@ 		, remoteAnnexReadOnly = getbool ReadOnlyField False 		, remoteAnnexCheckUUID = getbool CheckUUIDField True 		, remoteAnnexVerify = getbool VerifyField True+		, remoteAnnexFastCopy = getbool FastCopyField False 		, remoteAnnexTrackingBranch = Git.Ref . encodeBS <$> 			( notempty (getmaybe TrackingBranchField) 			<|> notempty (getmaybe ExportTrackingField) -- old name@@ -574,6 +578,7 @@ 	| ReadOnlyField 	| CheckUUIDField 	| VerifyField+	| FastCopyField 	| TrackingBranchField 	| ExportTrackingField 	| TrustLevelField@@ -644,6 +649,7 @@ 	ReadOnlyField -> inherited True "readonly" 	CheckUUIDField -> uninherited True "checkuuid" 	VerifyField -> inherited True "verify"+	FastCopyField -> inherited True "fastcopy" 	TrackingBranchField -> uninherited True "tracking-branch" 	ExportTrackingField -> uninherited True "export-tracking" 	TrustLevelField -> uninherited True "trustlevel"
Utility/CopyFile.hs view
@@ -43,7 +43,12 @@  {- The cp command is used, because I hate reinventing the wheel,  - and because this allows easy access to features like cp --reflink- - and preserving metadata. -}+ - and preserving metadata.+ -+ - This uses --reflink=auto when supported, which allows for fast copies+ - using reflinks or the copy_file_range syscall. Whatever cp thinks is+ - best. --reflink=auto is the default of recent versions of cp, but is+ - used explicitly to support older versions. -} copyFileExternal :: CopyMetaData -> OsPath -> OsPath -> IO Bool copyFileExternal meta src dest = do 	-- Delete any existing dest file because an unwritable file@@ -81,8 +86,8 @@ 	| otherwise = return False   where  	-- Note that in coreutils 9.0, cp uses CoW by default,-	-- without needing an option. This s only needed to support -	-- older versions.+	-- without needing an option. But, this makes it fail if it is+	-- unable to make a CoW copy. 	params = Param "--reflink=always" : copyMetaDataParams meta  {- Create a hard link if the filesystem allows it, and fall back to copying
Utility/MoveFile.hs view
@@ -65,10 +65,12 @@ 			let (ok, e') = case r of 				Left err -> (False, err) 				Right _ -> (True, e)+			when ok $+				void $ tryIO $ removeFile src #endif 			unless ok $ do 				-- delete any partial-				_ <- tryIO $ removeFile tmp+				void $ tryIO $ removeFile tmp 				throwM e'  #ifndef mingw32_HOST_OS
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20250520+Version: 10.20250605 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>