git-annex 10.20240227 → 10.20240430

raw patch · 68 files changed

+973/−378 lines, 68 filesdep +unbounded-delays

Dependencies added: unbounded-delays

Files

• Annex/AdjustedBranch.hs +15/−4
• Annex/AdjustedBranch/Merge.hs +2/−1
• Annex/Branch.hs +3/−3
• Annex/Common.hs +1/−1
• Annex/Content.hs +3/−1
• Annex/ExternalAddonProcess.hs +5/−5
• Annex/Import.hs +2/−2
• Annex/Locations.hs +1/−1
• Annex/RemoteTrackingBranch.hs +1/−1
• Annex/Transfer.hs +56/−29
• Annex/Verify.hs +30/−12
• Annex/View.hs +2/−2
• Annex/View/ViewedFile.hs +13/−8
• Assistant/Threads/TransferPoller.hs +1/−1
• Backend.hs +23/−22
• Backend/External.hs +3/−1
• Backend/Hash.hs +16/−8
• Backend/URL.hs +11/−9
• Backend/Utilities.hs +13/−6
• Backend/VURL.hs +102/−0
• Backend/VURL/Utilities.hs +57/−0
• Backend/Variety.hs +39/−0
• Backend/WORM.hs +3/−2
• CHANGELOG +30/−2
• COPYRIGHT +0/−5
• CmdLine/GitAnnex.hs +2/−0
• CmdLine/GitAnnex/Options.hs +1/−1
• Command/AddUrl.hs +14/−8
• Command/ExamineKey.hs +1/−1
• Command/Export.hs +17/−10
• Command/FilterBranch.hs +1/−1
• Command/FromKey.hs +1/−1
• Command/Fsck.hs +31/−33
• Command/Import.hs +9/−9
• Command/ImportFeed.hs +2/−2
• Command/Migrate.hs +2/−2
• Command/ReregisterUrl.hs +79/−0
• Command/Sync.hs +15/−13
• Database/Keys.hs +1/−1
• Git/Branch.hs +17/−4
• Git/UnionMerge.hs +5/−5
• Limit.hs +1/−1
• Logs.hs +17/−2
• Logs/EquivilantKeys.hs +31/−0
• Logs/Transfer.hs +67/−41
• Remote/Adb.hs +1/−1
• Remote/BitTorrent.hs +1/−1
• Remote/Directory.hs +1/−1
• Remote/External.hs +81/−58
• Remote/External/Types.hs +12/−7
• Remote/Helper/ExportImport.hs +2/−2
• Remote/Helper/ReadOnly.hs +1/−4
• Remote/List.hs +2/−0
• Remote/Rclone.hs +31/−0
• Remote/Rsync.hs +1/−1
• Remote/S3.hs +1/−1
• Remote/Web.hs +45/−5
• Remote/WebDAV.hs +1/−1
• Types/Backend.hs +8/−3
• Types/GitConfig.hs +2/−0
• Types/Key.hs +8/−4
• Types/Remote.hs +1/−1
• Utility/FileSystemEncoding.hs +4/−3
• Utility/MoveFile.hs +3/−3
• Utility/StatelessOpenPGP.hs +7/−2
• Utility/Terminal.hs +1/−2
• Utility/ThreadScheduler.hs +5/−16
• git-annex.cabal +8/−1

@@ -468,19 +468,30 @@ 			(commitAuthorMetaData basiscommit) 			(commitCommitterMetaData basiscommit) 			(mkcommit cmode)-	mkcommit cmode = Git.Branch.commitTree cmode+	-- Make sure that the exact message is used in the commit,+	-- since that message is looked for later.+	-- After git-annex 10.20240227, it's possible to use+	-- commitTree instead of this, but this is being kept+	-- for some time, for compatability with older versions.+	mkcommit cmode = Git.Branch.commitTreeExactMessage cmode 		adjustedBranchCommitMessage parents treesha  {- This message should never be changed. -} adjustedBranchCommitMessage :: String adjustedBranchCommitMessage = "git-annex adjusted branch" +{- Allow for a trailing newline after the message. -}+hasAdjustedBranchCommitMessage :: Commit -> Bool+hasAdjustedBranchCommitMessage c = +	dropWhileEnd (\x -> x == '\n' || x == '\r') (commitMessage c) +		== adjustedBranchCommitMessage+ findAdjustingCommit :: AdjBranch -> Annex (Maybe Commit) findAdjustingCommit (AdjBranch b) = go =<< catCommit b   where 	go Nothing = return Nothing 	go (Just c)-		| commitMessage c == adjustedBranchCommitMessage = return (Just c)+		| hasAdjustedBranchCommitMessage c = return (Just c) 		| otherwise = case commitParent c of 			[p] -> go =<< catCommit p 			_ -> return Nothing@@ -540,7 +551,7 @@ 		return (Right parent) 	go origsha parent pastadjcommit (sha:l) = catCommit sha >>= \case 		Just c-			| commitMessage c == adjustedBranchCommitMessage ->+			| hasAdjustedBranchCommitMessage c -> 				go origsha parent True l 			| pastadjcommit -> 				reverseAdjustedCommit parent adj (sha, c) origbranch@@ -577,7 +588,7 @@ 			(commitAuthorMetaData basiscommit) 			(commitCommitterMetaData basiscommit) $ 				Git.Branch.commitTree cmode-					(commitMessage basiscommit)+					[commitMessage basiscommit] 					[commitparent] treesha 		return (Right revadjcommit) 

@@ -153,7 +153,8 @@ 			then do 				cmode <- annexCommitMode <$> Annex.getGitConfig 				c <- inRepo $ Git.Branch.commitTree cmode-					("Merged " ++ fromRef tomerge) [adjmergecommit]+					["Merged " ++ fromRef tomerge]+					[adjmergecommit] 					(commitTree currentcommit) 				inRepo $ Git.Branch.update "updating adjusted branch" currbranch c 				propigateAdjustedCommits origbranch adj

@@ -52,7 +52,7 @@ import qualified System.FilePath.ByteString as P import System.PosixCompat.Files (isRegularFile) -import Annex.Common hiding (append)+import Annex.Common import Types.BranchState import Annex.BranchState import Annex.Journal@@ -945,9 +945,9 @@ 	addedt <- inRepo $ Git.Tree.graftTree treeish graftpoint origtree 	cmode <- annexCommitMode <$> Annex.getGitConfig 	c <- inRepo $ Git.Branch.commitTree cmode-		"graft" [branchref] addedt+		["graft"] [branchref] addedt 	c' <- inRepo $ Git.Branch.commitTree cmode-		"graft cleanup" [c] origtree+		["graft cleanup"] [c] origtree 	inRepo $ Git.Branch.update' fullname c' 	-- The tree in c' is the same as the tree in branchref, 	-- and the index was updated to that above, so it's safe to

@@ -12,5 +12,5 @@ import Messages as X import Git.Quote as X #ifndef mingw32_HOST_OS-import System.Posix.IO as X hiding (createPipe)+import System.Posix.IO as X hiding (createPipe, append) #endif

@@ -103,7 +103,9 @@ import Utility.InodeCache import Utility.CopyFile import Utility.Metered+#ifndef mingw32_HOST_OS import Utility.FileMode+#endif import qualified Utility.RawFilePath as R  import qualified System.FilePath.ByteString as P@@ -439,7 +441,7 @@ 	alreadyhave = liftIO $ R.removeLink src  checkSecureHashes :: Key -> Annex (Maybe String)-checkSecureHashes key = ifM (Backend.isCryptographicallySecure key)+checkSecureHashes key = ifM (Backend.isCryptographicallySecureKey key) 	( return Nothing 	, ifM (annexSecureHashesOnly <$> Annex.getGitConfig) 		( return $ Just $ "annex.securehashesonly blocked adding " ++ decodeBS (formatKeyVariety (fromKey keyVariety key)) ++ " key"

@@ -1,6 +1,6 @@ {- External addon processes for special remotes and backends.  -- - Copyright 2013-2020 Joey Hess <id@joeyh.name>+ - Copyright 2013-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -33,16 +33,16 @@ 	= ProgramNotInstalled String 	| ProgramFailure String -startExternalAddonProcess :: String -> ExternalAddonPID -> Annex (Either ExternalAddonStartError ExternalAddonProcess)-startExternalAddonProcess basecmd pid = do+startExternalAddonProcess :: String -> [CommandParam] -> ExternalAddonPID -> Annex (Either ExternalAddonStartError ExternalAddonProcess)+startExternalAddonProcess basecmd ps pid = do 	errrelayer <- mkStderrRelayer 	g <- Annex.gitRepo 	cmdpath <- liftIO $ searchPath basecmd 	liftIO $ start errrelayer g cmdpath   where 	start errrelayer g cmdpath = do-		(cmd, ps) <- maybe (pure (basecmd, [])) findShellCommand cmdpath-		let basep = (proc cmd (toCommand ps))+		(cmd, cmdps) <- maybe (pure (basecmd, [])) findShellCommand cmdpath+		let basep = (proc cmd (toCommand (cmdps ++ ps))) 			{ std_in = CreatePipe 			, std_out = CreatePipe 			, std_err = CreatePipe

@@ -86,7 +86,7 @@ 	{ importCommitTracking :: Maybe Sha 	-- ^ Current commit on the remote tracking branch. 	, importCommitMode :: Git.Branch.CommitMode-	, importCommitMessage :: String+	, importCommitMessages :: [String] 	}  {- Buils a commit for an import from a special remote.@@ -251,7 +251,7 @@  	mkcommit parents tree = inRepo $ Git.Branch.commitTree 		(importCommitMode importcommitconfig)-		(importCommitMessage importcommitconfig)+		(importCommitMessages importcommitconfig) 		parents 		tree 

@@ -506,7 +506,7 @@ gitAnnexWebPrivKey :: Git.Repo -> FilePath gitAnnexWebPrivKey r = fromRawFilePath $ gitAnnexDir r P.</> "privkey.pem" -{- .git/annex/feeds/ is used to record per-key (url) state by importfeeds -}+{- .git/annex/feeds/ is used to record per-key (url) state by importfeed -} gitAnnexFeedStateDir :: Git.Repo -> RawFilePath gitAnnexFeedStateDir r = P.addTrailingPathSeparator $ 	gitAnnexDir r P.</> "feedstate"

@@ -77,7 +77,7 @@ 	cmode <- annexCommitMode <$> Annex.getGitConfig 	inRepo $ Git.Branch.commitTree 			cmode-			"remote tracking branch"+			["remote tracking branch"] 			[commitsha, importedhistory] 			treesha 

@@ -1,6 +1,6 @@ {- git-annex transfers  -- - Copyright 2012-2023 Joey Hess <id@joeyh.name>+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -42,7 +42,7 @@ import Annex.WorkerPool import Annex.TransferrerPool import Annex.StallDetection-import Backend (isCryptographicallySecure)+import Backend (isCryptographicallySecureKey) import Types.StallDetection import qualified Utility.RawFilePath as R @@ -128,9 +128,10 @@   where 	go = do 		info <- liftIO $ startTransferInfo afile-		(meter, tfile, createtfile, metervar) <- mkProgressUpdater t info+		(tfile, lckfile, moldlckfile) <- fromRepo $ transferFileAndLockFile t+		(meter, createtfile, metervar) <- mkProgressUpdater t info tfile 		mode <- annexFileMode-		(lck, inprogress) <- prep tfile createtfile mode+		(lck, inprogress) <- prep lckfile moldlckfile createtfile mode 		if inprogress && not ignorelock 			then do 				warning "transfer already in progress, or unable to take transfer lock"@@ -139,51 +140,75 @@ 				v <- retry 0 info metervar $ 					detectStallsAndSuggestConfig stalldetection metervar $ 						transferaction meter-				liftIO $ cleanup tfile lck+				liftIO $ cleanup tfile lckfile moldlckfile lck 				if observeBool v 					then removeFailedTransfer t 					else recordFailedTransfer t info 				return v 	-	prep :: RawFilePath -> Annex () -> ModeSetter -> Annex (Maybe LockHandle, Bool)+	prep :: RawFilePath -> Maybe RawFilePath -> Annex () -> ModeSetter -> Annex (Maybe (LockHandle, Maybe LockHandle), Bool) #ifndef mingw32_HOST_OS-	prep tfile createtfile mode = catchPermissionDenied (const prepfailed) $ do-		let lck = transferLockFile tfile-		createAnnexDirectory $ P.takeDirectory lck-		tryLockExclusive (Just mode) lck >>= \case+	prep lckfile moldlckfile createtfile mode = catchPermissionDenied (const prepfailed) $ do+		createAnnexDirectory $ P.takeDirectory lckfile+		tryLockExclusive (Just mode) lckfile >>= \case 			Nothing -> return (Nothing, True) 			-- Since the lock file is removed in cleanup, 			-- there's a race where different processes 			-- may have a deleted and a new version of the same 			-- lock file open. checkSaneLock guards against 			-- that.-			Just lockhandle -> ifM (checkSaneLock lck lockhandle)-				( do-					createtfile-					return (Just lockhandle, False)+			Just lockhandle -> ifM (checkSaneLock lckfile lockhandle)+				( case moldlckfile of+					Nothing -> do+						createtfile+						return (Just (lockhandle, Nothing), False)+					Just oldlckfile -> do+						createAnnexDirectory $ P.takeDirectory oldlckfile+						tryLockExclusive (Just mode) oldlckfile >>= \case+							Nothing -> do+								liftIO $ dropLock lockhandle+								return (Nothing, True)+							Just oldlockhandle -> ifM (checkSaneLock oldlckfile oldlockhandle)+								( do+									createtfile+									return (Just (lockhandle, Just oldlockhandle), False)+								, do+									liftIO $ dropLock oldlockhandle+									liftIO $ dropLock lockhandle+									return (Nothing, True)+								) 				, do 					liftIO $ dropLock lockhandle 					return (Nothing, True) 				) #else-	prep tfile createtfile _mode = catchPermissionDenied (const prepfailed) $ do-		let lck = transferLockFile tfile-		createAnnexDirectory $ P.takeDirectory lck-		catchMaybeIO (liftIO $ lockExclusive lck) >>= \case-			Nothing -> return (Nothing, False)-			Just Nothing -> return (Nothing, True)-			Just (Just lockhandle) -> do-				createtfile-				return (Just lockhandle, False)+	prep lckfile moldlckfile createtfile _mode = catchPermissionDenied (const prepfailed) $ do+		createAnnexDirectory $ P.takeDirectory lckfile+		catchMaybeIO (liftIO $ lockExclusive lckfile) >>= \case+			Just (Just lockhandle) -> case moldlckfile of+				Nothing -> do+					createtfile+					return (Just (lockhandle, Nothing), False)+				Just oldlckfile -> do+					createAnnexDirectory $ P.takeDirectory oldlckfile+					catchMaybeIO (liftIO $ lockExclusive oldlckfile) >>= \case+						Just (Just oldlockhandle) -> do+							createtfile+							return (Just (lockhandle, Just oldlockhandle), False)+						_ -> do+							liftIO $ dropLock lockhandle+							return (Nothing, False)+			_ -> return (Nothing, False) #endif 	prepfailed = return (Nothing, False) -	cleanup _ Nothing = noop-	cleanup tfile (Just lockhandle) = do-		let lck = transferLockFile tfile+	cleanup _ _ _ Nothing = noop+	cleanup tfile lckfile moldlckfile (Just (lockhandle, moldlockhandle)) = do 		void $ tryIO $ R.removeLink tfile #ifndef mingw32_HOST_OS-		void $ tryIO $ R.removeLink lck+		void $ tryIO $ R.removeLink lckfile+		maybe noop (void . tryIO . R.removeLink) moldlckfile+		maybe noop dropLock moldlockhandle 		dropLock lockhandle #else 		{- Windows cannot delete the lockfile until the lock@@ -191,8 +216,10 @@ 		 - process that takes the lock before it's removed, 		 - so ignore failure to remove. 		 -}+		maybe noop dropLock moldlockhandle 		dropLock lockhandle-		void $ tryIO $ R.removeLink lck+		void $ tryIO $ R.removeLink lckfile+		maybe noop (void . tryIO . R.removeLink) moldlckfile #endif  	retry numretries oldinfo metervar run =@@ -279,7 +306,7 @@ 		(pure (Types.Backend.isCryptographicallySecure eventualbackend)) 		(Types.Backend.backendVariety eventualbackend) 	Nothing -> go-		(isCryptographicallySecure k)+		(isCryptographicallySecureKey k) 		(fromKey keyVariety k)   where 	go checksecure variety = ifM checksecure

@@ -12,6 +12,7 @@ 	shouldVerify, 	verifyKeyContentPostRetrieval, 	verifyKeyContent,+	verifyKeyContent', 	Verification(..), 	unVerified, 	warnUnverifiableInsecure,@@ -97,16 +98,32 @@ 				resumeVerifyKeyContent k f iv 			_ -> verifyKeyContent k f +-- When possible, does an incremental verification, because that can be+-- faster. Eg, the VURL backend can need to try multiple checksums and only+-- with an incremental verification does it avoid reading files twice. verifyKeyContent :: Key -> RawFilePath -> Annex Bool verifyKeyContent k f = verifyKeySize k f <&&> verifyKeyContent' k f +-- Does not verify size. verifyKeyContent' :: Key -> RawFilePath -> Annex Bool verifyKeyContent' k f =  	Backend.maybeLookupBackendVariety (fromKey keyVariety k) >>= \case 		Nothing -> return True-		Just b -> case Types.Backend.verifyKeyContent b of-			Nothing -> return True-			Just verifier -> verifier k f+		Just b -> case (Types.Backend.verifyKeyContentIncrementally b, Types.Backend.verifyKeyContent b) of+			(Nothing, Nothing) -> return True+			(Just mkiv, mverifier) -> do+				iv <- mkiv k+				showAction (UnquotedString (descIncrementalVerifier iv))+				res <- liftIO $ catchDefaultIO Nothing $+					withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do+						feedIncrementalVerifier h iv+						finalizeIncrementalVerifier iv+				case res of+					Just res' -> return res'+					Nothing -> case mverifier of+						Nothing -> return True+						Just verifier -> verifier k f+			(Nothing, Just verifier) -> verifier k f  resumeVerifyKeyContent :: Key -> RawFilePath -> IncrementalVerifier -> Annex Bool resumeVerifyKeyContent k f iv = liftIO (positionIncrementalVerifier iv) >>= \case@@ -132,17 +149,18 @@ 			liftIO $ catchDefaultIO (Just False) $ 				withBinaryFile (fromRawFilePath f) ReadMode $ \h -> do 					hSeek h AbsoluteSeek endpos-					feedincremental h+					feedIncrementalVerifier h iv 					finalizeIncrementalVerifier iv 	-	feedincremental h = do-		b <- S.hGetSome h chunk-		if S.null b-			then return ()-			else do-				updateIncrementalVerifier iv b-				feedincremental h-+feedIncrementalVerifier :: Handle -> IncrementalVerifier -> IO ()+feedIncrementalVerifier h iv = do+	b <- S.hGetSome h chunk+	if S.null b+		then return ()+		else do+			updateIncrementalVerifier iv b+			feedIncrementalVerifier h iv+  where 	chunk = 65536  verifyKeySize :: Key -> RawFilePath -> Annex Bool

@@ -387,7 +387,7 @@ prop_view_roundtrips (AssociatedFile (Just f)) metadata visible = or 	[ B.null (P.takeFileName f) && B.null (P.takeDirectory f) 	, viewTooLarge view-	, all hasfields (viewedFiles view (viewedFileFromReference' Nothing) (fromRawFilePath f) metadata)+	, all hasfields (viewedFiles view (viewedFileFromReference' Nothing Nothing) (fromRawFilePath f) metadata) 	]   where 	view = View (Git.Ref "foo") $@@ -577,7 +577,7 @@ 			cmode <- annexCommitMode <$> Annex.getGitConfig 			let msg = "updated " ++ fromRef (branchView view madj) 			let parent = catMaybes [oldcommit]-			inRepo (Git.Branch.commitTree cmode msg parent newtree)+			inRepo (Git.Branch.commitTree cmode [msg] parent newtree) 		else return Nothing  {- Diff between currently checked out branch and staged changes, and

@@ -1,6 +1,6 @@ {- filenames (not paths) used in views  -- - Copyright 2014-2023 Joey Hess <id@joeyh.name>+ - Copyright 2014-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -19,6 +19,7 @@  import Annex.Common import Utility.QuickCheck+import Backend.Utilities (maxExtensions)  import qualified Data.ByteString as S @@ -37,10 +38,12 @@  - So, from dir/subdir/file.foo, generate file_%dir%subdir%.foo  -} viewedFileFromReference :: GitConfig -> MkViewedFile-viewedFileFromReference g = viewedFileFromReference' (annexMaxExtensionLength g)+viewedFileFromReference g = viewedFileFromReference'+	(annexMaxExtensionLength g)+	(annexMaxExtensions g) -viewedFileFromReference' :: Maybe Int -> MkViewedFile-viewedFileFromReference' maxextlen f = concat $+viewedFileFromReference' :: Maybe Int -> Maybe Int -> MkViewedFile+viewedFileFromReference' maxextlen maxextensions f = concat $ 	[ escape (fromRawFilePath base') 	, if null dirs then "" else "_%" ++ intercalate "%" (map escape dirs) ++ "%" 	, escape $ fromRawFilePath $ S.concat extensions'@@ -51,11 +54,12 @@ 	(base, extensions) = case maxextlen of 		Nothing -> splitShortExtensions (toRawFilePath basefile') 		Just n -> splitShortExtensions' (n+1) (toRawFilePath basefile')-	{- Limit to two extensions maximum. -}+	{- Limit number of extensions. -}+	maxextensions' = fromMaybe maxExtensions maxextensions 	(base', extensions')-		| length extensions <= 2 = (base, extensions)+		| length extensions <= maxextensions' = (base, extensions) 		| otherwise = -			let (es,more) = splitAt 2 (reverse extensions)+			let (es,more) = splitAt maxextensions' (reverse extensions) 			in (base <> mconcat (reverse more), reverse es) 	{- On Windows, if the filename looked like "dir/c:foo" then 	 - basefile would look like it contains a drive letter, which will@@ -101,7 +105,8 @@ 	-- Relative filenames wanted, not directories. 	| any (isPathSeparator) (end f ++ beginning f) = True 	| isAbsolute f || isDrive f = True-	| otherwise = dir == dirFromViewedFile (viewedFileFromReference' Nothing f)+	| otherwise = dir == dirFromViewedFile +		(viewedFileFromReference' Nothing Nothing f)   where 	f = fromTestableFilePath tf 	dir = joinPath $ beginning $ splitDirectories f

@@ -45,7 +45,7 @@ 		{- Otherwise, this code polls the upload progress 		 - by reading the transfer info file. -} 		| otherwise = do-			let f = transferFile t g+			let (f, _, _) = transferFileAndLockFile t g 			mi <- liftIO $ catchDefaultIO Nothing $ 				readTransferInfoFile Nothing (fromRawFilePath f) 			maybe noop (newsize t info . bytesComplete) mi

@@ -1,6 +1,6 @@ {- git-annex key/value backends  -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -10,6 +10,7 @@ module Backend ( 	builtinList, 	defaultBackend,+	defaultHashBackend, 	genKey, 	getBackend, 	chooseBackend,@@ -17,9 +18,12 @@ 	lookupBuiltinBackendVariety, 	maybeLookupBackendVariety, 	isStableKey,+	isCryptographicallySecureKey, 	isCryptographicallySecure, ) where +import qualified Data.Map as M+ import Annex.Common import qualified Annex import Annex.CheckAttr@@ -27,20 +31,15 @@ import Types.KeySource import qualified Types.Backend as B import Utility.Metered---- When adding a new backend, import it here and add it to the builtinList.-import qualified Backend.Hash-import qualified Backend.WORM-import qualified Backend.URL-import qualified Backend.External--import qualified Data.Map as M+import Backend.Variety+import qualified Backend.VURL  {- Built-in backends. Does not include externals. -} builtinList :: [Backend]-builtinList = Backend.Hash.backends ++ Backend.WORM.backends ++ Backend.URL.backends+builtinList = regularBackendList ++ Backend.VURL.backends -{- Backend to use by default when generating a new key. -}+{- Backend to use by default when generating a new key. Takes git config+ - and --backend option into account. -} defaultBackend :: Annex Backend defaultBackend = maybe cache return =<< Annex.getState Annex.backend   where@@ -49,7 +48,7 @@ 			=<< Annex.getRead Annex.forcebackend 		b <- case n of 			Just name | valid name -> lookupname name-			_ -> pure (Prelude.head builtinList)+			_ -> pure defaultHashBackend 		Annex.changeState $ \s -> s { Annex.backend = Just b } 		return b 	valid name = not (null name)@@ -99,22 +98,24 @@ lookupBuiltinBackendVariety v = fromMaybe (giveup (unknownBackendVarietyMessage v)) $ 	maybeLookupBuiltinBackendVariety v -maybeLookupBackendVariety :: KeyVariety -> Annex (Maybe Backend)-maybeLookupBackendVariety (ExternalKey s hasext) =-	Just <$> Backend.External.makeBackend s hasext-maybeLookupBackendVariety v = -	pure $ M.lookup v varietyMap- maybeLookupBuiltinBackendVariety :: KeyVariety -> Maybe Backend maybeLookupBuiltinBackendVariety v = M.lookup v varietyMap +maybeLookupBackendVariety :: KeyVariety -> Annex (Maybe Backend)+maybeLookupBackendVariety v = maybeLookupBackendVarietyMap v varietyMap+ varietyMap :: M.Map KeyVariety Backend-varietyMap = M.fromList $ zip (map B.backendVariety builtinList) builtinList+varietyMap = makeVarietyMap builtinList  isStableKey :: Key -> Annex Bool isStableKey k = maybe False (`B.isStableKey` k)  	<$> maybeLookupBackendVariety (fromKey keyVariety k) -isCryptographicallySecure :: Key -> Annex Bool-isCryptographicallySecure k = maybe False B.isCryptographicallySecure-	<$> maybeLookupBackendVariety (fromKey keyVariety k)+isCryptographicallySecureKey :: Key -> Annex Bool+isCryptographicallySecureKey k = maybe +	(pure False)+	(\b -> B.isCryptographicallySecureKey b k)+	=<< maybeLookupBackendVariety (fromKey keyVariety k)++isCryptographicallySecure :: Backend -> Bool+isCryptographicallySecure = B.isCryptographicallySecure

@@ -73,6 +73,7 @@ 		, fastMigrate = Nothing 		, isStableKey = const isstable 		, isCryptographicallySecure = iscryptographicallysecure+		, isCryptographicallySecureKey = const (pure iscryptographicallysecure) 		} makeBackend' ebname hasext (Left _) = return $ unavailBackend ebname hasext @@ -87,6 +88,7 @@ 		, fastMigrate = Nothing 		, isStableKey = const False 		, isCryptographicallySecure = False+		, isCryptographicallySecureKey = const (pure False) 		}  genKeyExternal :: ExternalBackendName -> HasExt -> KeySource -> MeterUpdate -> Annex Key@@ -213,7 +215,7 @@ -- using it. newExternalState :: ExternalBackendName -> HasExt -> ExternalAddonPID -> Annex ExternalState newExternalState ebname hasext pid = do-	st <- startExternalAddonProcess basecmd pid+	st <- startExternalAddonProcess basecmd [] pid 	st' <- case st of 		Left (ProgramNotInstalled msg) -> warnonce msg >> return st 		Left (ProgramFailure msg) -> warnonce msg >> return st

@@ -11,6 +11,7 @@ 	backends, 	testKeyBackend, 	keyHash,+	descChecksum, ) where  import Annex.Common@@ -52,8 +53,10 @@ cryptographicallySecure SHA1Hash = False cryptographicallySecure MD5Hash = False -{- Order is slightly significant; want SHA256 first, and more general- - sizes earlier. -}+{- Order is significant. The first hash is the default one that git-annex+ - uses, and must be cryptographically secure. + -+ - Also, want more common sizes earlier than uncommon sizes. -} hashes :: [Hash] hashes = concat  	[ map (SHA2Hash . HashSize) [256, 512, 224, 384]@@ -81,6 +84,8 @@ 	, fastMigrate = Just trivialMigrate 	, isStableKey = const True 	, isCryptographicallySecure = cryptographicallySecure hash+	, isCryptographicallySecureKey = const $ pure $+		cryptographicallySecure hash 	}  genBackendE :: Hash -> Backend@@ -164,12 +169,15 @@ 	, not (hasExt (fromKey keyVariety key)) && keyHash key /= S.fromShort (fromKey keyName key) 	] -trivialMigrate :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)-trivialMigrate oldkey newbackend afile = trivialMigrate' oldkey newbackend afile-	<$> (annexMaxExtensionLength <$> Annex.getGitConfig)+trivialMigrate :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)+trivialMigrate oldkey newbackend afile _inannex = do+	c <- Annex.getGitConfig+	return $ trivialMigrate' oldkey newbackend afile+		(annexMaxExtensionLength c)+		(annexMaxExtensions c) -trivialMigrate' :: Key -> Backend -> AssociatedFile -> Maybe Int -> Maybe Key-trivialMigrate' oldkey newbackend afile maxextlen+trivialMigrate' :: Key -> Backend -> AssociatedFile -> Maybe Int -> Maybe Int -> Maybe Key+trivialMigrate' oldkey newbackend afile maxextlen maxexts 	{- Fast migration from hashE to hash backend. -} 	| migratable && hasExt oldvariety = Just $ alterKey oldkey $ \d -> d 		{ keyName = S.toShort (keyHash oldkey)@@ -180,7 +188,7 @@ 		AssociatedFile Nothing -> Nothing 		AssociatedFile (Just file) -> Just $ alterKey oldkey $ \d -> d 			{ keyName = S.toShort $ keyHash oldkey -				<> selectExtension maxextlen file+				<> selectExtension maxextlen maxexts file 			, keyVariety = newvariety 			} 	{- Upgrade to fix bad previous migration that created a

@@ -1,6 +1,6 @@-{- git-annex "URL" backend -- keys whose content is available from urls.+{- git-annex URL backend -- keys whose content is available from urls.  -- - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -14,28 +14,30 @@ import Types.Key import Types.Backend import Backend.Utilities+import Backend.VURL.Utilities (migrateFromURLToVURL)  backends :: [Backend]-backends = [backend]+backends = [backendURL] -backend :: Backend-backend = Backend+backendURL :: Backend+backendURL = Backend 	{ backendVariety = URLKey 	, genKey = Nothing 	, verifyKeyContent = Nothing 	, verifyKeyContentIncrementally = Nothing 	, canUpgradeKey = Nothing-	, fastMigrate = Nothing+	, fastMigrate = Just migrateFromURLToVURL 	-- The content of an url can change at any time, so URL keys are 	-- not stable. 	, isStableKey = const False 	, isCryptographicallySecure = False+	, isCryptographicallySecureKey = const (pure False) 	}  {- Every unique url has a corresponding key. -}-fromUrl :: String -> Maybe Integer -> Key-fromUrl url size = mkKey $ \k -> k+fromUrl :: String -> Maybe Integer -> Bool -> Key+fromUrl url size verifiable = mkKey $ \k -> k 	{ keyName = genKeyName url-	, keyVariety = URLKey+	, keyVariety = if verifiable then VURLKey else URLKey 	, keySize = size 	}

@@ -1,6 +1,6 @@ {- git-annex backend utilities  -- - Copyright 2012-2020 Joey Hess <id@joeyh.name>+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -45,20 +45,24 @@  - file that the key was generated from.  -} addE :: KeySource -> (KeyVariety -> KeyVariety) -> Key -> Annex Key addE source sethasext k = do-	maxlen <- annexMaxExtensionLength <$> Annex.getGitConfig-	let ext = selectExtension maxlen (keyFilename source)+	c <- Annex.getGitConfig+	let ext = selectExtension+		(annexMaxExtensionLength c)+		(annexMaxExtensions c)+		(keyFilename source) 	return $ alterKey k $ \d -> d 		{ keyName = keyName d <> S.toShort ext 		, keyVariety = sethasext (keyVariety d) 		} -selectExtension :: Maybe Int -> RawFilePath -> S.ByteString-selectExtension maxlen f+selectExtension :: Maybe Int -> Maybe Int -> RawFilePath -> S.ByteString+selectExtension maxlen maxextensions f 	| null es = "" 	| otherwise = S.intercalate "." ("":es)   where 	es = filter (not . S.null) $ reverse $-		take 2 $ filter (S.all validInExtension) $+		take (fromMaybe maxExtensions maxextensions) $+		filter (S.all validInExtension) $ 		takeWhile shortenough $ 		reverse $ S.split (fromIntegral (ord '.')) (P.takeExtensions f') 	shortenough e = S.length e <= fromMaybe maxExtensionLen maxlen@@ -75,3 +79,6 @@  maxExtensionLen :: Int maxExtensionLen = 4 -- long enough for "jpeg"++maxExtensions :: Int+maxExtensions = 2 -- include both extensions of "tar.gz"

@@ -0,0 +1,102 @@+{- git-annex VURL backend -- like URL, but with hash-based verification+ - of transfers between git-annex repositories.+ -+ - Copyright 2024 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Backend.VURL (+	backends,+) where++import Annex.Common+import Types.Key+import Types.Backend+import Logs.EquivilantKeys+import Backend.Variety+import Backend.Hash (descChecksum)+import Utility.Hash+import Backend.VURL.Utilities++backends :: [Backend]+backends = [backendVURL]++backendVURL :: Backend+backendVURL = Backend+	{ backendVariety = VURLKey+	, genKey = Nothing+	, verifyKeyContent = Just $ \k f -> do+		equivkeys k >>= \case+			-- Normally there will always be an key+			-- recorded when a VURL's content is available,+			-- because downloading the content from the web in+			-- the first place records one.+			[] -> return False+			eks -> do+				let check ek = getbackend ek >>= \case+					Nothing -> pure False+					Just b -> case verifyKeyContent b of+						Just verify -> verify ek f+						Nothing -> pure False+				anyM check eks+	, verifyKeyContentIncrementally = Just $ \k -> do+		-- Run incremental verifiers for each equivilant key together,+		-- and see if any of them succeed.+		eks <- equivkeys k+		let get = \ek -> getbackend ek >>= \case+			Nothing -> pure Nothing+			Just b -> case verifyKeyContentIncrementally b of+				Nothing -> pure Nothing+				Just va -> Just <$> va ek+		l <- catMaybes <$> forM eks get+		return $ IncrementalVerifier+			{ updateIncrementalVerifier = \s ->+				forM_ l $ flip updateIncrementalVerifier s+			-- If there are no equivilant keys recorded somehow,+			-- or if none of them support incremental verification,+			-- this will return Nothing, which indicates that+			-- incremental verification was not able to be+			-- performed.+			, finalizeIncrementalVerifier = do+				r <- forM l finalizeIncrementalVerifier+				return $ case catMaybes r of+					[] -> Nothing+					r' -> Just (or r')+			, unableIncrementalVerifier = +				forM_ l unableIncrementalVerifier+			, positionIncrementalVerifier =+				getM positionIncrementalVerifier l+			, descIncrementalVerifier = descChecksum+			} +	, canUpgradeKey = Nothing+	, fastMigrate = Just migrateFromVURLToURL+	-- Even if a hash is recorded on initial download from the web and+	-- is used to verify every subsequent transfer including other+	-- downloads from the web, in a split-brain situation there+	-- can be more than one hash and different versions of the content.+	-- So the content is not stable.+	, isStableKey = const False+	-- Not all keys using this backend are necessarily +	-- cryptographically secure.+	, isCryptographicallySecure = False+	-- A key is secure when all recorded equivilant keys are.+	-- If there are none recorded yet, it's secure because when+	-- downloaded, an equivilant key that is cryptographically secure+	-- will be constructed then.+	, isCryptographicallySecureKey = \k ->+		equivkeys k >>= \case+			[] -> return True+			l -> do+				let check ek = getbackend ek >>= \case+					Nothing -> pure False+					Just b -> isCryptographicallySecureKey b ek+				allM check l+	}+  where+	equivkeys k = filter allowedequiv <$> getEquivilantKeys k+	-- Don't allow using VURL keys as equivilant keys, because that+	-- could let a crafted git-annex branch cause an infinite loop.+	allowedequiv ek = fromKey keyVariety ek /= VURLKey+	varietymap = makeVarietyMap regularBackendList+	getbackend ek = maybeLookupBackendVarietyMap (fromKey keyVariety ek) varietymap

@@ -0,0 +1,57 @@+{- git-annex VURL backend utilities+ -+ - Copyright 2024 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Backend.VURL.Utilities where++import Annex.Common+import Types.Key+import Types.Backend+import Types.KeySource+import Logs.EquivilantKeys+import qualified Backend.Hash+import Utility.Metered++migrateFromURLToVURL :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)+migrateFromURLToVURL oldkey newbackend _af inannex+	| inannex && fromKey keyVariety oldkey == URLKey && backendVariety newbackend == VURLKey = do+		let newkey = mkKey $ const $+			(keyData oldkey)+				{ keyVariety = VURLKey }+		contentfile <- calcRepo (gitAnnexLocation oldkey)+		generateEquivilantKey hashbackend contentfile >>= \case+			Nothing -> return Nothing+			Just ek -> do+				setEquivilantKey newkey ek+				return (Just newkey)+	| otherwise = return Nothing+  where+	-- Relies on the first hash being cryptographically secure, and the+	-- default hash used by git-annex.+	hashbackend = Prelude.head Backend.Hash.backends++migrateFromVURLToURL :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)+migrateFromVURLToURL oldkey newbackend _af _+	| fromKey keyVariety oldkey == VURLKey && backendVariety newbackend == URLKey =+		return $ Just $ mkKey $ const $+			(keyData oldkey)+				{ keyVariety = URLKey }+	| otherwise = return Nothing++-- The Backend must use a cryptographically secure hash.+generateEquivilantKey :: Backend -> RawFilePath -> Annex (Maybe Key)+generateEquivilantKey b f =+	case genKey b of+		Just genkey -> do+			showSideAction (UnquotedString Backend.Hash.descChecksum)+			Just <$> genkey source nullMeterUpdate+		Nothing -> return Nothing+  where+	source = KeySource+		{ keyFilename = mempty -- avoid adding any extension+		, contentLocation = f+		, inodeCache = Nothing+		}

@@ -0,0 +1,39 @@+{- git-annex backend varieties+ -+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Backend.Variety where++import qualified Data.Map as M++import Annex.Common+import Types.Key+import Types.Backend+import qualified Backend.External++-- When adding a new backend, import it here and add it to the builtinList.+import qualified Backend.Hash+import qualified Backend.WORM+import qualified Backend.URL++{- Regular backends. Does not include externals or VURL. -}+regularBackendList :: [Backend]+regularBackendList = Backend.Hash.backends +	++ Backend.WORM.backends +	++ Backend.URL.backends++{- The default hashing backend. -}+defaultHashBackend :: Backend+defaultHashBackend = Prelude.head regularBackendList++makeVarietyMap :: [Backend] -> M.Map KeyVariety Backend+makeVarietyMap l = M.fromList $ zip (map backendVariety l) l++maybeLookupBackendVarietyMap :: KeyVariety -> M.Map KeyVariety Backend -> Annex (Maybe Backend)+maybeLookupBackendVarietyMap (ExternalKey s hasext) _varitymap =+	Just <$> Backend.External.makeBackend s hasext+maybeLookupBackendVarietyMap v varietymap = +	pure $ M.lookup v varietymap

@@ -33,6 +33,7 @@ 	, fastMigrate = Just removeProblemChars 	, isStableKey = const True 	, isCryptographicallySecure = False+	, isCryptographicallySecureKey = const (pure False) 	}  {- The key includes the file size, modification time, and the@@ -58,8 +59,8 @@ needsUpgrade key = 	any (`S8.elem` S.fromShort (fromKey keyName key)) [' ', '\r'] -removeProblemChars :: Key -> Backend -> AssociatedFile -> Annex (Maybe Key)-removeProblemChars oldkey newbackend _+removeProblemChars :: Key -> Backend -> AssociatedFile -> Bool -> Annex (Maybe Key)+removeProblemChars oldkey newbackend _ _ 	| migratable = return $ Just $ alterKey oldkey $ \d -> d 		{ keyName = S.toShort $ encodeBS $ reSanitizeKeyName $ decodeBS $ S.fromShort $ keyName d } 	| otherwise = return Nothing

@@ -1,3 +1,31 @@+git-annex (10.20240430) upstream; urgency=medium++  * Bug fix: While redundant concurrent transfers were already+    prevented in most cases, it failed to prevent the case where+    two different repositories were sending the same content to+    the same repository.+  * addurl, importfeed: Added --verifiable option, which improves+    the safety of --fast or --relaxed by letting the content of+    annexed files be verified with a checksum that is calculated+    on a later download from the web. This will become the default later.+  * Added rclone special remote, which can be used without needing+    to install the git-annex-remote-rclone program. This needs+    a forthcoming version of rclone (1.67.0), which supports +    "rclone gitannex".+  * sync, assist, import: Allow -m option to be specified multiple+    times, to provide additional paragraphs for the commit message.+  * reregisterurl: New command that can change an url from being+    used by a special remote to being used by the web remote.+  * annex.maxextensions configuration controls how many filename+    extensions to preserve.+  * find: Fix --help for --copies.+    Thanks, Gergely Risko+  * Windows: Fix escaping output to terminal when using old+    versions of MinTTY.+  * Added dependency on unbounded-delays.++ -- Joey Hess <id@joeyh.name>  Tue, 30 Apr 2024 15:26:32 -0400+ git-annex (10.20240227) upstream; urgency=medium    * importfeed: Added --scrape option, which uses yt-dlp to screen scrape@@ -326,7 +354,7 @@     that use exporttree=yes. In some cases this could result in the wrong     content being exported to, or retrieved from the remote.   * Support VERSION 2 in the external special remote protocol, which is-    identical to VERSION 1, but avoids external remote programs neededing+    identical to VERSION 1, but avoids external remote programs needing     to work around the above bug. External remote program that support     exporttree=yes are recommended to be updated to send VERSION 2. @@ -526,7 +554,7 @@   * Fix updating git index file after getting an unlocked file      when annex.stalldetection is set.   * restage: New git-annex command, handles restaging unlocked files.-  * test: Added --test-with-git-config option.+  * test: Added --test-git-config option.   * Run annex.freezecontent-command and annex.thawcontent-command     when on a crippled filesystem.     Thanks, Reiko Asakura

@@ -33,11 +33,6 @@            © 2014 Robie Basak <robie@justgohome.co.uk> License: GPL-3+ -Files: Utility/ThreadScheduler.hs-Copyright: 2011 Bas van Dijk & Roel van Dijk-           2012, 2013 Joey Hess <id@joeyh.name>-License: BSD-2-clause- Files: Utility/Attoparsec.hs Copyright: 2019 Joey Hess <id@joeyh.name>            2007-2015 Bryan O'Sullivan

@@ -34,6 +34,7 @@ import qualified Command.FromKey import qualified Command.RegisterUrl import qualified Command.UnregisterUrl+import qualified Command.ReregisterUrl import qualified Command.SetKey import qualified Command.DropKey import qualified Command.Transferrer@@ -196,6 +197,7 @@ 	, Command.FromKey.cmd 	, Command.RegisterUrl.cmd 	, Command.UnregisterUrl.cmd+	, Command.ReregisterUrl.cmd 	, Command.SetKey.cmd 	, Command.DropKey.cmd 	, Command.Transferrer.cmd

@@ -298,7 +298,7 @@ 		<> completeRemotes 		) 	, annexOption (setAnnexState . Limit.addCopies) $ strOption-		( long "copies" <> short 'C' <> metavar paramRemote+		( long "copies" <> short 'C' <> metavar paramNumber 		<> help "skip files with fewer copies" 		<> hidden 		)

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2011-2021 Joey Hess <id@joeyh.name>+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -62,6 +62,7 @@  data DownloadOptions = DownloadOptions 	{ relaxedOption :: Bool+	, verifiableOption :: Bool 	, rawOption :: Bool 	, noRawOption :: Bool 	, rawExceptOption :: Maybe (DeferredParse Remote)@@ -96,9 +97,14 @@ parseDownloadOptions withfileoptions = DownloadOptions 	<$> switch 		( long "relaxed"-		<> help "skip size check"+		<> help "accept whatever content is downloaded from web even if it changes" 		) 	<*> switch+		( long "verifiable"+		<> short 'V'+		<> help "improve later verification of --fast or --relaxed content"+		)+	<*> switch 		( long "raw" 		<> help "disable special handling for torrents, youtube-dl, etc" 		)@@ -215,7 +221,7 @@  downloadRemoteFile :: AddUnlockedMatcher -> Remote -> DownloadOptions -> URLString -> RawFilePath -> Maybe Integer -> Annex (Maybe Key) downloadRemoteFile addunlockedmatcher r o uri file sz = checkCanAdd o file $ \canadd -> do-	let urlkey = Backend.URL.fromUrl uri sz+	let urlkey = Backend.URL.fromUrl uri sz (verifiableOption o) 	createWorkTreeDirectory (parentDir file) 	ifM (Annex.getRead Annex.fast <||> pure (relaxedOption o)) 		( do@@ -344,7 +350,7 @@ downloadWeb addunlockedmatcher o url urlinfo file = 	go =<< downloadWith' downloader urlkey webUUID url file   where-	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing+	urlkey = addSizeUrlKey urlinfo $ Backend.URL.fromUrl url Nothing (verifiableOption o) 	downloader f p = Url.withUrlOptions $ downloadUrl False urlkey p Nothing [url] f 	go Nothing = return Nothing 	go (Just (tmp, backend)) = ifM (useYoutubeDl o <&&> liftIO (isHtmlFile (fromRawFilePath tmp)))@@ -388,7 +394,7 @@ 							warning (UnquotedString dlcmd <> " did not download anything") 							return Nothing 		mediaurl = setDownloader url YoutubeDownloader-		mediakey = Backend.URL.fromUrl mediaurl Nothing+		mediakey = Backend.URL.fromUrl mediaurl Nothing (verifiableOption o) 		-- Does the already annexed file have the mediaurl 		-- as an url? If so nothing to do. 		alreadyannexed dest k = do@@ -436,7 +442,7 @@ 	-- used to prevent two threads running concurrently when that would 	-- likely fail. 	ai = OnlyActionOn urlkey (ActionItemOther (Just (UnquotedString url)))-	urlkey = Backend.URL.fromUrl url Nothing+	urlkey = Backend.URL.fromUrl url Nothing (verifiableOption (downloadOptions o))  showDestinationFile :: RawFilePath -> Annex () showDestinationFile file = do@@ -539,12 +545,12 @@ 		return Nothing   where 	nomedia = do-		let key = Backend.URL.fromUrl url (Url.urlSize urlinfo)+		let key = Backend.URL.fromUrl url (Url.urlSize urlinfo) (verifiableOption o) 		nodownloadWeb' o addunlockedmatcher url key file 	usemedia mediafile = do 		let dest = youtubeDlDestFile o file mediafile 		let mediaurl = setDownloader url YoutubeDownloader-		let mediakey = Backend.URL.fromUrl mediaurl Nothing+		let mediakey = Backend.URL.fromUrl mediaurl Nothing (verifiableOption o) 		nodownloadWeb' o addunlockedmatcher mediaurl mediakey dest  youtubeDlDestFile :: DownloadOptions -> RawFilePath -> RawFilePath -> RawFilePath

@@ -78,6 +78,6 @@ 		Just v -> getParsed v >>= \b -> 			maybeLookupBackendVariety (fromKey keyVariety ik) >>= \case 				Just ib -> case fastMigrate ib of-					Just fm -> fromMaybe ik <$> fm ik b af+					Just fm -> fromMaybe ik <$> fm ik b af False 					Nothing -> pure ik 				Nothing -> pure ik

@@ -406,39 +406,46 @@ 	oldloc = mkExportLocation $ getTopFilePath oldf  startMoveToTempName :: Remote -> ExportHandle -> TopFilePath -> Key -> CommandStart-startMoveToTempName r db f ek = -	starting ("rename " ++ name r) ai si $+startMoveToTempName r db f ek = case renameExport (exportActions r) of+	Just _ -> starting ("rename " ++ name r) ai si $ 		performRename r db ek loc tmploc+	Nothing -> starting ("unexport " ++ name r) ai' si $+		performUnexport r db [ek] loc   where 	loc = mkExportLocation f' 	f' = getTopFilePath f 	tmploc = exportTempName ek 	ai = ActionItemOther $ Just $  		QuotedPath f' <> " -> " <> QuotedPath (fromExportLocation tmploc)+	ai' = ActionItemTreeFile (fromExportLocation loc) 	si = SeekInput []  startMoveFromTempName :: Remote -> ExportHandle -> Key -> TopFilePath -> CommandStart-startMoveFromTempName r db ek f = do-	let tmploc = exportTempName ek-	let ai = ActionItemOther $ Just $-		QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f'-	stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $+startMoveFromTempName r db ek f = case renameExport (exportActions r) of+	Just _ -> stopUnless (liftIO $ elem tmploc <$> getExportedLocation db ek) $ 		starting ("rename " ++ name r) ai si $ 			performRename r db ek tmploc loc+	Nothing -> starting ("unexport " ++ name r) ai' si $+		performUnexport r db [ek] tmploc   where 	loc = mkExportLocation f' 	f' = getTopFilePath f+	tmploc = exportTempName ek+	ai = ActionItemOther $ Just $+		QuotedPath (fromExportLocation tmploc) <> " -> " <> QuotedPath f'+	ai' = ActionItemTreeFile (fromExportLocation tmploc) 	si = SeekInput []  performRename :: Remote -> ExportHandle -> Key -> ExportLocation -> ExportLocation -> CommandPerform-performRename r db ek src dest =-	tryNonAsync (renameExport (exportActions r) ek src dest) >>= \case+performRename r db ek src dest = case renameExport (exportActions r) of+	Just renameaction -> tryNonAsync (renameaction ek src dest) >>= \case 		Right (Just ()) -> next $ cleanupRename r db ek src dest 		Left err -> do 			warning $ UnquotedString $ "rename failed (" ++ show err ++ "); deleting instead" 			fallbackdelete-		-- remote does not support renaming 		Right Nothing -> fallbackdelete+	-- remote does not support renaming+	Nothing -> fallbackdelete   where 	fallbackdelete = performUnexport r db [ek] src 

@@ -189,7 +189,7 @@ 	liftIO $ removeWhenExistsWith removeLink tmpindex 	cmode <- annexCommitMode <$> Annex.getGitConfig 	cmessage <- Annex.Branch.commitMessage-	c <- inRepo $ Git.commitTree cmode cmessage [] t+	c <- inRepo $ Git.commitTree cmode [cmessage] [] t 	liftIO $ putStrLn (fromRef c)   where 	ww = WarnUnmatchLsFiles "filter-branch"

@@ -94,7 +94,7 @@ keyOpt' :: String -> Either String Key keyOpt' s = case parseURIPortable s of 	Just u | not (isKeyPrefix (uriScheme u)) ->-		Right $ Backend.URL.fromUrl s Nothing+		Right $ Backend.URL.fromUrl s Nothing False 	_ -> case deserializeKey s of 		Just k -> Right k 		Nothing -> Left $ "bad key/url " ++ s

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010-2022 Joey Hess <id@joeyh.name>+ - Copyright 2010-2023 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -16,6 +16,7 @@ import qualified Types.Backend import qualified Backend import Annex.Content+import Annex.Verify #ifndef mingw32_HOST_OS import Annex.Version import Annex.Content.Presence@@ -127,7 +128,7 @@ 		(numcopies, _mincopies) <- getFileNumMinCopies file 		case from of 			Nothing -> go $ perform key file backend numcopies-			Just r -> go $ performRemote key afile backend numcopies r+			Just r -> go $ performRemote key afile numcopies r   where 	go = runFsck inc si (mkActionItem (key, afile)) key 	afile = AssociatedFile (Just file)@@ -144,7 +145,7 @@ 		, verifyAssociatedFiles key keystatus file 		, verifyWorkTree key file 		, checkKeySize key keystatus ai-		, checkBackend backend key keystatus afile+		, checkBackend key keystatus afile 		, checkKeyUpgrade backend key ai afile 		, checkKeyNumCopies key afile numcopies 		]@@ -154,8 +155,8 @@  {- To fsck a remote, the content is retrieved to a tmp file,  - and checked locally. -}-performRemote :: Key -> AssociatedFile -> Backend -> NumCopies -> Remote -> Annex Bool-performRemote key afile backend numcopies remote =+performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> Annex Bool+performRemote key afile numcopies remote = 	dispatch =<< Remote.hasKey remote key   where 	dispatch (Left err) = do@@ -178,7 +179,7 @@ 		, case fmap snd lv of 			Just Verified -> return True 			_ -> withLocalCopy (fmap fst lv) $-				checkBackendRemote backend key remote ai+				checkBackendRemote key remote ai 		, checkKeyNumCopies key afile numcopies 		] 	ai = mkActionItem (key, afile)@@ -215,18 +216,18 @@ startKey from inc (si, key, ai) numcopies = 	Backend.maybeLookupBackendVariety (fromKey keyVariety key) >>= \case 		Nothing -> stop-		Just backend -> runFsck inc si ai key $+		Just _ -> runFsck inc si ai key $ 			case from of-				Nothing -> performKey key backend numcopies-				Just r -> performRemote key (AssociatedFile Nothing) backend numcopies r+				Nothing -> performKey key numcopies+				Just r -> performRemote key (AssociatedFile Nothing) numcopies r -performKey :: Key -> Backend -> NumCopies -> Annex Bool-performKey key backend numcopies = do+performKey :: Key -> NumCopies -> Annex Bool+performKey key numcopies = do 	keystatus <- getKeyStatus key 	check 		[ verifyLocationLog key keystatus (mkActionItem key) 		, checkKeySize key keystatus (mkActionItem key)-		, checkBackend backend key keystatus (AssociatedFile Nothing)+		, checkBackend key keystatus (AssociatedFile Nothing) 		, checkKeyNumCopies key (AssociatedFile Nothing) numcopies 		] @@ -328,8 +329,8 @@ 	{- Warn when annex.securehashesonly is set and content using an  	 - insecure hash is present. This should only be able to happen 	 - if the repository already contained the content before the-	 - config was set. -}-	whenM (pure present <&&> (not <$> Backend.isCryptographicallySecure key)) $+	 - config was set, or of course if a hash was broken. -}+	whenM (pure present <&&> (not <$> Backend.isCryptographicallySecureKey key)) $ 		whenM (annexSecureHashesOnly <$> Annex.getGitConfig) $ 			warning $ "** Despite annex.securehashesonly being set, " <> QuotedPath obj <> " has content present in the annex using an insecure " <> UnquotedString (decodeBS (formatKeyVariety (fromKey keyVariety key))) <> " key" @@ -496,18 +497,18 @@  {- Runs the backend specific check on a key's content object.  -- - When a annex.this is set, an unlocked file may be a hard link to the object.+ - When a annex.thin is set, an unlocked file may be a hard link to the object.  - Thus when the user modifies the file, the object will be modified and  - not pass the check, and we don't want to find an error in this case.  -}-checkBackend :: Backend -> Key -> KeyStatus -> AssociatedFile -> Annex Bool-checkBackend backend key keystatus afile = do+checkBackend :: Key -> KeyStatus -> AssociatedFile -> Annex Bool+checkBackend key keystatus afile = do 	content <- calcRepo (gitAnnexLocation key) 	ifM (pure (isKeyUnlockedThin keystatus) <&&> (not <$> isUnmodified key content)) 		( nocheck 		, do 			mic <- withTSDelta (liftIO . genInodeCache content)-			ifM (checkBackendOr badContent backend key content ai)+			ifM (checkBackendOr badContent key content ai) 				( do 					checkInodeCache key content mic ai 					return True@@ -519,22 +520,19 @@  	ai = mkActionItem (key, afile) -checkBackendRemote :: Backend -> Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool-checkBackendRemote backend key remote ai localcopy =-	checkBackendOr (badContentRemote remote localcopy) backend key localcopy ai+checkBackendRemote :: Key -> Remote -> ActionItem -> RawFilePath -> Annex Bool+checkBackendRemote key remote ai localcopy =+	checkBackendOr (badContentRemote remote localcopy) key localcopy ai -checkBackendOr :: (Key -> Annex String) -> Backend -> Key -> RawFilePath -> ActionItem -> Annex Bool-checkBackendOr bad backend key file ai =-	case Types.Backend.verifyKeyContent backend of-		Just verifier -> do-			ok <- verifier key file-			unless ok $ do-				msg <- bad key-				warning $ actionItemDesc ai-					<> ": Bad file content; "-					<> UnquotedString msg-			return ok-		Nothing -> return True+checkBackendOr :: (Key -> Annex String) -> Key -> RawFilePath -> ActionItem -> Annex Bool+checkBackendOr bad key file ai = do+	ok <- verifyKeyContent' key file+	unless ok $ do+		msg <- bad key+		warning $ actionItemDesc ai+			<> ": Bad file content; "+			<> UnquotedString msg+	return ok  {- Check, if there are InodeCaches recorded for a key, that one of them  - matches the object file. There are situations where the InodeCache

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2012-2021 Joey Hess <id@joeyh.name>+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -70,7 +70,7 @@ 		, importToSubDir :: Maybe FilePath 		, importContent :: Bool 		, checkGitIgnoreOption :: CheckGitIgnore-		, messageOption :: Maybe String+		, messageOption :: [String] 		}  optParser :: CmdParamsDesc -> Parser ImportOptions@@ -82,7 +82,7 @@ 		) 	dupmode <- fromMaybe Default <$> optional duplicateModeParser 	ic <- Command.Add.checkGitIgnoreSwitch-	message <- optional (strOption+	message <- many (strOption 		( long "message" <> short 'm' <> metavar "MSG" 		<> help "commit message" 		))@@ -322,8 +322,8 @@ 	verifyEnoughCopiesToDrop [] key Nothing needcopies mincopies [] preverified tocheck 		(const yes) no -seekRemote :: Remote -> Branch -> Maybe TopFilePath -> Bool -> CheckGitIgnore -> Maybe String -> CommandSeek-seekRemote remote branch msubdir importcontent ci mimportmessage = do+seekRemote :: Remote -> Branch -> Maybe TopFilePath -> Bool -> CheckGitIgnore -> [String] -> CommandSeek+seekRemote remote branch msubdir importcontent ci importmessages = do 	importtreeconfig <- case msubdir of 		Nothing -> return ImportTree 		Just subdir ->@@ -336,7 +336,7 @@ 	 	trackingcommit <- fromtrackingbranch Git.Ref.sha 	cmode <- annexCommitMode <$> Annex.getGitConfig-	let importcommitconfig = ImportCommitConfig trackingcommit cmode importmessage+	let importcommitconfig = ImportCommitConfig trackingcommit cmode importmessages' 	let commitimport = commitRemote remote branch tb trackingcommit importtreeconfig importcommitconfig  	importabletvar <- liftIO $ newTVarIO Nothing@@ -353,9 +353,9 @@ 				includeCommandAction $  					commitimport imported   where-	importmessage = fromMaybe -		("import from " ++ Remote.name remote)-		mimportmessage+	importmessages'+		| null importmessages = ["import from " ++ Remote.name remote]+		| otherwise = importmessages  	tb = mkRemoteTrackingBranch remote branch 

@@ -283,7 +283,7 @@ 	Enclosure url -> startdownloadenclosure url 	MediaLink linkurl -> do 		let mediaurl = setDownloader linkurl YoutubeDownloader-		let mediakey = Backend.URL.fromUrl mediaurl Nothing+		let mediakey = Backend.URL.fromUrl mediaurl Nothing (verifiableOption (downloadOptions opts)) 		-- Old versions of git-annex that used quvi might have 		-- used the quviurl for this, so check if it's known 		-- to avoid adding it a second time.@@ -638,7 +638,7 @@ 		=<< feedState url  feedState :: URLString -> Annex RawFilePath-feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing+feedState url = fromRepo $ gitAnnexFeedState $ fromUrl url Nothing False  {- The feed library parses the feed to Text, and does not use the  - filesystem encoding to do it, so when the locale is not unicode

@@ -126,7 +126,7 @@ 		| knowngoodcontent = finish =<< tweaksize newkey 		| otherwise = stopUnless checkcontent $ 			finish =<< tweaksize newkey-	checkcontent = Command.Fsck.checkBackend oldbackend oldkey KeyPresent afile+	checkcontent = Command.Fsck.checkBackend oldkey KeyPresent afile 	finish newkey = ifM (Command.ReKey.linkKey file oldkey newkey) 		( do 			_ <- copyMetaData oldkey newkey@@ -149,7 +149,7 @@ 			} 		newkey <- fst <$> genKey source nullMeterUpdate newbackend 		return $ Just (newkey, False)-	genkey (Just fm) = fm oldkey newbackend afile >>= \case+	genkey (Just fm) = fm oldkey newbackend afile True >>= \case 		Just newkey -> return (Just (newkey, True)) 		Nothing -> genkey Nothing 	tweaksize k

@@ -0,0 +1,79 @@+{- git-annex command+ -+ - Copyright 2015-2024 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Command.ReregisterUrl where++import Command+import Logs.Web+import Command.FromKey (keyOpt, keyOpt')+import qualified Remote+import Git.Types++cmd :: Command+cmd = withAnnexOptions [jsonOptions] $ command "reregisterurl"+	SectionPlumbing "updates url registration information"+	(paramKey)+	(seek <$$> optParser)++data ReregisterUrlOptions = ReregisterUrlOptions+	{ keyOpts :: CmdParams+	, batchOption :: BatchMode+	, moveFromOption :: Maybe (DeferredParse Remote)+	}++optParser :: CmdParamsDesc -> Parser ReregisterUrlOptions+optParser desc = ReregisterUrlOptions+	<$> cmdParams desc+	<*> parseBatchOption False+	<*> optional (mkParseRemoteOption <$> parseMoveFromOption)++parseMoveFromOption :: Parser RemoteName+parseMoveFromOption = strOption+	( long "move-from" <> metavar paramRemote+	<> completeRemotes+	)++seek :: ReregisterUrlOptions -> CommandSeek+seek o = case (batchOption o, keyOpts o) of+	(Batch fmt, _) -> seekBatch o fmt+	(NoBatch, ps) -> commandAction (start o ps)++seekBatch :: ReregisterUrlOptions -> BatchFormat -> CommandSeek+seekBatch o fmt = batchOnly Nothing (keyOpts o) $+	batchInput fmt (pure . parsebatch) $+		batchCommandAction . start' o+  where+	parsebatch l = case keyOpt' l of+		Left e -> Left e+		Right k -> Right k++start :: ReregisterUrlOptions -> [String] -> CommandStart+start o (keyname:[]) = start' o (si, keyOpt keyname)+  where+	si = SeekInput [keyname]+start _ _ = giveup "specify a key"++start' :: ReregisterUrlOptions -> (SeekInput, Key) -> CommandStart+start' o (si, key) =+	starting "reregisterurl" ai si $+		perform o key+  where+	ai = ActionItemKey key++perform :: ReregisterUrlOptions -> Key -> CommandPerform+perform o key = maybe (pure Nothing) (Just <$$> getParsed) (moveFromOption o) >>= \case+	Nothing -> next $ return True+	Just r -> do+		us <- map fst+			. filter (\(_, d) -> d == OtherDownloader)+			. map getDownloader+			<$> getUrls key+		us' <- filterM (\u -> (== r) <$> Remote.claimingUrl u) us+		forM_ us' $ \u -> do+			setUrlMissing key (setDownloader u OtherDownloader)+			setUrlPresent key u+		next $ return True

@@ -1,7 +1,7 @@ {- git-annex command  -  - Copyright 2011 Joachim Breitner <mail@joachim-breitner.de>- - Copyright 2011-2023 Joey Hess <id@joeyh.name>+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -105,7 +105,7 @@ 	, notOnlyAnnexOption :: Bool 	, commitOption :: Bool 	, noCommitOption :: Bool-	, messageOption :: Maybe String+	, messageOption :: [String] 	, pullOption :: Bool 	, pushOption :: Bool 	, contentOption :: Maybe Bool@@ -125,7 +125,7 @@ 		, notOnlyAnnexOption = False 		, commitOption = False 		, noCommitOption = False-		, messageOption = Nothing+		, messageOption = [] 		, pullOption = False 		, pushOption = False 		, contentOption = Just False@@ -169,8 +169,8 @@ 			( long "no-commit" 			<> help "avoid git commit"  			))-	<*> unlessmode [SyncMode, AssistMode] Nothing-		(optional (strOption+	<*> unlessmode [SyncMode, AssistMode] []+		(many (strOption 			( long "message" <> short 'm' <> metavar "MSG" 			<> help "commit message" 			)))@@ -402,17 +402,18 @@  commit :: SyncOptions -> CommandStart commit o = stopUnless shouldcommit $ starting "commit" ai si $ do-	commitmessage <- maybe commitMsg return (messageOption o) 	Annex.Branch.commit =<< Annex.Branch.commitMessage+	mopts <- concatMap (\msg -> [Param "-m", Param msg])+		<$> if null (messageOption o)+			then (:[]) <$> commitMsg+			else pure (messageOption o) 	next $ do 		showOutput 		let cmode = Git.Branch.ManualCommit 		cquiet <- Git.Branch.CommitQuiet <$> commandProgressDisabled-		void $ inRepo $ Git.Branch.commitCommand cmode cquiet-			[ Param "-a"-			, Param "-m"-			, Param commitmessage-			]+		void $ inRepo $ Git.Branch.commitCommand+			cmode cquiet+			([ Param "-a" ] ++ mopts) 		return True   where 	shouldcommit = notOnlyAnnex o <&&>@@ -426,7 +427,8 @@ commitMsg = do 	u <- getUUID 	m <- uuidDescMap-	return $ "git-annex in " ++ maybe "unknown" fromUUIDDesc (M.lookup u m)+	return $ "git-annex in "+		++ maybe "unknown" fromUUIDDesc (M.lookup u m)  mergeLocal :: [Git.Merge.MergeConfig] -> SyncOptions -> CurrBranch -> CommandStart mergeLocal mergeconfig o currbranch = stopUnless (notOnlyAnnex o) $@@ -578,7 +580,7 @@ 			let (branch, subdir) = splitRemoteAnnexTrackingBranchSubdir b 			if canImportKeys remote importcontent 				then do-					Command.Import.seekRemote remote branch subdir importcontent (CheckGitIgnore True) Nothing+					Command.Import.seekRemote remote branch subdir importcontent (CheckGitIgnore True) [] 					-- Importing generates a branch 					-- that is not initially connected 					-- to the current branch, so allow

@@ -352,7 +352,7 @@ 		, Param "-z" 		, Param "--no-abbrev" 		-- Optimization: Limit to pointer files and annex symlinks.-		-- This is not perfect. A file could contain with this and not+		-- This is not perfect. A file could contain this and not 		-- be a pointer file. And a pointer file that is replaced with 		-- a non-pointer file will match this. This is only a 		-- prefilter so that's ok.

@@ -1,6 +1,6 @@ {- git branch stuff  -- - Copyright 2011-2021 Joey Hess <id@joeyh.name>+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -178,7 +178,7 @@ 	tree <- writeTree repo 	ifM (cancommit tree) 		( do-			sha <- commitTree commitmode message parentrefs tree repo+			sha <- commitTree commitmode [message] parentrefs tree repo 			update' branch sha repo 			return $ Just sha 		, return Nothing@@ -207,8 +207,21 @@ 	go nullh = pipeReadStrict' (\p -> p { std_err = UseHandle nullh })  		[Param "write-tree"] repo -commitTree :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha-commitTree commitmode message parentrefs tree repo =+commitTree :: CommitMode -> [String] -> [Ref] -> Ref -> Repo -> IO Sha+commitTree commitmode messages parentrefs tree repo =+	getSha "commit-tree" $ pipeReadStrict ps repo+  where+	ps = [Param "commit-tree", Param (fromRef tree)]+		++ applyCommitModeForCommitTree commitmode baseparams repo+	baseparams = map Param $+		concatMap (\r -> ["-p", fromRef r]) parentrefs+			++ concatMap (\msg -> ["-m", msg]) messages++-- commitTree passes the commit message to git with -m, which can cause it+-- to get modified slightly (eg adding trailing newline). This variant uses+-- the exact commit message that is provided.+commitTreeExactMessage :: CommitMode -> String -> [Ref] -> Ref -> Repo -> IO Sha+commitTreeExactMessage commitmode message parentrefs tree repo = 	getSha "commit-tree" $ 		pipeWriteRead ([Param "commit-tree", Param (fromRef tree)] ++ ps) 			sendmsg repo

@@ -87,11 +87,11 @@ mergeFile info file hashhandle h = case S8.words info of 	[_colonmode, _bmode, asha, bsha, _status] ->  		case filter (`notElem` nullShas) [Ref asha, Ref bsha] of-		[] -> return Nothing-		(sha:[]) -> use sha-		shas -> use-			=<< either return (hashBlob hashhandle . L8.unlines)-			=<< calcMerge . zip shas <$> mapM getcontents shas+			[] -> return Nothing+			(sha:[]) -> use sha+			shas -> use+				=<< either return (hashBlob hashhandle . L8.unlines)+				=<< calcMerge . zip shas <$> mapM getcontents shas 	_ -> return Nothing   where 	use sha = return $ Just $

@@ -575,7 +575,7 @@  limitSecureHash :: MatchFiles Annex limitSecureHash = MatchFiles-	{ matchAction = const $ checkKey isCryptographicallySecure+	{ matchAction = const $ checkKey isCryptographicallySecureKey 	, matchNeedsFileName = False 	, matchNeedsFileContent = False 	, matchNeedsKey = True

@@ -1,6 +1,6 @@ {- git-annex log file names  -- - Copyright 2013-2023 Joey Hess <id@joeyh.name>+ - Copyright 2013-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -35,7 +35,9 @@ 	| isRemoteStateLog f = Just NewUUIDBasedLog 	| isRemoteContentIdentifierLog f = Just NewUUIDBasedLog 	| isRemoteMetaDataLog f = Just RemoteMetaDataLog-	| isMetaDataLog f || f `elem` otherTopLevelLogs = Just OtherLog+	| isMetaDataLog f+		|| f `elem` otherTopLevelLogs+		|| isEquivilantKeyLog f = Just OtherLog 	| otherwise = (LocationLog <$> locationLogFileKey config f) 		<|> (ChunkLog <$> extLogFileKey chunkLogExt f) 		<|> (UrlLog  <$> urlLogFileKey f)@@ -70,6 +72,7 @@ 	, remoteMetaDataLogFile config k 	, remoteContentIdentifierLogFile config k 	, chunkLogFile config k+	, equivilantKeysLogFile config k 	] ++ oldurlLogs config k  {- All uuid-based logs stored in the top of the git-annex branch. -}@@ -207,6 +210,18 @@  chunkLogExt :: S.ByteString chunkLogExt = ".log.cnk"++{- The filename of the equivilant keys log for a given key. -}+equivilantKeysLogFile :: GitConfig -> Key -> RawFilePath+equivilantKeysLogFile config key = +	(branchHashDir config key P.</> keyFile key)+		<> equivilantKeyLogExt++equivilantKeyLogExt :: S.ByteString+equivilantKeyLogExt = ".log.ek"++isEquivilantKeyLog :: RawFilePath -> Bool+isEquivilantKeyLog path = equivilantKeyLogExt `S.isSuffixOf` path  {- The filename of the metadata log for a given key. -} metaDataLogFile :: GitConfig -> Key -> RawFilePath

@@ -0,0 +1,31 @@+{- Logs listing keys that are equivilant to a key.+ -+ - Copyright 2024 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE BangPatterns #-}++module Logs.EquivilantKeys (+	getEquivilantKeys,+	setEquivilantKey,+) where++import Annex.Common+import qualified Annex+import Logs+import Logs.Presence+import qualified Annex.Branch++getEquivilantKeys :: Key -> Annex [Key]+getEquivilantKeys key = do+	config <- Annex.getGitConfig+	nub . mapMaybe (deserializeKey' . fromLogInfo)+		<$> presentLogInfo (equivilantKeysLogFile config key)++setEquivilantKey :: Key -> Key -> Annex ()+setEquivilantKey key equivkey = do+	config <- Annex.getGitConfig+	addLog (Annex.Branch.RegardingUUID []) (equivilantKeysLogFile config key)+		InfoPresent (LogInfo (serializeKey' equivkey))

@@ -1,6 +1,6 @@ {- git-annex transfer information files and lock files  -- - Copyright 2012-2021 Joey Hess <id@joeyh.name>+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -56,26 +56,24 @@ 		<*> Just (fromMaybe 0 $ bytesComplete info)  {- Generates a callback that can be called as transfer progresses to update- - the transfer info file. Also returns the file it'll be updating, - - an action that sets up the file with appropriate permissions,- - which should be run after locking the transfer lock file, but- - before using the callback, and a TVar that can be used to read- - the number of bytes processed so far. -}-mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, RawFilePath, Annex (), TVar (Maybe BytesProcessed))-mkProgressUpdater t info = do-	tfile <- fromRepo $ transferFile t+ - the transfer info file. Also returns an action that sets up the file with+ - appropriate permissions, which should be run after locking the transfer+ - lock file, but before using the callback, and a TVar that can be used to+ - read the number of bytes processed so far. -}+mkProgressUpdater :: Transfer -> TransferInfo -> RawFilePath -> Annex (MeterUpdate, Annex (), TVar (Maybe BytesProcessed))+mkProgressUpdater t info tfile = do 	let createtfile = void $ tryNonAsync $ writeTransferInfoFile info tfile 	tvar <- liftIO $ newTVarIO Nothing 	loggedtvar <- liftIO $ newTVarIO 0-	return (liftIO . updater (fromRawFilePath tfile) tvar loggedtvar, tfile, createtfile, tvar)+	return (liftIO . updater (fromRawFilePath tfile) tvar loggedtvar, createtfile, tvar)   where-	updater tfile tvar loggedtvar new = do+	updater tfile' tvar loggedtvar new = do 		old <- atomically $ swapTVar tvar (Just new) 		let oldbytes = maybe 0 fromBytesProcessed old 		let newbytes = fromBytesProcessed new 		when (newbytes - oldbytes >= mindelta) $ do 			let info' = info { bytesComplete = Just newbytes }-			_ <- tryIO $ updateTransferInfoFile info' tfile+			_ <- tryIO $ updateTransferInfoFile info' tfile' 			atomically $ writeTVar loggedtvar newbytes  	{- The minimum change in bytesComplete that is worth@@ -102,33 +100,40 @@ {- If a transfer is still running, returns its TransferInfo.  -   - If no transfer is running, attempts to clean up the stale- - lock and info files. This can happen if a transfer process was- - interrupted.+ - lock and info files, which can be left behind when a transfer+ - process was interrupted.  -} checkTransfer :: Transfer -> Annex (Maybe TransferInfo) checkTransfer t = debugLocks $ do-	tfile <- fromRepo $ transferFile t-	let lck = transferLockFile tfile-	let cleanstale = do+	(tfile, lck, moldlck) <- fromRepo $ transferFileAndLockFile t+	let deletestale = do 		void $ tryIO $ R.removeLink tfile 		void $ tryIO $ R.removeLink lck+		maybe noop (void . tryIO . R.removeLink) moldlck #ifndef mingw32_HOST_OS 	v <- getLockStatus lck-	case v of+	v' <- case (moldlck, v) of+		(Nothing, _) -> pure v+		(_, StatusLockedBy pid) -> pure (StatusLockedBy pid)+		(Just oldlck, _) -> getLockStatus oldlck+	case v' of 		StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $ 			readTransferInfoFile (Just pid) (fromRawFilePath tfile) 		_ -> do-			-- Take a non-blocking lock while deleting-			-- the stale lock file. Ignore failure-			-- due to permissions problems, races, etc.-			void $ tryIO $ do-				mode <- annexFileMode-				r <- tryLockExclusive (Just mode) lck-				case r of-					Just lockhandle -> liftIO $ do-						cleanstale+			mode <- annexFileMode+			-- Ignore failure due to permissions, races, etc.+			void $ tryIO $ tryLockExclusive (Just mode) lck >>= \case+				Just lockhandle -> case moldlck of+					Nothing -> liftIO $ do+						deletestale 						dropLock lockhandle-					_ -> noop+					Just oldlck -> tryLockExclusive (Just mode) oldlck >>= \case+						Just oldlockhandle -> liftIO $ do+							deletestale+							dropLock oldlockhandle+							dropLock lockhandle+						Nothing -> liftIO $ dropLock lockhandle+				Nothing -> noop 			return Nothing #else 	v <- liftIO $ lockShared lck@@ -137,7 +142,7 @@ 			readTransferInfoFile Nothing (fromRawFilePath tfile) 		Just lockhandle -> do 			dropLock lockhandle-			cleanstale+			deletestale 			return Nothing #endif @@ -198,24 +203,45 @@ 	failedtfile <- fromRepo $ failedTransferFile t 	writeTransferInfoFile info failedtfile -{- The transfer information file to use for a given Transfer. -}-transferFile :: Transfer -> Git.Repo -> RawFilePath-transferFile (Transfer direction u kd) r =-	transferDir direction r-		P.</> B8.filter (/= '/') (fromUUID u)-		P.</> keyFile (mkKey (const kd))+{- The transfer information file and transfer lock file + - to use for a given Transfer. + -+ - The transfer lock file used for an Upload includes the UUID.+ - This allows multiple transfers of the same key to different remote+ - repositories run at the same time, while preventing multiple+ - transfers of the same key to the same remote repository.+ -+ - The transfer lock file used for a Download does not include the UUID.+ - This prevents multiple transfers of the same key into the local+ - repository at the same time.+ -+ - Since old versions of git-annex (10.20240227 and older) used to + - include the UUID in the transfer lock file for a Download, this also+ - returns a second lock file for Downloads, which has to be locked+ - in order to interoperate with the old git-annex processes.+ - Lock order is the same as return value order. + - At some point in the future, when old git-annex processes are no longer+ - a concern, this complication can be removed.+ -}+transferFileAndLockFile :: Transfer -> Git.Repo -> (RawFilePath, RawFilePath, Maybe RawFilePath)+transferFileAndLockFile (Transfer direction u kd) r =+	case direction of+		Upload -> (transferfile, uuidlockfile, Nothing)+		Download -> (transferfile, nouuidlockfile, Just uuidlockfile)+  where+	td = transferDir direction r+	fu = B8.filter (/= '/') (fromUUID u)+	kf = keyFile (mkKey (const kd))+	lckkf = "lck." <> kf+	transferfile = td P.</> fu P.</> kf+	uuidlockfile = td P.</> fu P.</> lckkf+	nouuidlockfile = td P.</> "lck" P.</> lckkf  {- The transfer information file to use to record a failed Transfer -} failedTransferFile :: Transfer -> Git.Repo -> RawFilePath failedTransferFile (Transfer direction u kd) r =  	failedTransferDir u direction r 		P.</> keyFile (mkKey (const kd))--{- The transfer lock file corresponding to a given transfer info file. -}-transferLockFile :: RawFilePath -> RawFilePath-transferLockFile infofile = -	let (d, f) = P.splitFileName infofile-	in P.combine d ("lck." <> f)  {- Parses a transfer information filename to a Transfer. -} parseTransferFile :: FilePath -> Maybe Transfer

@@ -94,7 +94,7 @@ 			, versionedExport = False 			, checkPresentExport = checkPresentExportM serial adir 			, removeExportDirectory = Just $ removeExportDirectoryM serial adir-			, renameExport = renameExportM serial adir+			, renameExport = Just $ renameExportM serial adir 			} 		, importActions = ImportActions 			{ listImportableContents = listImportableContentsM serial adir c

@@ -173,7 +173,7 @@  {- A Key corresponding to the URL of a torrent file. -} torrentUrlKey :: URLString -> Annex Key-torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing+torrentUrlKey u = return $ fromUrl (fst $ torrentUrlNum u) Nothing False  {- Temporary filename to use to store the torrent file. -} tmpTorrentFile :: URLString -> Annex RawFilePath

@@ -112,7 +112,7 @@ 				-- Not needed because removeExportLocation 				-- auto-removes empty directories. 				, removeExportDirectory = Nothing-				, renameExport = renameExportM dir+				, renameExport = Just $ renameExportM dir 				} 			, importActions = ImportActions 				{ listImportableContents = listImportableContentsM ii dir

@@ -1,6 +1,6 @@ {- External special remote interface.  -- - Copyright 2013-2022 Joey Hess <id@joeyh.name>+ - Copyright 2013-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,7 +9,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE RankNTypes #-} -module Remote.External (remote) where+module Remote.External where  import Remote.External.Types import Remote.External.AsyncExtension@@ -48,10 +48,10 @@ remote = specialRemoteType $ RemoteType 	{ typename = "external" 	, enumerate = const (findSpecialRemotes "externaltype")-	, generate = gen-	, configParser = remoteConfigParser-	, setup = externalSetup-	, exportSupported = checkExportSupported+	, generate = gen remote Nothing+	, configParser = remoteConfigParser Nothing+	, setup = externalSetup Nothing Nothing+	, exportSupported = checkExportSupported Nothing 	, importSupported = importUnsupported 	, thirdPartyPopulated = False 	}@@ -62,15 +62,15 @@ readonlyField :: RemoteConfigField readonlyField = Accepted "readonly" -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)-gen r u rc gc rs+gen :: RemoteType -> Maybe ExternalProgram -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen rt externalprogram r u rc gc rs 	-- readonly mode only downloads urls; does not use external program-	| externaltype == "readonly" = do+	| externalprogram' == ExternalType "readonly" = do 		c <- parsedRemoteConfig remote rc 		cst <- remoteCost gc c expensiveRemoteCost 		let rmt = mk c cst (pure GloballyAvailable) 			Nothing-			(externalInfo externaltype)+			(externalInfo externalprogram') 			Nothing 			Nothing 			exportUnsupported@@ -83,7 +83,7 @@ 			rmt 	| otherwise = do 		c <- parsedRemoteConfig remote rc-		external <- newExternal externaltype (Just u) c (Just gc)+		external <- newExternal externalprogram' (Just u) c (Just gc) 			(Git.remoteName r) (Just rs) 		Annex.addCleanupAction (RemoteCleanup u) $ stopExternal external 		cst <- getCost external r gc c@@ -98,7 +98,7 @@ 				, versionedExport = False 				, checkPresentExport = checkPresentExportM external 				, removeExportDirectory = Just $ removeExportDirectoryM external-				, renameExport = renameExportM external+				, renameExport = Just $ renameExportM external 				} 			else exportUnsupported 		-- Cheap exportSupported that replaces the expensive@@ -150,21 +150,29 @@ 			, appendonly = False 			, untrustworthy = False 			, availability = avail-			, remotetype = remote +			, remotetype = rt  				{ exportSupported = cheapexportsupported }-			, mkUnavailable = gen r u rc-				(gc { remoteAnnexExternalType = Just "!dne!" }) rs+			, mkUnavailable =+				let dneprogram = case externalprogram of+					Just (ExternalCommand _ _) -> Just (ExternalType "!dne!")+					_ -> Nothing+				    dnegc = gc { remoteAnnexExternalType = Just "!dne!" }+				in gen rt dneprogram r u rc dnegc rs 			, getInfo = togetinfo 			, claimUrl = toclaimurl 			, checkUrl = tocheckurl 			, remoteStateHandle = rs 			}-	externaltype = fromMaybe (giveup "missing externaltype") (remoteAnnexExternalType gc)+	externalprogram' = case externalprogram of+		Just p -> p+		Nothing -> ExternalType $ +			fromMaybe (giveup "missing externaltype")+				(remoteAnnexExternalType gc) -externalSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)-externalSetup _ mu _ c gc = do+externalSetup :: Maybe ExternalProgram -> Maybe (String, String) -> SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+externalSetup externalprogram setgitconfig _ mu _ c gc = do 	u <- maybe (liftIO genUUID) return mu-	pc <- either giveup return $ parseRemoteConfig c lenientRemoteConfigParser+	pc <- either giveup return $ parseRemoteConfig c (lenientRemoteConfigParser externalprogram) 	let readonlyconfig = getRemoteConfigValue readonlyField pc == Just True 	let externaltype = if readonlyconfig 		then "readonly"@@ -181,8 +189,9 @@ 			setConfig (remoteAnnexConfig (fromJust (lookupName c)) "readonly") (boolConfig True) 			return c' 		else do-			pc' <- either giveup return $ parseRemoteConfig c' lenientRemoteConfigParser-			external <- newExternal externaltype (Just u) pc' (Just gc) Nothing Nothing+			pc' <- either giveup return $ parseRemoteConfig c' (lenientRemoteConfigParser externalprogram)+			let p = fromMaybe (ExternalType externaltype) externalprogram+			external <- newExternal p (Just u) pc' (Just gc) Nothing Nothing 			-- Now that we have an external, ask it to LISTCONFIGS,  			-- and re-parse the RemoteConfig strictly, so we can 			-- error out if the user provided an unexpected config.@@ -200,17 +209,20 @@ 				liftIO . atomically . readTMVar . externalConfigChanges 			return (changes c') -	gitConfigSpecialRemote u c'' [("externaltype", externaltype)]+	gitConfigSpecialRemote u c''+		[ fromMaybe ("externaltype", externaltype) setgitconfig ] 	return (M.delete readonlyField c'', u) -checkExportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool-checkExportSupported c gc = do+checkExportSupported :: Maybe ExternalProgram -> ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool+checkExportSupported Nothing c gc = do 	let externaltype = fromMaybe (giveup "Specify externaltype=") $ 		remoteAnnexExternalType gc <|> getRemoteConfigValue externaltypeField c 	if externaltype == "readonly" 		then return False-		else checkExportSupported' -			=<< newExternal externaltype Nothing c (Just gc) Nothing Nothing+		else checkExportSupported (Just (ExternalType externaltype)) c gc+checkExportSupported (Just externalprogram) c gc = +	checkExportSupported' +		=<< newExternal externalprogram Nothing c (Just gc) Nothing Nothing  checkExportSupported' :: External -> Annex Bool checkExportSupported' external = go `catchNonAsync` (const (return False))@@ -658,7 +670,7 @@ 		n <- succ <$> readTVar (externalLastPid external) 		writeTVar (externalLastPid external) n 		return n-	AddonProcess.startExternalAddonProcess basecmd pid >>= \case+	AddonProcess.startExternalAddonProcess externalcmd externalparams pid >>= \case 		Left (AddonProcess.ProgramFailure err) -> do 			unusable err 		Left (AddonProcess.ProgramNotInstalled err) ->@@ -666,8 +678,8 @@ 				(Just rname, Just True) -> unusable $ unlines 					[ err 					, "This remote has annex-readonly=true, and previous versions of"-					, "git-annex would tried to download from it without"-					, "installing " ++ basecmd ++ ". If you want that, you need to set:"+					, "git-annex would try to download from it without"+					, "installing " ++ externalcmd ++ ". If you want that, you need to set:" 					, "git config remote." ++ rname ++ ".annex-externaltype readonly" 					] 				_ -> unusable err@@ -686,7 +698,9 @@ 			extensions <- startproto st 			return (st, extensions)   where-	basecmd = "git-annex-remote-" ++ externalType external+	(externalcmd, externalparams) = case externalProgram external of+		ExternalType t -> ("git-annex-remote-" ++ t, [])+		ExternalCommand c ps -> (c, ps) 	startproto st = do 		receiveMessage st external 			(const Nothing)@@ -707,13 +721,13 @@ 		case filter (`notElem` fromExtensionList supportedExtensionList) (fromExtensionList exwanted) of 			[] -> return exwanted 			exrest -> unusable $ unwords $-				[ basecmd+				[ externalcmd 				, "requested extensions that this version of git-annex does not support:" 				] ++ exrest  	unusable msg = do 		warning (UnquotedString msg)-		giveup ("unable to use external special remote " ++ basecmd)+		giveup ("unable to use external special remote " ++ externalcmd)  stopExternal :: External -> Annex () stopExternal external = liftIO $ do@@ -825,12 +839,13 @@   where 	supported u = snd (getDownloader u) == WebDownloader 			-externalInfo :: ExternalType -> Annex [(String, String)]-externalInfo et = return [("externaltype", et)]+externalInfo :: ExternalProgram -> Annex [(String, String)]+externalInfo (ExternalType et) = return [("externaltype", et)]+externalInfo (ExternalCommand _ _) = return []  getInfoM :: External -> Annex [(String, String)] getInfoM external = (++)-	<$> externalInfo (externalType external)+	<$> externalInfo (externalProgram external) 	<*> handleRequest external GETINFO Nothing (collect [])   where 	collect l req = case req of@@ -847,34 +862,41 @@  {- All unknown configs are passed through in case the external program  - uses them. -}-lenientRemoteConfigParser :: RemoteConfigParser-lenientRemoteConfigParser =-	addRemoteConfigParser specialRemoteConfigParsers baseRemoteConfigParser+lenientRemoteConfigParser :: Maybe ExternalProgram -> RemoteConfigParser+lenientRemoteConfigParser externalprogram =+	addRemoteConfigParser specialRemoteConfigParsers (baseRemoteConfigParser externalprogram) -baseRemoteConfigParser :: RemoteConfigParser-baseRemoteConfigParser = RemoteConfigParser-	{ remoteConfigFieldParsers =-		[ optionalStringParser externaltypeField-			(FieldDesc "type of external special remote to use")-		, trueFalseParser readonlyField (Just False)-			(FieldDesc "enable readonly mode")-		]+baseRemoteConfigParser :: Maybe ExternalProgram -> RemoteConfigParser+baseRemoteConfigParser externalprogram = RemoteConfigParser+	{ remoteConfigFieldParsers = if isJust extcommand+		then []+		else +			[ optionalStringParser externaltypeField+				(FieldDesc "type of external special remote to use")+			, trueFalseParser readonlyField (Just False)+				(FieldDesc "enable readonly mode")+			] 	, remoteConfigRestPassthrough = Just 		( const True-		, [("*", FieldDesc "all other parameters are passed to external special remote program")]+		, [("*", FieldDesc $ "all other parameters are passed to " ++ fromMaybe "external special remote program" extcommand)] 		) 	}+  where+	extcommand = case externalprogram of+		Just (ExternalCommand c _) -> Just c+		_ -> Nothing  {- When the remote supports LISTCONFIGS, only accept the ones it listed.  - When it does not, accept all configs. -} strictRemoteConfigParser :: External -> Annex RemoteConfigParser strictRemoteConfigParser external = listConfigs external >>= \case-	Nothing -> return lenientRemoteConfigParser+	Nothing -> return lcp 	Just l -> do 		let s = S.fromList (map fst l) 		let listed f = S.member (fromProposedAccepted f) s-		return $ lenientRemoteConfigParser-			{ remoteConfigRestPassthrough = Just (listed, l) }+		return $ lcp { remoteConfigRestPassthrough = Just (listed, l) }+  where+	lcp = lenientRemoteConfigParser (Just (externalProgram external))  listConfigs :: External -> Annex (Maybe [(Setting, FieldDesc)]) listConfigs external = handleRequest external LISTCONFIGS Nothing (collect [])@@ -886,20 +908,21 @@ 		UNSUPPORTED_REQUEST -> result Nothing 		_ -> Nothing -remoteConfigParser :: RemoteConfig -> Annex RemoteConfigParser-remoteConfigParser c+remoteConfigParser :: Maybe ExternalProgram -> RemoteConfig -> Annex RemoteConfigParser+remoteConfigParser externalprogram c 	-- No need to start the external when there is no config to parse, 	-- or when everything in the config was already accepted; in those 	-- cases the lenient parser will do the same thing as the strict 	-- parser.-	| M.null (M.filter isproposed c) = return lenientRemoteConfigParser-	| otherwise = case parseRemoteConfig c baseRemoteConfigParser of-		Left _ -> return lenientRemoteConfigParser+	| M.null (M.filter isproposed c) = return (lenientRemoteConfigParser externalprogram)+	| otherwise = case parseRemoteConfig c (baseRemoteConfigParser externalprogram) of+		Left _ -> return (lenientRemoteConfigParser externalprogram) 		Right pc -> case (getRemoteConfigValue externaltypeField pc, getRemoteConfigValue readonlyField pc) of-			(Nothing, _) -> return lenientRemoteConfigParser-			(_, Just True) -> return lenientRemoteConfigParser+			(Nothing, _) -> return (lenientRemoteConfigParser externalprogram)+			(_, Just True) -> return (lenientRemoteConfigParser externalprogram) 			(Just externaltype, _) -> do-				external <- newExternal externaltype Nothing pc Nothing Nothing Nothing+				let p = fromMaybe (ExternalType externaltype) externalprogram+				external <- newExternal p Nothing pc Nothing Nothing Nothing 				strictRemoteConfigParser external   where 	isproposed (Accepted _) = False

@@ -1,6 +1,6 @@ {- External special remote data types.  -- - Copyright 2013-2020 Joey Hess <id@joeyh.name>+ - Copyright 2013-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -12,7 +12,7 @@ module Remote.External.Types ( 	External(..), 	newExternal,-	ExternalType,+	ExternalProgram(..), 	ExternalState(..), 	PrepareStatus(..), 	ExtensionList(..),@@ -64,7 +64,7 @@ import qualified Data.ByteString.Short as S (fromShort)  data External = External-	{ externalType :: ExternalType+	{ externalProgram :: ExternalProgram 	, externalUUID :: Maybe UUID 	, externalState :: TVar [ExternalState] 	-- ^ Contains states for external special remote processes@@ -77,9 +77,9 @@ 	, externalAsync :: TMVar ExternalAsync 	} -newExternal :: ExternalType -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External-newExternal externaltype u c gc rn rs = liftIO $ External-	<$> pure externaltype+newExternal :: ExternalProgram -> Maybe UUID -> ParsedRemoteConfig -> Maybe RemoteGitConfig -> Maybe RemoteName -> Maybe RemoteStateHandle -> Annex External+newExternal p u c gc rn rs = liftIO $ External+	<$> pure p 	<*> pure u 	<*> atomically (newTVar []) 	<*> atomically (newTVar 0)@@ -89,7 +89,12 @@ 	<*> pure rs 	<*> atomically (newTMVar UncheckedExternalAsync) -type ExternalType = String+data ExternalProgram+	= ExternalType String+	-- ^ "git-annex-remote-" is prepended to this to get the program+	| ExternalCommand String [CommandParam]+	-- ^ to use a program with a different name, and parameters+	deriving (Show, Eq)  data ExternalState = ExternalState 	{ externalSend :: forall t. (Proto.Sendable t, ToAsyncWrapped t) => t -> IO ()

@@ -41,7 +41,7 @@ 		, removeExport = nope 		, versionedExport = False 		, removeExportDirectory = nope-		, renameExport = \_ _ _ -> return Nothing+		, renameExport = Nothing 		} 	 where 	 	nope = giveup "export not supported"@@ -257,7 +257,7 @@ 		-- renameExport is optional, and the remote's 		-- implementation may lose modifications to the file 		-- (by eg copying and then deleting) so don't use it-		, renameExport = \_ _ _ -> return Nothing+		, renameExport = Nothing 		, checkPresentExport = checkPresentImport ciddbv 		} 	

@@ -34,7 +34,7 @@ 			{ storeExport = readonlyStoreExport 			, removeExport = readonlyRemoveExport 			, removeExportDirectory = Just readonlyRemoveExportDirectory-			, renameExport = readonlyRenameExport+			, renameExport = Nothing 			} 		, importActions = (importActions r) 			{ storeExportWithContentIdentifier = readonlyStoreExportWithContentIdentifier@@ -61,9 +61,6 @@  readonlyRemoveExportDirectory :: ExportDirectory -> Annex () readonlyRemoveExportDirectory _ = readonlyFail--readonlyRenameExport :: Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())-readonlyRenameExport _ _ _ = return Nothing  readonlyStoreExportWithContentIdentifier :: FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail

@@ -37,6 +37,7 @@ import qualified Remote.GitLFS import qualified Remote.HttpAlso import qualified Remote.Borg+import qualified Remote.Rclone import qualified Remote.Hook import qualified Remote.External @@ -59,6 +60,7 @@ 	, Remote.GitLFS.remote 	, Remote.HttpAlso.remote 	, Remote.Borg.remote+	, Remote.Rclone.remote 	, Remote.Hook.remote 	, Remote.External.remote 	]

@@ -0,0 +1,31 @@+{- Rclone special remote, using "rclone gitannex"+ -+ - Copyright 2024 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Remote.Rclone (remote) where++import Types+import Types.Remote+import Remote.Helper.Special+import Remote.Helper.ExportImport+import Utility.SafeCommand+import qualified Remote.External as External+import Remote.External.Types++remote :: RemoteType+remote = specialRemoteType $ RemoteType+	{ typename = "rclone"+	, enumerate = const (findSpecialRemotes "rclone")+	, generate = External.gen remote p+	, configParser = External.remoteConfigParser p+	, setup = External.externalSetup p setgitconfig +	, exportSupported = External.checkExportSupported p+	, importSupported = importUnsupported+	, thirdPartyPopulated = False+	}+  where+	p = Just $ ExternalCommand "rclone" [Param "gitannex"]+	setgitconfig = Just ("rclone", "true")

@@ -106,7 +106,7 @@ 				, versionedExport = False 				, checkPresentExport = checkPresentExportM o 				, removeExportDirectory = Just (removeExportDirectoryM o)-				, renameExport = renameExportM o+				, renameExport = Just $ renameExportM o 				} 			, importActions = importUnsupported 			, whereisKey = Nothing

@@ -228,7 +228,7 @@ 				, checkPresentExport = checkPresentExportS3 hdl this info 				-- S3 does not have directories. 				, removeExportDirectory = Nothing-				, renameExport = renameExportS3 hdl this rs info+				, renameExport = Just $ renameExportS3 hdl this rs info 				} 			, importActions = ImportActions                                 { listImportableContents = listImportableContentsS3 hdl this info c

@@ -1,6 +1,6 @@ {- Web remote.  -- - Copyright 2011-2023 Joey Hess <id@joeyh.name>+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -11,6 +11,7 @@ import Types.Remote import Types.ProposedAccepted import Types.Creds+import Types.Key import Remote.Helper.Special import Remote.Helper.ExportImport import qualified Git@@ -27,6 +28,9 @@ import Annex.YoutubeDl import Annex.SpecialRemote.Config import Logs.Remote+import Logs.EquivilantKeys+import Backend+import Backend.VURL.Utilities (generateEquivilantKey)  import qualified Data.Map as M @@ -123,23 +127,59 @@ 			, show (length urls) 			, "known url(s) failed" 			]+	+	isyoutube (_, YoutubeDownloader) = True+	isyoutube _ = False  	dl ([], ytus) = flip getM (map fst ytus) $ \u -> 		ifM (youtubeDlTo key u dest p)-			( return (Just UnVerified)+			( postdl UnVerified 			, return Nothing 			) 	dl (us, ytus) = do 		iv <- startVerifyKeyContentIncrementally vc key 		ifM (Url.withUrlOptions $ downloadUrl True key p iv (map fst us) dest) 			( finishVerifyKeyContentIncrementally iv >>= \case-				(True, v) -> return (Just v)+				(True, v) -> postdl v 				(False, _) -> dl ([], ytus) 			, dl ([], ytus) 			) -	isyoutube (_, YoutubeDownloader) = True-	isyoutube _ = False+	postdl v@Verified = return (Just v)+	postdl v+		-- For a VURL key that was not verified on download, +		-- need to generate a hashed key for the content downloaded+		-- from the web, and record it for later use verifying this+		-- content.+		--+		-- But when the VURL key has a known size, and already has a+		-- recorded hashed key, don't record a new key, since the+		-- content on the web is expected to be stable for such a key.+		| fromKey keyVariety key == VURLKey =+			case fromKey keySize key of+				Nothing -> +					getEquivilantKeys key+						>>= recordvurlkey+				Just _ -> do+					eks <- getEquivilantKeys key+					if null eks+						then recordvurlkey eks+						else return (Just v)+		| otherwise = return (Just v)+	+	recordvurlkey eks = do+		-- Make sure to pick a backend that is cryptographically+		-- secure.+		db <- defaultBackend+		let b = if isCryptographicallySecure db+			then db+			else defaultHashBackend+		generateEquivilantKey b (toRawFilePath dest) >>= \case+			Nothing -> return Nothing+			Just ek -> do+				unless (ek `elem` eks) $+					setEquivilantKey key ek+				return (Just Verified)  uploadKey :: Key -> AssociatedFile -> MeterUpdate -> Annex () uploadKey _ _ _ = giveup "upload to web not supported"

@@ -104,7 +104,7 @@ 				, versionedExport = False 				, removeExportDirectory = Just $ 					removeExportDirectoryDav hdl-				, renameExport = renameExportDav hdl+				, renameExport = Just $ renameExportDav hdl 				} 			, importActions = importUnsupported 			, whereisKey = Nothing

@@ -2,7 +2,7 @@  -  - Most things should not need this, using Types instead  -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -29,12 +29,17 @@ 	, canUpgradeKey :: Maybe (Key -> Bool) 	-- Checks if there is a fast way to migrate a key to a different 	-- backend (ie, without re-hashing).-	, fastMigrate :: Maybe (Key -> BackendA a -> AssociatedFile -> a (Maybe Key))+	-- The Bool is true if the content of the key has been verified to+	-- be inAnnex.+	, fastMigrate :: Maybe (Key -> BackendA a -> AssociatedFile -> Bool -> a (Maybe Key)) 	-- Checks if a key is known (or assumed) to always refer to the 	-- same data. 	, isStableKey :: Key -> Bool-	-- Checks if a key is verified using a cryptographically secure hash.+	-- Are all keys using this backend verified using a cryptographically+	-- secure hash? 	, isCryptographicallySecure :: Bool+	-- Checks if a key is verified using a cryptographically secure hash.+	, isCryptographicallySecureKey :: Key -> a Bool 	}  instance Show (BackendA a) where

@@ -136,6 +136,7 @@ 	, annexAllowedIPAddresses :: String 	, annexAllowUnverifiedDownloads :: Bool 	, annexMaxExtensionLength :: Maybe Int+	, annexMaxExtensions :: Maybe Int 	, annexJobs :: Concurrency 	, annexCacheCreds :: Bool 	, annexAutoUpgradeRepository :: Bool@@ -244,6 +245,7 @@ 	, annexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ 		getmaybe (annexConfig "security.allow-unverified-downloads") 	, annexMaxExtensionLength = getmayberead (annexConfig "maxextensionlength")+	, annexMaxExtensions = getmayberead (annexConfig "maxextensions") 	, annexJobs = fromMaybe NonConcurrent $  		parseConcurrency =<< getmaybe (annexConfig "jobs") 	, annexCacheCreds = getbool (annexConfig "cachecreds") True

@@ -1,6 +1,6 @@ {- git-annex Key data type  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2024 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -134,12 +134,12 @@ 	c ?: (Just b) = sepbefore (char7 c <> b) 	_ ?: Nothing = mempty -{- This is a strict parser for security reasons; a key- - can contain only 4 fields, which all consist only of numbers.+{- This is a strict parser for security reasons; in addition to keyName,+ - a key can contain only 4 fields, which all consist only of numbers.  - Any key containing other fields, or non-numeric data will fail  - to parse.  -- - If a key contained non-numeric fields, they could be used to+ - If a key contained other non-numeric fields, they could be used to  - embed data used in a SHA1 collision attack, which would be a  - problem since the keys are committed to git.  -}@@ -218,6 +218,7 @@ 	| MD5Key HasExt 	| WORMKey 	| URLKey+	| VURLKey 	-- A key that is handled by some external backend. 	| ExternalKey S.ByteString HasExt  	-- Some repositories may contain keys of other varieties,@@ -251,6 +252,7 @@ hasExt (MD5Key (HasExt b)) = b hasExt WORMKey = False hasExt URLKey = False+hasExt VURLKey = False hasExt (ExternalKey _ (HasExt b)) = b hasExt (OtherKey s) = (snd <$> S8.unsnoc s) == Just 'E' @@ -279,6 +281,7 @@ 	MD5Key e -> adde e "MD5" 	WORMKey -> "WORM" 	URLKey -> "URL"+	VURLKey -> "VURL" 	ExternalKey s e -> adde e ("X" <> s) 	OtherKey s -> s   where@@ -343,6 +346,7 @@ parseKeyVariety "MD5E"         = MD5Key (HasExt True) parseKeyVariety "WORM"         = WORMKey parseKeyVariety "URL"          = URLKey+parseKeyVariety "VURL"         = VURLKey parseKeyVariety b 	| "X" `S.isPrefixOf` b =  		let b' = S.tail b

@@ -302,7 +302,7 @@ 	-- 	-- Throws an exception if the remote cannot be accessed, or 	-- the file doesn't exist or cannot be renamed.-	, renameExport :: Key -> ExportLocation -> ExportLocation -> a (Maybe ())+	, renameExport :: Maybe (Key -> ExportLocation -> ExportLocation -> a (Maybe ())) 	}  data ImportActions a = ImportActions

@@ -21,17 +21,18 @@ 	truncateFilePath, ) where -import qualified GHC.Foreign as GHC import qualified GHC.IO.Encoding as Encoding import System.IO-import System.IO.Unsafe import System.FilePath.ByteString (RawFilePath, encodeFilePath, decodeFilePath) import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L-import Data.ByteString.Unsafe (unsafePackMallocCStringLen) #ifdef mingw32_HOST_OS import qualified Data.ByteString.UTF8 as S8 import qualified Data.ByteString.Lazy.UTF8 as L8+#else+import qualified GHC.Foreign as GHC+import System.IO.Unsafe+import Data.ByteString.Unsafe (unsafePackMallocCStringLen) #endif  {- Makes all subsequent Handles that are opened, as well as stdio Handles,

@@ -31,9 +31,6 @@ import qualified Utility.RawFilePath as R import Author -copyright :: Copyright-copyright = author JoeyHess (2022-11)- {- Moves one filename to another.  - First tries a rename, but falls back to moving across devices if needed. -} moveFile :: RawFilePath -> RawFilePath -> IO ()@@ -80,4 +77,7 @@ 		case r of 			(Left _) -> return False 			(Right s) -> return $ isDirectory s++copyright :: Copyright+copyright = author JoeyHess (2022-11) #endif

@@ -29,11 +29,15 @@ import Utility.Tmp #endif import Utility.Tmp.Dir+import Author  import Control.Concurrent.Async import Control.Monad.IO.Class import qualified Data.ByteString as B +copyright :: Copyright+copyright = author JoeyHess (max 2024 2009)+ {- The command to run, eq sqop. -} newtype SOPCmd = SOPCmd { unSOPCmd :: String } @@ -148,7 +152,8 @@ 		return (passwordfd, frompipe, toh, t) 	let cleanup (_, frompipe, toh, t) = liftIO $ do 		closeFd frompipe-		hClose toh+		when copyright $+			hClose toh 		cancel t 	bracket setup cleanup $ \(passwordfd, _, _, _) -> 		go (Just emptydirectory) (passwordfd ++ params)@@ -186,7 +191,7 @@ 			Just (EmptyDirectory d) -> Just d 			Nothing -> Nothing 		}-	bracket (setup p) cleanup (go p)+	copyright =<< bracket (setup p) cleanup (go p)   where 	setup = liftIO . createProcess 	cleanup = liftIO . cleanupProcess

@@ -16,7 +16,6 @@ import System.IO #ifdef mingw32_HOST_OS import System.Win32.MinTTY (isMinTTYHandle)-import System.Win32.File import System.Win32.Types import Graphics.Win32.Misc import Control.Exception@@ -41,5 +40,5 @@ 				then return (IsTerminal False) 				else do 					b' <- isMinTTYHandle h'-					return (IsTerminal b)+					return (IsTerminal b') #endif

@@ -1,7 +1,6 @@ {- thread scheduling  -- - Copyright 2012, 2013 Joey Hess <id@joeyh.name>- - Copyright 2011 Bas van Dijk & Roel van Dijk+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -19,8 +18,9 @@ ) where  import Control.Monad-import Control.Concurrent+import qualified Control.Concurrent.Thread.Delay as Unbounded #ifndef mingw32_HOST_OS+import Control.Concurrent import Control.Monad.IfElse import System.Posix.IO #endif@@ -44,20 +44,9 @@ threadDelaySeconds :: Seconds -> IO () threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond) -{- Like threadDelay, but not bounded by an Int.- -- - There is no guarantee that the thread will be rescheduled promptly when the- - delay has expired, but the thread will never continue to run earlier than- - specified.- - - - Taken from the unbounded-delay package to avoid a dependency for 4 lines- - of code.- -}+{- Like threadDelay, but not bounded by an Int. -} unboundDelay :: Microseconds -> IO ()-unboundDelay time = do-	let maxWait = min time $ toInteger (maxBound :: Int)-	threadDelay $ fromInteger maxWait-	when (maxWait /= time) $ unboundDelay (time - maxWait)+unboundDelay = Unbounded.delay  {- Pauses the main thread, letting children run until program termination. -} waitForTermination :: IO ()

@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20240227+Version: 10.20240430 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -267,6 +267,7 @@    split,    attoparsec (>= 0.13.2.2),    concurrent-output (>= 1.10),+   unbounded-delays,    QuickCheck (>= 2.10.0),    tasty (>= 1.2),    tasty-hunit,@@ -582,6 +583,9 @@     Backend.Hash     Backend.URL     Backend.Utilities+    Backend.Variety+    Backend.VURL+    Backend.VURL.Utilities     Backend.WORM     Benchmark     Build.BundledPrograms@@ -681,6 +685,7 @@     Command.ReadPresentKey     Command.RecvKey     Command.RegisterUrl+    Command.ReregisterUrl     Command.Reinit     Command.Reinject     Command.RemoteDaemon@@ -811,6 +816,7 @@     Logs.ContentIdentifier.Pure     Logs.Difference     Logs.Difference.Pure+    Logs.EquivilantKeys     Logs.Export     Logs.Export.Pure     Logs.File@@ -894,6 +900,7 @@     Remote.List     Remote.List.Util     Remote.P2P+    Remote.Rclone     Remote.Rsync     Remote.Rsync.RsyncUrl     Remote.S3