git-annex 10.20260624 → 10.20260717

raw patch · 96 files changed

+1280/−495 lines, 96 filesdep +ramdep ~basedep ~persistentdep ~yesod

Dependencies added: ram

Dependency ranges changed: base, persistent, yesod, yesod-core, yesod-form, yesod-static

Files

• Annex/Balanced.hs +3/−1
• Annex/Content.hs +6/−6
• Annex/DirHashes.hs +3/−1
• Annex/Export.hs +6/−4
• Annex/Import.hs +15/−13
• Annex/Init.hs +1/−1
• Annex/Proxy.hs +1/−1
• Annex/SpecialRemote/Config.hs +4/−0
• Annex/StallDetection.hs +3/−3
• Annex/Tmp.hs +1/−1
• Annex/Transfer.hs +4/−4
• Annex/TransferrerPool.hs +2/−2
• Annex/Verify.hs +15/−15
• Assistant/CredPairCache.hs +1/−1
• Assistant/Repair.hs +1/−1
• Assistant/Restart.hs +1/−1
• Assistant/Threads/Committer.hs +5/−5
• Assistant/Threads/ConfigMonitor.hs +1/−1
• Assistant/Threads/Cronner.hs +6/−6
• Assistant/Threads/DaemonStatus.hs +1/−1
• Assistant/Threads/Exporter.hs +2/−2
• Assistant/Threads/Glacier.hs +1/−1
• Assistant/Threads/MountWatcher.hs +1/−1
• Assistant/Threads/NetWatcher.hs +2/−2
• Assistant/Threads/ProblemFixer.hs +1/−1
• Assistant/Threads/Pusher.hs +2/−2
• Assistant/Threads/RemoteControl.hs +1/−1
• Assistant/Threads/SanityChecker.hs +3/−3
• Assistant/Threads/TransferScanner.hs +1/−1
• Assistant/Threads/UpgradeWatcher.hs +1/−1
• Assistant/Threads/Watcher.hs +1/−1
• Assistant/TransferSlots.hs +1/−1
• Assistant/Upgrade.hs +1/−1
• Assistant/WebApp/Configurators/Ssh.hs +1/−1
• Backend/External.hs +13/−9
• BuildFlags.hs +3/−0
• CHANGELOG +22/−0
• Command/EnableTor.hs +1/−1
• Command/FuzzTest.hs +16/−16
• Command/Import.hs +1/−1
• Command/NotifyChanges.hs +1/−1
• Command/P2P.hs +1/−1
• Command/Transferrer.hs +1/−1
• Messages/Progress.hs +14/−4
• P2P/Http/State.hs +2/−2
• P2P/IO.hs +2/−2
• P2P/Protocol.hs +52/−31
• Remote/Adb.hs +7/−5
• Remote/BitTorrent.hs +2/−0
• Remote/Borg.hs +10/−8
• Remote/Bup.hs +2/−0
• Remote/Compute.hs +2/−0
• Remote/Ddar.hs +2/−0
• Remote/Directory.hs +7/−5
• Remote/External.hs +383/−107
• Remote/External/AsyncExtension.hs +1/−1
• Remote/External/Types.hs +95/−30
• Remote/GCrypt.hs +2/−0
• Remote/Git.hs +2/−0
• Remote/GitLFS.hs +2/−0
• Remote/Glacier.hs +2/−0
• Remote/Helper/ExportImport.hs +161/−70
• Remote/Helper/ReadOnly.hs +1/−1
• Remote/Hook.hs +2/−0
• Remote/HttpAlso.hs +2/−0
• Remote/Mask.hs +2/−0
• Remote/P2P.hs +2/−0
• Remote/Rclone.hs +4/−3
• Remote/Rsync.hs +68/−7
• Remote/S3.hs +10/−8
• Remote/Tahoe.hs +4/−2
• Remote/Web.hs +2/−0
• Remote/WebDAV.hs +2/−0
• RemoteDaemon/Common.hs +1/−1
• RemoteDaemon/Core.hs +2/−2
• RemoteDaemon/Transport/Ssh/Types.hs +3/−2
• RemoteDaemon/Types.hs +12/−11
• Test/Framework.hs +1/−1
• Types/GitConfig.hs +7/−7
• Types/Remote.hs +77/−9
• Types/Transferrer.hs +17/−16
• Utility/AuthToken.hs +1/−1
• Utility/Hash/Crypton.hs +1/−1
• Utility/Hash/Types.hs +3/−2
• Utility/IPAddress.hs +2/−1
• Utility/LockFile/PidLock.hs +6/−6
• Utility/LockPool/PidLock.hs +2/−2
• Utility/Rsync.hs +20/−1
• Utility/SimpleProtocol.hs +24/−2
• Utility/ThreadScheduler.hs +10/−10
• Utility/Tmp.hs +14/−3
• Utility/Tor.hs +1/−1
• git-annex.cabal +37/−13
• stack-NoLLMDependencies.yaml +30/−0
• stack-botan.yaml +1/−0
• stack.yaml +1/−0

@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE PackageImports #-}+ module Annex.Balanced where  import Key@@ -15,7 +17,7 @@ import qualified Data.List as L import Data.Bits (shiftL) import qualified Data.Set as S-import qualified Data.ByteArray as BA+import qualified "memory" Data.ByteArray as BA  -- The Int is how many UUIDs to pick. type BalancedPicker = S.Set UUID -> Key -> Int -> [UUID]

@@ -897,19 +897,19 @@  - Otherwise, only displays one error message, from one of the urls  - that failed.  -}-downloadUrl :: Bool -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> OsPath -> Url.UrlOptions -> Annex Bool-downloadUrl listfailedurls k p iv urls file uo =-	downloadUrl' listfailedurls k p iv urls file uo >>= \case+downloadUrl :: MeterSize sizer => Bool -> sizer -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> OsPath -> Url.UrlOptions -> Annex Bool+downloadUrl listfailedurls sizer p iv urls file uo =+	downloadUrl' listfailedurls sizer p iv urls file uo >>= \case 		Right r -> return r 		Left e -> do 			warning $ UnquotedString e 			return False -downloadUrl' :: Bool -> Key -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> OsPath -> Url.UrlOptions -> Annex (Either String Bool)-downloadUrl' listfailedurls k p iv urls file uo = +downloadUrl' :: MeterSize sizer => Bool -> sizer -> MeterUpdate -> Maybe IncrementalVerifier -> [Url.URLString] -> OsPath -> Url.UrlOptions -> Annex (Either String Bool)+downloadUrl' listfailedurls sizer p iv urls file uo =  	-- Poll the file to handle configurations where an external 	-- download command is used.-	meteredFile file (Just p) k (go urls [])+	meteredFile file (Just p) sizer (go urls [])   where 	go (u:us) errs p' = Url.download' p' iv u file uo >>= \case 		Right () -> return (Right True)

@@ -5,6 +5,8 @@  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE PackageImports #-}+ module Annex.DirHashes ( 	Hasher, 	HashLevels(..),@@ -20,7 +22,7 @@ import Data.Default import Data.Bits import qualified Data.List.NonEmpty as NE-import qualified Data.ByteArray as BA+import qualified "memory" Data.ByteArray as BA import qualified Data.ByteString as S  import Common

@@ -30,11 +30,13 @@  warnExportImportConflict :: Remote -> Annex () warnExportImportConflict r = do-	isimport <- Remote.isImportSupported r 	isexport <- Remote.isExportSupported r-	let (ops, resolvcmd) = case (isexport, isimport) of-		(False, True) -> ("imported from", "git-annex import")-		(True, False) -> ("exported to", "git-annex export")+	isimport <- Remote.isImportSupported r+	isexportimport <- Remote.isExportImportSupported r+	let (ops, resolvcmd) = case (isexport, isimport, isexportimport) of+		(False, _, True) -> ("exported to and/or imported from", "git-annex import")+		(True, _, False) -> ("exported to", "git-annex export")+		(False, True, False) -> ("imported from", "git-annex import") 		_ -> ("exported to and/or imported from", "git-annex export") 	toplevelWarning True $ UnquotedString $ unwords 		[ "Conflict detected. Different trees have been"

@@ -6,6 +6,7 @@  -}  {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-} {-# LANGUAGE CPP #-}  module Annex.Import (@@ -71,7 +72,7 @@ import Control.Concurrent.STM import qualified Data.Map.Strict as M import qualified Data.Set as S-import qualified Data.ByteArray.Encoding as BA+import qualified "memory" Data.ByteArray.Encoding as BA #ifdef mingw32_HOST_OS import qualified System.FilePath.Posix as Posix #endif@@ -502,7 +503,7 @@ canImportKeys remote importcontent = 	importcontent || isJust (Remote.importKey ia)   where-	ia = Remote.importActions remote+	ia = Remote.exportImportActions remote  -- Result of an import.  data ImportResult t@@ -806,7 +807,7 @@ 			return (Right job) 	 	thirdpartypopulatedimport db (loc, (cid, sz)) = -		case Remote.importKey ia of+		case Remote.importKey (Remote.exportImportActions remote) of 			Nothing -> return Nothing 			Just importkey -> 				tryNonAsync (importkey loc cid sz nullMeterUpdate) >>= \case@@ -826,7 +827,7 @@ 		-- than downloading and retrieving a key, to avoid 		-- generating trees with different keys for the same content. 		let act = if importcontent-			then case Remote.importKey ia of+			then case Remote.importKey (Remote.exportImportActions remote) of 				Nothing -> dodownload 				Just _ -> if Utility.Matcher.introspect matchNeedsFileContent (fst matcher) 					then dodownload@@ -835,7 +836,7 @@ 		act cidmap (loc, (cid, sz)) f matcher  	doimport cidmap (loc, (cid, sz)) f matcher =-		case Remote.importKey ia of+		case Remote.importKey (Remote.exportImportActions remote) of 			Nothing -> error "internal" -- checked earlier 			Just importkey -> do 				when (Utility.Matcher.introspect matchNeedsFileContent (fst matcher)) $@@ -882,8 +883,9 @@ 		getcontent k = do 			let af = AssociatedFile (Just f) 			let downloader p' tmpfile = do-				_ <- Remote.retrieveExportWithContentIdentifier-					ia loc [cid] tmpfile+				_ <- Remote.retrieveImport+					(Remote.importActions remote)+					loc [cid] tmpfile 					(Left k) 					(combineMeterUpdate p' p) 				ok <- moveAnnex k tmpfile@@ -900,8 +902,9 @@ 	-- need to retrieve this file. 	doimportsmall cidmap loc cid sz p = do 		let downloader tmpfile = do-			(k, _) <- Remote.retrieveExportWithContentIdentifier-				ia loc [cid] tmpfile+			(k, _) <- Remote.retrieveImport+				(Remote.importActions remote)+				loc [cid] tmpfile 				(Right (mkkey tmpfile)) 				p 			case keyGitSha k of@@ -923,8 +926,9 @@ 	dodownload cidmap (loc, (cid, sz)) f matcher = do 		let af = AssociatedFile (Just f) 		let downloader tmpfile p = do-			(k, _) <- Remote.retrieveExportWithContentIdentifier-				ia loc [cid] tmpfile+			(k, _) <- Remote.retrieveImport+				(Remote.importActions remote)+				loc [cid] tmpfile 				(Right (mkkey tmpfile)) 				p 			case keyGitSha k of@@ -970,8 +974,6 @@ 						} 					fst <$> genKey ks nullMeterUpdate backend 				else gitShaKey <$> hashFile tmpfile-	-	ia = Remote.importActions remote 				 	bwlimit = remoteAnnexBwLimitDownload (Remote.gitconfig remote) 			<|> remoteAnnexBwLimit (Remote.gitconfig remote)

@@ -428,7 +428,7 @@ 		return ok 	 	warnstall annexrunner = do-		threadDelaySeconds (Seconds 10)+		threadDelaySeconds (SecondsDelay 10) 		annexrunner $ do 			warning "Probing the filesystem for POSIX fcntl lock support is taking a long time." 			warning "(Setting annex.pidlock will avoid this probe.)"

@@ -194,7 +194,7 @@ 				gotall <- liftIO $ receivetofile iv h len 				liftIO $ hClose h 				verified <- if gotall-					then fst <$> finishVerifyKeyContentIncrementally' True iv+					then fst <$> finishVerifyKeyContentIncrementally iv 					else pure False 				let store = tryNonAsync (storeput k af tmpfile) >>= \case 					Right () -> liftIO $ sendmessage SUCCESS

@@ -288,6 +288,10 @@ 	yesno "no" = Just False 	yesno _ = Nothing +yesNoGenerator :: Bool -> String+yesNoGenerator True = "yes"+yesNoGenerator False = "no"+ trueFalseParser :: RemoteConfigField -> Maybe Bool -> FieldDesc -> RemoteConfigFieldParser trueFalseParser f mdef fd = genParser trueFalseParser' f mdef fd 	(Just (ValueDesc "true or false"))

@@ -55,7 +55,7 @@ 	let BwRate scaledminsz scaledduration = upscale bwrate timepassed 	detectStalls' scaledminsz scaledduration metervar onstall v   where-	minwaitsecs = Seconds $+	minwaitsecs = SecondsDelay $ 		min 60 (fromIntegral (durationSeconds duration)) 	waitforfirstupdate startval = do 		liftIO $ threadDelaySeconds minwaitsecs@@ -75,7 +75,7 @@   where 	duration = Duration 60 -	delay = Seconds (fromIntegral (durationSeconds duration) `div` 2)+	delay = SecondsDelay (fromIntegral (durationSeconds duration) `div` 2) 	 	waitforfirstupdate startval = do 		liftIO $ threadDelaySeconds delay@@ -115,7 +115,7 @@ 			| sofar - prev < minsz -> onstall 			| otherwise -> cont   where-	delay = Seconds (fromIntegral (durationSeconds duration))+	delay = SecondsDelay (fromIntegral (durationSeconds duration))  readMeterVar 	:: MonadIO m

@@ -38,7 +38,7 @@ -- cleaned up by another git-annex process (after they're a week old). -- -- Unlike withOtherTmp, this does not rely on locking working.--- Its main use is in situations where the state of lockfile is not+-- Its main use is in situations where the state of locking is not -- determined yet, eg during initialization. withEventuallyCleanedOtherTmp :: (OsPath -> Annex a) -> Annex a withEventuallyCleanedOtherTmp = bracket setup cleanup

@@ -360,19 +360,19 @@  - by git configuration. -} configuredRetry :: RetryDecider configuredRetry numretries _old new = do-	(maxretries, Seconds initretrydelay) <- getcfg $ +	(maxretries, SecondsDelay initretrydelay) <- getcfg $  		Remote.gitconfig <$> transferRemote new 	if numretries < maxretries 		then do-			let retrydelay = Seconds (initretrydelay * 2^(numretries-1))-			showSideAction $ UnquotedString $ "Delaying " ++ show (fromSeconds retrydelay) ++ "s before retrying."+			let retrydelay = SecondsDelay (initretrydelay * 2^(numretries-1))+			showSideAction $ UnquotedString $ "Delaying " ++ show (fromSecondsDelay retrydelay) ++ "s before retrying." 			liftIO $ threadDelaySeconds retrydelay 			return True 		else return False   where 	globalretrycfg = fromMaybe 0 . annexRetry 		<$> Annex.getGitConfig-	globalretrydelaycfg = fromMaybe (Seconds 1) . annexRetryDelay+	globalretrydelaycfg = fromMaybe (SecondsDelay 1) . annexRetryDelay 		<$> Annex.getGitConfig 	getcfg Nothing = (,) <$> globalretrycfg <*> globalretrydelaycfg 	getcfg (Just gc) = (,)

@@ -247,14 +247,14 @@ 		(AssistantLevel, Upload) -> AssistantUploadRequest 		(AssistantLevel, Download) -> AssistantDownloadRequest 	let r = f tr (transferKey t) (TransferAssociatedFile afile)-	let l = unwords $ Proto.formatMessage r+	let l = Proto.genMessage r 	debug "Annex.TransferrerPool" ("> " ++ l) 	hPutStrLn h l 	hFlush h  sendSerializedOutputResponse :: Handle -> SerializedOutputResponse -> IO () sendSerializedOutputResponse h sor = do-	let l = unwords $ Proto.formatMessage $+	let l = Proto.genMessage $ 		TransferSerializedOutputResponse sor 	debug "Annex.TransferrerPool" ("> " ++ show l) 	hPutStrLn h l

@@ -1,6 +1,6 @@ {- verification  -- - Copyright 2010-2024 Joey Hess <id@joeyh.name>+ - Copyright 2010-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -19,8 +19,8 @@ 	isVerifiable, 	startVerifyKeyContentIncrementally, 	finishVerifyKeyContentIncrementally,-	finishVerifyKeyContentIncrementally', 	verifyKeyContentIncrementally,+	verifyKeyContentIncrementally', 	IncrementalVerifier(..), 	writeVerifyChunk, 	resumeVerifyFromOffset,@@ -76,6 +76,7 @@ verifyKeyContentPostRetrieval :: RetrievalSecurityPolicy -> VerifyConfig -> Verification -> Key -> OsPath -> Annex Bool verifyKeyContentPostRetrieval rsp v verification k f = case (rsp, verification) of 	(_, Verified) -> return True+	(_, VerificationFailed) -> return False 	(RetrievalVerifiableKeysSecure, _) -> ifM (isVerifiable k) 		( verify 		, ifM (annexAllowUnverifiedDownloads <$> Annex.getGitConfig)@@ -199,26 +200,25 @@ 		)  finishVerifyKeyContentIncrementally :: Maybe IncrementalVerifier -> Annex (Bool, Verification)-finishVerifyKeyContentIncrementally = finishVerifyKeyContentIncrementally' False--finishVerifyKeyContentIncrementally' :: Bool -> Maybe IncrementalVerifier -> Annex (Bool, Verification)-finishVerifyKeyContentIncrementally' _ Nothing = +finishVerifyKeyContentIncrementally Nothing =  	return (True, UnVerified)-finishVerifyKeyContentIncrementally' quiet (Just iv) =+finishVerifyKeyContentIncrementally (Just iv) = 	liftIO (finalizeIncrementalVerifier iv) >>= \case 		Just True -> return (True, Verified)-		Just False -> do-			unless quiet $-				warning "verification of content failed"-			return (False, UnVerified)+		Just False -> return (False, VerificationFailed) 		-- Incremental verification was not able to be done. 		Nothing -> return (True, UnVerified) -verifyKeyContentIncrementally :: VerifyConfig -> Key -> (Maybe IncrementalVerifier -> Annex ()) -> Annex Verification-verifyKeyContentIncrementally verifyconfig k a = do+verifyKeyContentIncrementally :: VerifyConfig -> Key -> (Maybe IncrementalVerifier -> Annex ()) -> Annex (Verification)+verifyKeyContentIncrementally verifyconfig k a  = +	snd <$> verifyKeyContentIncrementally' verifyconfig k a++verifyKeyContentIncrementally' :: VerifyConfig -> Key -> (Maybe IncrementalVerifier -> Annex a) -> Annex (a, Verification)+verifyKeyContentIncrementally' verifyconfig k a = do 	miv <- startVerifyKeyContentIncrementally verifyconfig k-	a miv-	snd <$> finishVerifyKeyContentIncrementally miv+	r <- a miv+	v <- snd <$> finishVerifyKeyContentIncrementally miv+	return (r, v)  writeVerifyChunk :: Maybe IncrementalVerifier -> Handle -> S.ByteString -> IO () writeVerifyChunk (Just iv) h c = do

@@ -27,7 +27,7 @@  - Note that repeatedly caching the same CredPair  - does not reset its expiry time.  -}-cacheCred :: CredPair -> Seconds -> Assistant ()+cacheCred :: CredPair -> SecondsDelay -> Assistant () cacheCred (login, password) expireafter = do 	cache <- getAssistant credPairCache 	liftIO $ do

@@ -149,7 +149,7 @@ 	go [] = return () 	go l = whenM (liftIO $ null <$> Lsof.query ("--" : map (fromOsPath . fst) l)) $ do 		debug ["Waiting for 60 seconds to check stale git lock file"]-		liftIO $ threadDelaySeconds $ Seconds 60+		liftIO $ threadDelaySeconds $ SecondsDelay 60 		l' <- getsizes 		if l' == l 			then liftIO $ mapM_ (removeWhenExistsWith removeFile . fst) l

@@ -52,7 +52,7 @@ 	modifyDaemonStatus_ $ \status -> status { globalRedirUrl = Just url } 	liftIO . sendNotification . globalRedirNotifier =<< getDaemonStatus 	void $ liftIO $ forkIO $ do-		threadDelaySeconds (Seconds 120)+		threadDelaySeconds (SecondsDelay 120) 		terminateSelf  terminateSelf :: IO ()

@@ -59,7 +59,7 @@ commitThread = namedThread "Committer" $ do 	havelsof <- liftIO $ inSearchPath "lsof" 	delayadd <- liftAnnex $-		fmap Seconds . annexDelayAdd <$> Annex.getGitConfig+		fmap SecondsDelay . annexDelayAdd <$> Annex.getGitConfig 	largefilematcher <- liftAnnex largeFilesMatcher 	annexdotfiles <- liftAnnex $ getGitConfigVal annexDotFiles 	addunlockedmatcher <- liftAnnex $@@ -111,7 +111,7 @@   where 	waitchanges lastcommitsize = do 		-- Wait one one second as a simple rate limiter.-		liftIO $ threadDelaySeconds (Seconds 1)+		liftIO $ threadDelaySeconds (SecondsDelay 1) 		-- Now, wait until at least one change is available for 		-- processing. 		cs <- getChanges@@ -193,7 +193,7 @@ 		loop 0 = continue oldchanges 		loop n = do 			liftAnnex noop -- ensure Annex state is free-			liftIO $ threadDelaySeconds (Seconds 1)+			liftIO $ threadDelaySeconds (SecondsDelay 1) 			changes <- getAnyChanges 			if null changes 				then loop (n - 1)@@ -280,7 +280,7 @@  - Any pending adds that are not ready yet are put back into the ChangeChan,  - where they will be retried later.  -}-handleAdds :: OsPath -> Bool -> GetFileMatcher -> Bool -> Maybe AddUnlockedMatcher -> Maybe Seconds -> [Change] -> Assistant [Change]+handleAdds :: OsPath -> Bool -> GetFileMatcher -> Bool -> Maybe AddUnlockedMatcher -> Maybe SecondsDelay -> [Change] -> Assistant [Change] handleAdds lockdowndir havelsof largefilematcher annexdotfiles addunlockedmatcher delayadd cs = returnWhen (null incomplete) $ do 	let (pending, inprocess) = partition isPendingAddChange incomplete 	let lockdownconfig = LockDownConfig@@ -467,7 +467,7 @@  -  - Check by running lsof on the repository.  -}-safeToAdd :: OsPath -> LockDownConfig -> Bool -> Maybe Seconds -> [Change] -> [Change] -> Assistant [Either Change Change]+safeToAdd :: OsPath -> LockDownConfig -> Bool -> Maybe SecondsDelay -> [Change] -> [Change] -> Assistant [Either Change Change] safeToAdd _ _ _ _ [] [] = return [] safeToAdd lockdowndir lockdownconfig havelsof delayadd pending inprocess = do 	maybe noop (liftIO . threadDelaySeconds) delayadd

@@ -50,7 +50,7 @@ 			{- Record a commit to get this config 			 - change pushed out to remotes. -} 			recordCommit-		liftIO $ threadDelaySeconds (Seconds 60)+		liftIO $ threadDelaySeconds (SecondsDelay 60) 		loop new  {- Config files, and their checksums. -}

@@ -116,8 +116,8 @@ 	desc = fromScheduledActivity activity 	schedule = getSchedule activity 	waitrun l t mmaxt = do-		seconds <- liftIO $ secondsUntilLocalTime t-		when (seconds > Seconds 0) $ do+		seconds <- liftIO $ secondsDelayUntilLocalTime t+		when (seconds > SecondsDelay 0) $ do 			debug ["waiting", show seconds, "for next scheduled", desc] 			liftIO $ threadDelaySeconds seconds 		now <- liftIO getCurrentTime@@ -161,14 +161,14 @@ 	go _ = noop -- running at exact time not handled here 	loop = remoteActivityThread urlrenderer mvar activity -secondsUntilLocalTime :: LocalTime -> IO Seconds-secondsUntilLocalTime t = do+secondsDelayUntilLocalTime :: LocalTime -> IO SecondsDelay+secondsDelayUntilLocalTime t = do 	now <- getCurrentTime 	tz <- getTimeZone now 	let secs = truncate $ diffUTCTime (localTimeToUTC tz t) now 	return $ if secs > 0-		then Seconds secs-		else Seconds 0+		then SecondsDelay secs+		else SecondsDelay 0  runActivity :: UrlRenderer -> ScheduledActivity -> LocalTime -> Assistant () runActivity urlrenderer activity nowt = do

@@ -20,7 +20,7 @@ 	notifier <- liftIO . newNotificationHandle False 		=<< changeNotifier <$> getDaemonStatus 	checkpoint-	runEvery (Seconds tenMinutes) <~> do+	runEvery (SecondsDelay tenMinutes) <~> do 		liftIO $ waitNotification notifier 		checkpoint   where

@@ -25,7 +25,7 @@  {- This thread retries exports that failed before. -} exportRetryThread :: NamedThread-exportRetryThread = namedThread "ExportRetrier" $ runEvery (Seconds halfhour) <~> do+exportRetryThread = namedThread "ExportRetrier" $ runEvery (SecondsDelay halfhour) <~> do 	-- We already waited half an hour, now wait until there are failed 	-- exports to retry. 	toexport <- getFailedPushesBefore (fromIntegral halfhour) @@ -38,7 +38,7 @@  {- This thread updates exports soon after git commits are made. -} exportThread :: NamedThread-exportThread = namedThread "Exporter" $ runEvery (Seconds 30) <~> do+exportThread = namedThread "Exporter" $ runEvery (SecondsDelay 30) <~> do 	-- We already waited two seconds as a simple rate limiter. 	-- Next, wait until at least one commit has been made 	void getExportCommits

@@ -25,7 +25,7 @@  - downloads. If so, runs glacier-cli to check if the files are now  - available, and queues the downloads. -} glacierThread :: NamedThread-glacierThread = namedThread "Glacier" $ runEvery (Seconds 3600) <~> go+glacierThread = namedThread "Glacier" $ runEvery (SecondsDelay 3600) <~> go   where 	isglacier r = Remote.remotetype r == Glacier.remote 	go = do

@@ -131,7 +131,7 @@ pollingThread urlrenderer = go =<< liftIO currentMountPoints   where 	go wasmounted = do-		liftIO $ threadDelaySeconds (Seconds 10)+		liftIO $ threadDelaySeconds (SecondsDelay 10) 		nowmounted <- liftIO currentMountPoints 		handleMounts urlrenderer wasmounted nowmounted 		go nowmounted

@@ -48,7 +48,7 @@  -} netWatcherFallbackThread :: NamedThread netWatcherFallbackThread = namedThread "NetWatcherFallback" $-	runEvery (Seconds 3600) <~> handleConnection+	runEvery (SecondsDelay 3600) <~> handleConnection  #if WITH_DBUS @@ -80,7 +80,7 @@ 		liftAnnex $ 			warning $ UnquotedString $ "lost dbus connection; falling back to polling (" ++ show e ++ ")" 		{- Wait, in hope that dbus will come back -}-		liftIO $ threadDelaySeconds (Seconds 60)+		liftIO $ threadDelaySeconds (SecondsDelay 60)  {- Examine the list of services connected to dbus, to see if there  - are any we can use to monitor network connections. -}

@@ -30,7 +30,7 @@   where 	go problems = do 		mapM_ (handleProblem urlrenderer) problems-		liftIO $ threadDelaySeconds (Seconds 60)+		liftIO $ threadDelaySeconds (SecondsDelay 60) 		-- Problems may have been re-reported while they were being 		-- fixed, so ignore those. If a new unique problem happened 		-- 60 seconds after the last was fixed, we're unlikely

@@ -18,7 +18,7 @@  {- This thread retries pushes that failed before. -} pushRetryThread :: NamedThread-pushRetryThread = namedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do+pushRetryThread = namedThread "PushRetrier" $ runEvery (SecondsDelay halfhour) <~> do 	-- We already waited half an hour, now wait until there are failed 	-- pushes to retry. 	topush <- getFailedPushesBefore (fromIntegral halfhour)@@ -31,7 +31,7 @@  {- This thread pushes git commits out to remotes soon after they are made. -} pushThread :: NamedThread-pushThread = namedThread "Pusher" $ runEvery (Seconds 2) <~> do+pushThread = namedThread "Pusher" $ runEvery (SecondsDelay 2) <~> do 	-- We already waited two seconds as a simple rate limiter. 	-- Next, wait until at least one commit has been made 	void getCommits

@@ -62,7 +62,7 @@ 		msg <- liftIO $ readChan clicker 		debug [show msg] 		liftIO $ do-			hPutStrLn toh $ unwords $ formatMessage msg+			hPutStrLn toh $ genMessage msg 			hFlush toh  -- read status messages emitted by the remotedaemon and handle them

@@ -91,7 +91,7 @@ 	void $ liftAnnex $ tryNonAsync $ cleanupOtherTmp  	{- If there's a startup delay, it's done here. -}-	liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay+	liftIO $ maybe noop (threadDelaySeconds . SecondsDelay . fromIntegral . durationSeconds) startupdelay  	{- Notify other threads that the startup sanity check is done. -} 	status <- getDaemonStatus@@ -100,7 +100,7 @@ {- This thread wakes up hourly for inxepensive frequent sanity checks. -} sanityCheckerHourlyThread :: NamedThread sanityCheckerHourlyThread = namedThread "SanityCheckerHourly" $ forever $ do-	liftIO $ threadDelaySeconds $ Seconds oneHour+	liftIO $ threadDelaySeconds $ SecondsDelay oneHour 	hourlyCheck  {- This thread wakes up daily to make sure the tree is in good shape. -}@@ -135,7 +135,7 @@ waitForNextCheck = do 	v <- lastSanityCheck <$> getDaemonStatus 	now <- liftIO getPOSIXTime-	liftIO $ threadDelaySeconds $ Seconds $ calcdelay now v+	liftIO $ threadDelaySeconds $ SecondsDelay $ calcdelay now v   where 	calcdelay _ Nothing = oneDay 	calcdelay now (Just lastcheck)

@@ -45,7 +45,7 @@   where 	go scanned = do 		scanrunning False-		liftIO $ threadDelaySeconds (Seconds 2)+		liftIO $ threadDelaySeconds (SecondsDelay 2) 		(rs, infos) <- unzip <$> getScanRemote 		scanrunning True 		if any fullScan infos || any (`S.notMember` scanned) rs

@@ -80,7 +80,7 @@ 	-- place.) Not needed when using a distribution bundle, because 	-- in that case git-annex handles the upgrade in a non-racy way. 	liftIO $ unlessM usingDistribution $-		threadDelaySeconds (Seconds 120)+		threadDelaySeconds (SecondsDelay 120) 	ifM autoUpgradeEnabled 		( do 			debug ["starting automatic upgrade"]

@@ -125,7 +125,7 @@ 			_ -> noop 		_ -> noop   where-	pause = runEvery (Seconds 86400) noop+	pause = runEvery (SecondsDelay 86400) noop  {- Initial scartup scan. The action should return once the scan is complete. -} startupScan :: IO a -> Assistant a

@@ -96,7 +96,7 @@ 			Annex.getRead Annex.signalactions 		withTransferrer' True signalactonsvar mkcheck rt p run 	pause = catchPauseResume $-		runEvery (Seconds 86400) noop+		runEvery (SecondsDelay 86400) noop 	{- Note: This must use E.try, rather than E.catch. 	 - When E.catch is used, and has called go in its exception 	 - handler, Control.Concurrent.throwTo will block sometimes

@@ -311,7 +311,7 @@ 		-- upgrades, manual upgrades, etc. 		program <- programPath 		untilM (doesFileExist program <&&> nowriter program) $-			threadDelaySeconds (Seconds 60)+			threadDelaySeconds (SecondsDelay 60) 		boolSystem (fromOsPath program) [Param "version"] 	)   where

@@ -365,7 +365,7 @@ 	ExistingSshKey -> liftIO $ go [passwordprompts 0] Nothing 	CachedPassword -> setupAskPass 	Password -> do-		cacheCred (login, geti inputPassword) (Seconds $ 60 * 10)+		cacheCred (login, geti inputPassword) (SecondsDelay $ 60 * 10) 		setupAskPass   where 	login = getLogin sshinput

@@ -161,7 +161,7 @@ 	hPutStrLn (externalSend p) line 	hFlush (externalSend p)   where-	line = unwords $ Proto.formatMessage m+	line = Proto.genMessage m  {- A response handler can yield a result, or it can request that another  - message be consumed from the external. -}@@ -347,8 +347,10 @@ 	deserialize = ProtocolVersion <$$> readish  instance Proto.Sendable ExceptionalMessage where-	formatMessage (ERROR err) = ["ERROR", Proto.serialize err]-	formatMessage (DEBUG msg) = ["DEBUG", Proto.serialize msg]+	formatMessage (ERROR err) = Proto.mkMessage+		["ERROR", Proto.serialize err]+	formatMessage (DEBUG msg) = Proto.mkMessage+		["DEBUG", Proto.serialize msg]  instance Proto.Receivable ExceptionalMessage where 	parseCommand "ERROR" = Proto.parse1 ERROR@@ -356,12 +358,14 @@ 	parseCommand _ = Proto.parseFail  instance Proto.Sendable Request where-	formatMessage GETVERSION = ["GETVERSION"]-	formatMessage CANVERIFY = ["CANVERIFY"]-	formatMessage ISSTABLE = ["ISSTABLE"]-	formatMessage ISCRYPTOGRAPHICALLYSECURE = ["ISCRYPTOGRAPHICALLYSECURE"]-	formatMessage (GENKEY file) = ["GENKEY", Proto.serialize file]-	formatMessage (VERIFYKEYCONTENT key file) =+	formatMessage GETVERSION = Proto.mkMessage ["GETVERSION"]+	formatMessage CANVERIFY = Proto.mkMessage ["CANVERIFY"]+	formatMessage ISSTABLE = Proto.mkMessage ["ISSTABLE"]+	formatMessage ISCRYPTOGRAPHICALLYSECURE = Proto.mkMessage+		["ISCRYPTOGRAPHICALLYSECURE"]+	formatMessage (GENKEY file) = Proto.mkMessage+		["GENKEY", Proto.serialize file]+	formatMessage (VERIFYKEYCONTENT key file) = Proto.mkMessage 		["VERIFYKEYCONTENT", Proto.serialize key, Proto.serialize file]  instance Proto.Receivable Response where

@@ -80,6 +80,9 @@ #else #warning Building without XXH3 support. #endif+#ifdef WITH_NOLLMDEPENDENCIES+	, "NoLLMDependencies"+#endif 	]  -- Not a complete list, let alone a listing transitive deps, but only

@@ -1,3 +1,25 @@+git-annex (10.20260717) upstream; urgency=medium++  * External special remote protocol extended to support import.+    Developers of external special remotes should consider if import makes+    sense for them and add support.+  * Support importtree=yes with rsync special remotes.+  * Added git-annex-remote-internetarchive special remote that imports an+    Internet Archive item and serves as an example for how to easily write+    importtree=yes external special remotes.+    https://git-annex.branchable.com/tips/how_to_make_a_simple_importtree_special_remote/+  * Added DOWNLOAD-URL extension to the external special remote protocol.+  * git-annex is guaranteed to not contain LLM generated code,+    and will attempt to remain buildable with versions of dependencies+    that predate the addition of any LLM generated code.+    See https://git-annex.branchable.com/no_llm_code/+  * git-annex.cabal: Added NoLLMDependencies build flag.+  * Added stack-NoLLMDependencies.yaml+  * Avoid redundant hash verification after a hash verification fails.+  * Fix build with time-1.15.++ -- Joey Hess <id@joeyh.name>  Mon, 20 Jul 2026 13:04:47 -0400+ git-annex (10.20260624) upstream; urgency=medium    * Added Botan build flag, which speeds up checksumming significantly

@@ -114,7 +114,7 @@ 		liftIO (tryNonAsync $ connectPeer Nothing addr) >>= \case 			Left e -> do 				warning $ UnquotedString $ "Unable to connect to hidden service. It may not yet have propagated to the Tor network. (" ++ show e ++ ") Will retry.."-				liftIO $ threadDelaySeconds (Seconds 2)+				liftIO $ threadDelaySeconds (SecondsDelay 2) 				check (n-1) addrs 			Right conn -> do 				liftIO $ closeConnection conn

@@ -74,32 +74,32 @@ {- Delay for either a fraction of a second, or a few seconds, or up  - to 1 minute.  -- - The MinutesDelay is used as an opportunity to do housekeeping tasks.+ - The RandomMinutesDelay is used as an opportunity to do housekeeping tasks.  -}-randomDelay :: Delay -> Annex ()-randomDelay TinyDelay = liftIO $+randomDelay :: RandomDelay -> Annex ()+randomDelay RandomTinyDelay = liftIO $ 	threadDelay =<< getStdRandom (randomR (10000, 1000000))-randomDelay SecondsDelay = liftIO $ -	threadDelaySeconds =<< Seconds <$> getStdRandom (randomR (1, 10))-randomDelay MinutesDelay = do-	liftIO $ threadDelaySeconds =<< Seconds <$> getStdRandom (randomR (1, 60))+randomDelay RandomSecondsDelay = liftIO $ +	threadDelaySeconds =<< SecondsDelay <$> getStdRandom (randomR (1, 10))+randomDelay RandomMinutesDelay = do+	liftIO $ threadDelaySeconds =<< SecondsDelay <$> getStdRandom (randomR (1, 60)) 	reserve <- annexDiskReserve <$> Annex.getGitConfig 	free <- liftIO $ getDiskFree "." 	case free of 		Just have | have < reserve -> do 			warning "Low disk space; fuzz test paused."-			liftIO $ threadDelaySeconds (Seconds 60)-			randomDelay MinutesDelay+			liftIO $ threadDelaySeconds (SecondsDelay 60)+			randomDelay RandomMinutesDelay 		_  -> noop -data Delay-	= TinyDelay-	| SecondsDelay-	| MinutesDelay+data RandomDelay+	= RandomTinyDelay+	| RandomSecondsDelay+	| RandomMinutesDelay 	deriving (Read, Show, Eq) -instance Arbitrary Delay where-	arbitrary = elements [TinyDelay, SecondsDelay, MinutesDelay]+instance Arbitrary RandomDelay where+	arbitrary = elements [RandomTinyDelay, RandomSecondsDelay, RandomMinutesDelay]  data FuzzFile = FuzzFile FilePath 	deriving (Read, Show, Eq)@@ -161,7 +161,7 @@ 	| FuzzMove FuzzFile FuzzFile 	| FuzzDeleteDir FuzzDir 	| FuzzMoveDir FuzzDir FuzzDir-	| FuzzPause Delay+	| FuzzPause RandomDelay 	deriving (Read, Show, Eq)  instance Arbitrary FuzzAction where

@@ -141,7 +141,7 @@ 		`withPathContents` importFiles o seek o@(RemoteImportOptions {}) = startConcurrency commandStages $ do 	r <- getParsed (importFromRemote o)-	unlessM (Remote.isImportSupported r) $+	unlessM (Remote.isExportImportSupported r <||> Remote.isImportSupported r) $ 		giveup "That remote does not support imports." 	subdir <- maybe 		(pure Nothing)

@@ -40,5 +40,5 @@  send :: Notification -> IO () send n = do-	putStrLn $ unwords $ formatMessage n+	putStrLn $ genMessage n 	hFlush stdout

@@ -286,7 +286,7 @@   where 	go 0 [] _ _ = return $ LinkFailed $ "Unable to connect to " ++ remotename ++ "." 	go n [] theirauthtoken ourauthtoken = do-		liftIO $ threadDelaySeconds (Seconds 2)+		liftIO $ threadDelaySeconds (SecondsDelay 2) 		liftIO $ putStrLn $ "Unable to connect to " ++ remotename ++ ". Retrying..." 		go (n-1) theiraddrs theirauthtoken ourauthtoken 	go n (theiraddr:rest) theirauthtoken ourauthtoken = do

@@ -117,7 +117,7 @@  sendTransferResponse :: Handle -> TransferResponse -> IO () sendTransferResponse h r = silenceIOErrors $ do-	hPutStrLn h $ unwords $ Proto.formatMessage r+	hPutStrLn h $ Proto.genMessage r 	hFlush h  getNextLine :: Handle -> IO String

@@ -1,6 +1,6 @@ {- git-annex progress output  -- - Copyright 2010-2021 Joey Hess <id@joeyh.name>+ - Copyright 2010-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -51,6 +51,11 @@ instance MeterSize KeySource where 	getMeterSize = maybe (pure Nothing) getMeterSize . inodeCache +data UnknownSize = UnknownSize++instance MeterSize UnknownSize where+	getMeterSize UnknownSize = pure Nothing+ {- When the key's size is not known, the file is statted to get the size.  - This allows uploads of keys without size to still have progress  - displayed.@@ -171,9 +176,14 @@ 	minratelimit = min consoleratelimit jsonratelimit 		 {- Poll file size to display meter. -}-meteredFile :: OsPath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a-meteredFile file combinemeterupdate key a = -	metered combinemeterupdate key Nothing $ \_ p ->+meteredFile+	:: MeterSize sizer+	=> OsPath+	-> Maybe MeterUpdate+	-> sizer+	-> (MeterUpdate -> Annex a) -> Annex a+meteredFile file combinemeterupdate sizer a = +	metered combinemeterupdate sizer Nothing $ \_ p -> 		watchFileSize file p a  {- Progress dots. -}

@@ -582,7 +582,7 @@ 	lv <- newEmptyTMVarIO 	timeoutdisablev <- newEmptyTMVarIO 	timeouttid <- async $ whenM (atomically $ readTMVar lv) $ do-		threadDelaySeconds $ Seconds $ fromIntegral $+		threadDelaySeconds $ SecondsDelay $ fromIntegral $ 			durationSeconds p2pDefaultLockContentRetentionDuration 		atomically (tryReadTMVar timeoutdisablev) >>= \case 			Nothing -> void $ atomically $@@ -870,7 +870,7 @@ 		-- Wait until a change has completed and it's idle. 		atomically (waitidleorend idlev) >>= \case 			Right () -> do-				threadDelaySeconds (Seconds 1)+				threadDelaySeconds (SecondsDelay 1) 				-- Once it's been idle for a second, 				-- commit the journalled changes. 				atomically (tryTakeTMVar idlev) >>= \case

@@ -240,7 +240,7 @@ 			debugMessage conn "P2P >" m 			case connOhdl conn of 				P2PHandle h -> tryNonAsync $ do-					hPutStrLn h $ unwords (formatMessage m)+					hPutStrLn h $ genMessage m 					hFlush h 				P2PHandleTMVar mv _ closedv -> tryNonAsync $ 					atomically $ putTMVar mv (Right m)@@ -345,7 +345,7 @@ 	debug "P2P.IO" $ concat $ catMaybes $ 		[ (\ident -> "[" ++ ident ++ "] ") <$> mident 		, Just $ "[" ++ show tid ++ "] "-		, Just $ prefix ++ " " ++ unwords (formatMessage safem)+		, Just $ prefix ++ " " ++ genMessage safem 		]   where 	safem = case m of

@@ -2,7 +2,7 @@  -  - See doc/design/p2p_protocol.mdwn  -- - Copyright 2016-2024 Joey Hess <id@joeyh.name>+ - Copyright 2016-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -119,36 +119,57 @@ 	deriving (Show)  instance Proto.Sendable Message where-	formatMessage (AUTH uuid authtoken) = ["AUTH", Proto.serialize uuid, Proto.serialize authtoken]-	formatMessage (AUTH_SUCCESS uuid) = ["AUTH-SUCCESS",  Proto.serialize uuid]-	formatMessage AUTH_FAILURE = ["AUTH-FAILURE"]-	formatMessage (VERSION v) = ["VERSION", Proto.serialize v]-	formatMessage (CONNECT service) = ["CONNECT", Proto.serialize service]-	formatMessage (CONNECTDONE exitcode) = ["CONNECTDONE", Proto.serialize exitcode]-	formatMessage NOTIFYCHANGE = ["NOTIFYCHANGE"]-	formatMessage (CHANGED refs) = ["CHANGED", Proto.serialize refs]-	formatMessage (CHECKPRESENT key) = ["CHECKPRESENT", Proto.serialize key]-	formatMessage (LOCKCONTENT key) = ["LOCKCONTENT", Proto.serialize key]-	formatMessage UNLOCKCONTENT = ["UNLOCKCONTENT"]-	formatMessage (REMOVE key) = ["REMOVE", Proto.serialize key]-	formatMessage (REMOVE_BEFORE ts key) = ["REMOVE-BEFORE", Proto.serialize ts, Proto.serialize key]-	formatMessage GETTIMESTAMP = ["GETTIMESTAMP"]-	formatMessage (GET offset af key) = ["GET", Proto.serialize offset, Proto.serialize af, Proto.serialize key]-	formatMessage (PUT af key) = ["PUT", Proto.serialize af, Proto.serialize key]-	formatMessage (PUT_FROM offset) = ["PUT-FROM", Proto.serialize offset]-	formatMessage ALREADY_HAVE = ["ALREADY-HAVE"]-	formatMessage (ALREADY_HAVE_PLUS uuids) = ("ALREADY-HAVE-PLUS":map Proto.serialize uuids)-	formatMessage SUCCESS = ["SUCCESS"]-	formatMessage (SUCCESS_PLUS uuids) = ("SUCCESS-PLUS":map Proto.serialize uuids)-	formatMessage FAILURE = ["FAILURE"]-	formatMessage (FAILURE_PLUS uuids) = ("FAILURE-PLUS":map Proto.serialize uuids)-	formatMessage (BYPASS (Bypass uuids)) = ("BYPASS":map Proto.serialize (S.toList uuids))-	formatMessage (DATA len) = ["DATA", Proto.serialize len]-	formatMessage DATA_PRESENT = ["DATA-PRESENT"]-	formatMessage (VALIDITY Valid) = ["VALID"]-	formatMessage (VALIDITY Invalid) = ["INVALID"]-	formatMessage (TIMESTAMP ts) = ["TIMESTAMP", Proto.serialize ts]-	formatMessage (ERROR err) = ["ERROR", Proto.serialize err]+	formatMessage (AUTH uuid authtoken) = Proto.mkMessage+		["AUTH", Proto.serialize uuid, Proto.serialize authtoken]+	formatMessage (AUTH_SUCCESS uuid) = Proto.mkMessage+		["AUTH-SUCCESS",  Proto.serialize uuid]+	formatMessage AUTH_FAILURE = Proto.mkMessage ["AUTH-FAILURE"]+	formatMessage (VERSION v) = Proto.mkMessage+		["VERSION", Proto.serialize v]+	formatMessage (CONNECT service) = Proto.mkMessage+		["CONNECT", Proto.serialize service]+	formatMessage (CONNECTDONE exitcode) = Proto.mkMessage+		["CONNECTDONE", Proto.serialize exitcode]+	formatMessage NOTIFYCHANGE = Proto.mkMessage ["NOTIFYCHANGE"]+	formatMessage (CHANGED refs) = Proto.mkMessage+		["CHANGED", Proto.serialize refs]+	formatMessage (CHECKPRESENT key) = Proto.mkMessage+		["CHECKPRESENT", Proto.serialize key]+	formatMessage (LOCKCONTENT key) = Proto.mkMessage+		["LOCKCONTENT", Proto.serialize key]+	formatMessage UNLOCKCONTENT = Proto.mkMessage ["UNLOCKCONTENT"]+	formatMessage (REMOVE key) = Proto.mkMessage+		["REMOVE", Proto.serialize key]+	formatMessage (REMOVE_BEFORE ts key) = Proto.mkMessage+		["REMOVE-BEFORE", Proto.serialize ts, Proto.serialize key]+	formatMessage GETTIMESTAMP = Proto.mkMessage ["GETTIMESTAMP"]+	formatMessage (GET offset af key) = Proto.mkMessage+		["GET", Proto.serialize offset, Proto.serialize af, Proto.serialize key]+	formatMessage (PUT af key) = Proto.mkMessage+		["PUT", Proto.serialize af, Proto.serialize key]+	formatMessage (PUT_FROM offset) = Proto.mkMessage+		["PUT-FROM", Proto.serialize offset]+	formatMessage ALREADY_HAVE = Proto.mkMessage ["ALREADY-HAVE"]+	formatMessage (ALREADY_HAVE_PLUS uuids) = Proto.mkMessage+		("ALREADY-HAVE-PLUS":map Proto.serialize uuids)+	formatMessage SUCCESS = Proto.mkMessage ["SUCCESS"]+	formatMessage (SUCCESS_PLUS uuids) =+		Proto.mkMessage ("SUCCESS-PLUS":map Proto.serialize uuids)+	formatMessage FAILURE = Proto.mkMessage ["FAILURE"]+	formatMessage (FAILURE_PLUS uuids) = Proto.mkMessage+		("FAILURE-PLUS":map Proto.serialize uuids)+	formatMessage (BYPASS (Bypass uuids)) = Proto.mkMessage+		("BYPASS":map Proto.serialize (S.toList uuids))+	formatMessage (DATA len) = Proto.mkMessage+		["DATA", Proto.serialize len]+	formatMessage DATA_PRESENT = Proto.mkMessage+		["DATA-PRESENT"]+	formatMessage (VALIDITY Valid) = Proto.mkMessage ["VALID"]+	formatMessage (VALIDITY Invalid) = Proto.mkMessage ["INVALID"]+	formatMessage (TIMESTAMP ts) =+		Proto.mkMessage ["TIMESTAMP", Proto.serialize ts]+	formatMessage (ERROR err) = Proto.mkMessage+		["ERROR", Proto.serialize err]  instance Proto.Receivable Message where 	parseCommand "AUTH" = Proto.parse2 AUTH

@@ -54,7 +54,8 @@ 		] 	, setup = adbSetup 	, exportSupported = exportIsSupported-	, importSupported = importIsSupported+	, importSupported = importUnsupported+	, exportImportSupported = exportImportIsSupported 	, thirdPartyPopulated = False 	} @@ -97,8 +98,9 @@ 			, removeExportDirectory = Just $ removeExportDirectoryM serial adir 			, renameExport = Just $ renameExportM serial adir 			}-		, importActions = ImportActions-			{ listImportableContents = listImportableContentsM serial adir c+		, importActions = importUnsupported+		, exportImportActions = ExportImportActions+			{ listImportableOrExportedContents = listImportableOrExportedContentsM serial adir c 			, importKey = Nothing 			, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM serial adir 			, storeExportWithContentIdentifier = storeExportWithContentIdentifierM serial adir@@ -297,8 +299,8 @@ 		, File newloc 		] -listImportableContentsM :: AndroidSerial -> AndroidPath -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))-listImportableContentsM serial adir c = adbfind >>= \case+listImportableOrExportedContentsM :: AndroidSerial -> AndroidPath -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableOrExportedContentsM serial adir c = adbfind >>= \case 	Just ls -> return $ Just $ ImportableContentsComplete $  		ImportableContents (mapMaybe mk ls) [] 	Nothing -> giveup "adb find failed"

@@ -48,6 +48,7 @@ 	, setup = giveup "not supported" 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -79,6 +80,7 @@ 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -59,7 +59,8 @@ 		] 	, setup = borgSetup 	, exportSupported = exportUnsupported-	, importSupported = importIsSupported+	, importSupported = importUnsupported+	, exportImportSupported = exportImportIsSupported 	, thirdPartyPopulated = True 	} @@ -94,16 +95,17 @@ 		, checkPresent = checkPresentDummy 		, checkPresentCheap = borgLocal borgrepo 		, exportActions = exportUnsupported-		, importActions = ImportActions-			{ listImportableContents = listImportableContentsM u borgrepo c+		, importActions = importUnsupported+		, exportImportActions = ExportImportActions+			{ listImportableOrExportedContents = listImportableOrExportedContentsM u borgrepo c 			, importKey = Just ThirdPartyPopulated.importKey 			, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM borgrepo 			, checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierM borgrepo 			-- This remote is thirdPartyPopulated, so these 			-- actions will never be used.-			, storeExportWithContentIdentifier = storeExportWithContentIdentifier importUnsupported-			, removeExportDirectoryWhenEmpty = removeExportDirectoryWhenEmpty importUnsupported-			, removeExportWithContentIdentifier = removeExportWithContentIdentifier importUnsupported+			, storeExportWithContentIdentifier = storeExportWithContentIdentifier exportImportUnsupported+			, removeExportDirectoryWhenEmpty = removeExportDirectoryWhenEmpty exportImportUnsupported+			, removeExportWithContentIdentifier = removeExportWithContentIdentifier exportImportUnsupported 			} 		, whereisKey = Nothing 		, remoteFsck = Nothing@@ -168,8 +170,8 @@ checkAvailability borgrepo@(BorgRepo r) =  	checkPathAvailability (borgLocal borgrepo) (toOsPath r) -listImportableContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))-listImportableContentsM u borgrepo c = prompt $ do+listImportableOrExportedContentsM :: UUID -> BorgRepo -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableOrExportedContentsM u borgrepo c = prompt $ do 	imported <- getImported u 	ls <- withborglist (locBorgRepo borgrepo) Nothing formatarchivelist $ \as -> 		forM (filter (not . S.null) as) $ \archivename ->

@@ -55,6 +55,7 @@ 	, setup = bupSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -88,6 +89,7 @@ 		, checkPresentCheap = bupLocal buprepo 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -86,6 +86,7 @@ 	, setup = setupInstance 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -120,6 +121,7 @@ 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -49,6 +49,7 @@ 	, setup = ddarSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -90,6 +91,7 @@ 		, checkPresentCheap = ddarLocal ddarrepo 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -68,7 +68,8 @@ 		] 	, setup = directorySetup 	, exportSupported = exportIsSupported-	, importSupported = importIsSupported+	, importSupported = importUnsupported+	, exportImportSupported = exportImportIsSupported 	, thirdPartyPopulated = False 	} @@ -115,8 +116,9 @@ 				, removeExportDirectory = Nothing 				, renameExport = Just $ renameExportM dir 				}-			, importActions = ImportActions-				{ listImportableContents = listImportableContentsM ii dir+			, importActions = importUnsupported+			, exportImportActions = ExportImportActions+				{ listImportableOrExportedContents = listImportableOrExportedContentsM ii dir 				, importKey = Just (importKeyM ii dir) 				, retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierM ii dir cow 				, storeExportWithContentIdentifier = storeExportWithContentIdentifierM ii dir cow fastcopy@@ -383,8 +385,8 @@ 		let p = exportPath topdir $ mkExportLocation loc' 		in go (upFrom loc') =<< tryIO (removeDirectory p) -listImportableContentsM :: IgnoreInodes -> OsPath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))-listImportableContentsM ii dir = liftIO $ do+listImportableOrExportedContentsM :: IgnoreInodes -> OsPath -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableOrExportedContentsM ii dir = liftIO $ do 	l' <- mapM go =<< dirContentsRecursiveSkipping (const False) False dir 	return $ Just $ ImportableContentsComplete $ 		ImportableContents (catMaybes l') []

@@ -18,6 +18,7 @@ import qualified Annex.ExternalAddonProcess as AddonProcess import Types.Remote import Types.RemoteState+import Types.Import import Types.Export import Types.CleanupActions import Types.UrlContents@@ -33,6 +34,7 @@ import Remote.Helper.ReadOnly import Utility.Metered import Utility.Hash+import Utility.Tmp import Types.Transfer import Logs.PreferredContent.Raw import Logs.RemoteState@@ -47,6 +49,7 @@ import Annex.DisableRemote import Annex.LockFile import Creds+import Messages.Progress import qualified Utility.FileIO as F  import Control.Concurrent.STM@@ -60,8 +63,9 @@ 	, generate = gen remote Nothing 	, configParser = remoteConfigParser Nothing 	, setup = externalSetup Nothing Nothing-	, exportSupported = checkExportSupported Nothing-	, importSupported = importUnsupported+	, exportSupported = checkSupportedWith Nothing checkExportSupported+	, importSupported = checkSupportedWith Nothing checkImportSupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -71,7 +75,15 @@ readonlyField :: RemoteConfigField readonlyField = Accepted "readonly" -gen :: RemoteType -> Maybe ExternalProgram -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+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 	| externalprogram' == ExternalType "readonly" = do@@ -83,7 +95,9 @@ 			Nothing 			Nothing 			exportUnsupported+			importUnsupported 			exportUnsupported+			importUnsupported 		return $ Just $ specialRemote c 			readonlyStorer 			(retrieveUrl gc)@@ -97,8 +111,11 @@ 		Annex.addCleanupAction (RemoteCleanup u) $ stopExternal external 		cst <- getCost external r gc c 		exportsupported <- if exportTree c-			then checkExportSupported' external+			then isExportSupported' <$> checkExportSupported (Just external) 			else return False+		importsupported <- if importTree c+			then isImportSupported' <$> checkImportSupported (Just external)+			else return False 		let exportactions = if exportsupported 			then ExportActions 				{ storeExport = storeExportM external@@ -109,11 +126,21 @@ 				, renameExport = Just $ renameExportM external 				} 			else exportUnsupported-		-- Cheap exportSupported that replaces the expensive-		-- checkExportSupported now that we've already checked it.+		let importactions = if importsupported+			then ImportActions+				{ listImportableContents = listImportableContentsM external+				, retrieveImport = retrieveImportM external gc+				, checkPresentImport = checkPresentImportM external gc+				}+			else importUnsupported+		-- Replace the expensive checks now that we've already+		-- checked them. 		let cheapexportsupported = if exportsupported 			then exportIsSupported 			else exportUnsupported+		let cheapimportsupported = if importsupported+			then importIsSupported+			else importUnsupported 		let rmt = mk c cst 			(getOrdered external) 			(getAvailability external)@@ -122,7 +149,9 @@ 			(Just (claimUrlM external)) 			(Just (checkUrlM external)) 			exportactions+			importactions 			cheapexportsupported+			cheapimportsupported 		return $ Just $ specialRemote c 			(storeKeyM external) 			(retrieveKeyFileM external gc)@@ -130,7 +159,7 @@ 			(checkPresentM external gc) 			rmt   where-	mk c cst ordered avail towhereis togetinfo toclaimurl tocheckurl exportactions cheapexportsupported =+	mk c cst ordered avail towhereis togetinfo toclaimurl tocheckurl exportactions importactions cheapexportsupported cheapimportsupported = 		Remote 			{ uuid = u 			, cost = cst@@ -149,7 +178,8 @@ 			, checkPresent = checkPresentDummy 			, checkPresentCheap = False 			, exportActions = exportactions-			, importActions = importUnsupported+			, importActions = importactions+			, exportImportActions = exportImportUnsupported 			, whereisKey = towhereis 			, remoteFsck = Nothing 			, repairKey = Nothing@@ -163,7 +193,9 @@ 			, untrustworthy = False 			, availability = avail 			, remotetype = rt -				{ exportSupported = cheapexportsupported }+				{ exportSupported = cheapexportsupported+				, importSupported = cheapimportsupported+				} 			, mkUnavailable = 				let dneprogram = case externalprogram of 					Just (ExternalCommand _ _) -> Just (ExternalType "!dne!")@@ -181,7 +213,16 @@ 			fromMaybe (giveup "missing externaltype") 				(remoteAnnexExternalType gc) -externalSetup :: Maybe ExternalProgram -> Maybe (String, String) -> SetupStage -> Maybe UUID -> RemoteName -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)+externalSetup+	:: Maybe ExternalProgram+	-> Maybe (String, String)+	-> SetupStage+	-> Maybe UUID+	-> RemoteName+	-> Maybe CredPair+	-> RemoteConfig+	-> RemoteGitConfig+	-> Annex (RemoteConfig, UUID) externalSetup externalprogram setgitconfig ss mu remotename _ c gc = do 	u <- maybe (liftIO genUUID) return mu 	pc <- either giveup return $ parseRemoteConfig c (lenientRemoteConfigParser externalprogram)@@ -225,26 +266,45 @@ 		[ fromMaybe ("externaltype", externaltype) setgitconfig ] 	return (M.delete readonlyField c'', u) -checkExportSupported :: Maybe ExternalProgram -> ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool-checkExportSupported Nothing c gc = do+checkSupportedWith+	:: Maybe ExternalProgram+	-> (Maybe External -> Annex a)+	-> ParsedRemoteConfig+	-> RemoteGitConfig+	-> Annex a+checkSupportedWith Nothing checker c gc = do 	let externaltype = fromMaybe (giveup "Specify externaltype=") $ 		remoteAnnexExternalType gc <|> getRemoteConfigValue externaltypeField c 	if externaltype == "readonly"-		then return False-		else checkExportSupported (Just (ExternalType externaltype)) c gc-checkExportSupported (Just externalprogram) c gc = -	checkExportSupported' +		then checker Nothing+		else checkSupportedWith (Just (ExternalType externaltype)) checker c gc+checkSupportedWith (Just externalprogram) checker c gc = +	checker . Just 		=<< newExternal externalprogram Nothing c (Just gc) Nothing Nothing -checkExportSupported' :: External -> Annex Bool-checkExportSupported' external = go `catchNonAsync` (const (return False))+checkExportSupported :: Maybe External -> Annex ExportSupported+checkExportSupported (Just external) = go+	`catchNonAsync` (const (return (ExportSupported False)))   where 	go = handleRequest external EXPORTSUPPORTED Nothing $ \resp -> case resp of-		EXPORTSUPPORTED_SUCCESS -> result True-		EXPORTSUPPORTED_FAILURE -> result False-		UNSUPPORTED_REQUEST -> result False+		EXPORTSUPPORTED_SUCCESS -> result (ExportSupported True)+		EXPORTSUPPORTED_FAILURE -> result (ExportSupported False)+		UNSUPPORTED_REQUEST -> result (ExportSupported False) 		_ -> Nothing+checkExportSupported Nothing = return (ExportSupported False) +checkImportSupported :: Maybe External -> Annex ImportSupported+checkImportSupported (Just external) = go+	`catchNonAsync` (const (return (ImportSupported False)))+  where+	go = handleRequest external IMPORTSUPPORTED Nothing $ \resp -> case resp of+		IMPORTSUPPORTED_SUCCESS -> result (ImportSupported True)+		IMPORTSUPPORTED_FAILURE -> result (ImportSupported False)+		IMPORTREQUIRED -> result ImportRequired+		UNSUPPORTED_REQUEST -> result (ImportSupported False)+		_ -> Nothing+checkImportSupported Nothing = return (ImportSupported False)+ storeKeyM :: External -> Storer storeKeyM external = fileStorer $ \k f p -> 	either giveup return =<< go k f p@@ -256,10 +316,10 @@ 				result (Right ()) 			TRANSFER_FAILURE Upload k' errmsg | k == k' -> 				result (Left (respErrorMessage "TRANSFER" errmsg))-			DELEGATE ps -> Just $ do+			DELEGATE ps -> getResult $ do 				delegate <- getDelegateRemote external ps 				storeKey delegate k (AssociatedFile Nothing) (Just f) p	-				return (Result (Right ()))+				return (Right ()) 			_ -> Nothing  retrieveKeyFileM :: External -> RemoteGitConfig -> Retriever@@ -274,13 +334,13 @@ 				| k == k' -> result $ Left $ 					respErrorMessage "TRANSFER" errmsg 			TRANSFER_RETRIEVE_URL k' url-				| k == k' -> retrieveUrl' gc url dest k p-			DELEGATE ps -> Just $ do+				| k == k' -> getResult $ retrieveUrl' gc url dest k p+			DELEGATE ps -> getResult $ do 				delegate <- getDelegateRemote external ps 				_ <- retrieveKeyFile delegate k 					(AssociatedFile Nothing) dest p 					NoVerify-				return (Result (Right ()))+				return (Right ()) 			_ -> Nothing  removeKeyM :: External -> Remover@@ -293,10 +353,10 @@ 			REMOVE_FAILURE k' errmsg 				| k == k' -> result $ Left $ 					respErrorMessage "REMOVE" errmsg-			DELEGATE ps -> Just $ do+			DELEGATE ps -> getResult $ do 				delegate <- getDelegateRemote external ps 				_ <- removeKey delegate proof k-				return (Result (Right ()))+				return (Right ()) 			_ -> Nothing  checkPresentM :: External -> RemoteGitConfig -> CheckPresent@@ -330,23 +390,36 @@ 	UNSUPPORTED_REQUEST -> result [] 	_ -> Nothing -storeExportM :: External -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+storeExportM+	:: External+	-> OsPath+	-> Key+	-> ExportLocation+	-> MeterUpdate+	-> Annex () storeExportM external f k loc p = either giveup return =<< go   where 	go = handleRequestExport external loc req k (Just p) $ \resp -> case resp of 		TRANSFER_SUCCESS Upload k' | k == k' -> result $ Right () 		TRANSFER_FAILURE Upload k' errmsg | k == k' -> 			result $ Left $ respErrorMessage "TRANSFER" errmsg-		DELEGATE ps -> Just $ do+		DELEGATE ps -> getResult $ do 			delegate <- getDelegateRemote external ps 			_ <- storeExport (exportActions delegate) f k loc p-			return (Result (Right ()))+			return (Right ()) 		UNSUPPORTED_REQUEST ->  			result $ Left "TRANSFEREXPORT not implemented by external special remote" 		_ -> Nothing 	req sk = TRANSFEREXPORT Upload sk (fromOsPath f) -retrieveExportM :: External -> RemoteGitConfig -> Key -> ExportLocation -> OsPath -> MeterUpdate -> Annex Verification+retrieveExportM+	:: External+	-> RemoteGitConfig+	-> Key+	-> ExportLocation+	-> OsPath+	-> MeterUpdate+	-> Annex Verification retrieveExportM external gc k loc dest p = do 	verifyKeyContentIncrementally AlwaysVerify k $ \iv -> 		tailVerify iv dest $@@ -358,34 +431,102 @@ 		TRANSFER_FAILURE Download k' errmsg 			| k == k' -> result $ Left $ respErrorMessage "TRANSFER" errmsg 		TRANSFER_RETRIEVE_URL k' url-			| k == k' -> retrieveUrl' gc url dest k p-		DELEGATE ps -> Just $ do+			| k == k' -> Just $ Result <$> retrieveUrl' gc url dest k p+		DELEGATE ps -> getResult $ do 			delegate <- getDelegateRemote external ps 			_ <- retrieveExport (exportActions delegate) k loc dest p-			return (Result (Right ()))+			return (Right ()) 		UNSUPPORTED_REQUEST -> 			result $ Left "TRANSFEREXPORT not implemented by external special remote" 		_ -> Nothing 	req sk = TRANSFEREXPORT Download sk (fromOsPath dest) -checkPresentExportM :: External -> RemoteGitConfig -> Key -> ExportLocation -> Annex Bool-checkPresentExportM external gc k loc = either giveup id <$> go+retrieveImportM+	:: External+	-> RemoteGitConfig+	-> ImportLocation+	-> [ContentIdentifier]+	-> OsPath+	-> Either Key (Annex Key)+	-> MeterUpdate+	-> Annex (Key, Verification)+retrieveImportM external gc loc cids dest gk p =+	case gk of+		Right _ -> do+			k <- go Nothing+			return (k, UnVerified)+		Left k -> verifyKeyContentIncrementally' AlwaysVerify k go   where-	go = handleRequestExport external loc CHECKPRESENTEXPORT k Nothing $ \resp -> case resp of+	go iv = tailVerify iv dest $+		either giveup return =<< go'+	go' = handleRequestImport' external loc req (Just p) $ \resp -> case resp of+		RETRIEVEIMPORT_SUCCESS -> getResult $+			Right <$> either pure id gk+		RETRIEVEIMPORT_FAILURE errmsg -> +			result $ Left $ respErrorMessage "RETRIEVEIMPORT" errmsg+		RETRIEVEIMPORT_URL url -> getResult $ do+			retrieveUrl' gc url dest UnknownSize p >>= \case+				Right () -> Right <$> either pure id gk+				Left msg -> pure (Left msg)+		DELEGATE ps -> getResult $ do+			delegate <- getDelegateRemote external ps+			Right . fst <$> retrieveImport (importActions delegate) loc cids dest gk p+		UNSUPPORTED_REQUEST ->+			result $ Left "RETRIEVEIMPORT not implemented by external special remote"+		_ -> Nothing+	req = RETRIEVEIMPORT (fromOsPath dest)++checkPresentExportM+	:: External+	-> RemoteGitConfig+	-> Key+	-> ExportLocation+	-> Annex Bool+checkPresentExportM = checkPresentExportImport+	CHECKPRESENTEXPORT+	"CHECKPRESENTEXPORT"+	(checkPresentExport . exportActions)+	handleRequestExport++checkPresentImportM+	:: External+	-> RemoteGitConfig+	-> Key+	-> ExportLocation+	-> Annex Bool+checkPresentImportM = checkPresentExportImport+	CHECKPRESENTIMPORT+	"CHECKPRESENTIMPORT"+	(checkPresentImport . importActions)+	handleRequestImport++checkPresentExportImport+	:: (SafeKey -> Request)+	-> String+	-> (Remote -> Key -> ExportLocation -> Annex Bool)+	-> (External -> ImportLocation -> (SafeKey -> Request) -> Key -> Maybe MeterUpdate -> ResponseHandler (Either String Bool) -> Annex (Either String Bool))+	-> External+	-> RemoteGitConfig+	-> Key+	-> ExportLocation+	-> Annex Bool+checkPresentExportImport request srequest delegateaction handlereq external gc k loc = either giveup id <$> go+  where+	go = handlereq external loc request k Nothing $ \resp -> case resp of 		CHECKPRESENT_SUCCESS k' 			| k' == k -> result $ Right True 		CHECKPRESENT_FAILURE k' 			| k' == k -> result $ Right False 		CHECKPRESENT_UNKNOWN k' errmsg 			| k' == k -> result $ Left $-				respErrorMessage "CHECKPRESENT" errmsg+				respErrorMessage srequest errmsg 		CHECKPRESENT_URL k' url 			| k == k' -> checkKeyUrl' gc k url 		DELEGATE ps -> Just $ do 			delegate <- getDelegateRemote external ps-			Result . Right <$> checkPresentExport (exportActions delegate) k loc+			Result . Right <$> delegateaction delegate k loc 		UNSUPPORTED_REQUEST -> result $-			Left "CHECKPRESENTEXPORT not implemented by external special remote"+			Left $ srequest ++ " not implemented by external special remote" 		_ -> Nothing  removeExportM :: External -> Key -> ExportLocation -> Annex ()@@ -396,10 +537,10 @@ 			| k == k' -> result $ Right () 		REMOVE_FAILURE k' errmsg 			| k == k' -> result $ Left $ respErrorMessage "REMOVE" errmsg-		DELEGATE ps -> Just $ do+		DELEGATE ps -> getResult $ do 			delegate <- getDelegateRemote external ps 			_ <- removeExport (exportActions delegate) k loc-			return (Result (Right ()))+			return (Right ()) 		UNSUPPORTED_REQUEST -> result $ 			Left $ "REMOVEEXPORT not implemented by external special remote" 		_ -> Nothing@@ -411,17 +552,22 @@ 		REMOVEEXPORTDIRECTORY_SUCCESS -> result $ Right () 		REMOVEEXPORTDIRECTORY_FAILURE -> result $ 			Left "failed to remove directory"-		DELEGATE ps -> Just $ do+		DELEGATE ps -> getResult $ do 			delegate <- getDelegateRemote external ps 			case removeExportDirectory (exportActions delegate) of 				Just a -> a dir 				Nothing -> return ()-			return (Result (Right ()))+			return (Right ()) 		UNSUPPORTED_REQUEST -> result $ Right () 		_ -> Nothing 	req = REMOVEEXPORTDIRECTORY dir -renameExportM :: External -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ())+renameExportM+	:: External+	-> Key+	-> ExportLocation+	-> ExportLocation+	-> Annex (Maybe ()) renameExportM external k src dest = either giveup return =<< go   where 	go = handleRequestExport external src req k Nothing $ \resp -> case resp of@@ -429,15 +575,43 @@ 			| k' == k -> result $ Right (Just ()) 		RENAMEEXPORT_FAILURE k'  			| k' == k -> result $ Left "failed to rename exported file"-		DELEGATE ps -> Just $ do+		DELEGATE ps -> getResult $ do 			delegate <- getDelegateRemote external ps 			case renameExport (exportActions delegate) of-				Just a -> Result . Right <$> a k src dest-				Nothing -> return $ Result $ Right Nothing+				Just a -> Right <$> a k src dest+				Nothing -> return $ Right Nothing 		UNSUPPORTED_REQUEST -> result (Right Nothing) 		_ -> Nothing 	req sk = RENAMEEXPORT sk dest +listImportableContentsM+	:: External+	-> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableContentsM external =+	handleRequest external LISTIMPORTABLECONTENTS Nothing+		(go [] Nothing)+  where+	go c _ (IMPORTABLECONTENT sz loc) = +		let loc' = mkImportLocation (toOsPath loc)+		in Just $ return $ GetNextMessage $+			go c (Just (sz, loc'))+	go c (Just (sz, loc)) (IMPORTABLECONTENTIDENTIFIER cid) =+		Just $ return $ GetNextMessage $ +			go ((loc, (cid, sz)):c) Nothing+	go c _ LISTIMPORTABLECONTENTS_SUCCESS =+		result $ Just $+			ImportableContentsComplete $ ImportableContents+				{ importableContents = c+				, importableHistory = []+				}+	go _ _ (LISTIMPORTABLECONTENTS_FAILURE err) =+		giveup err+	go _ _ (DELEGATE ps) = Just $ do+		delegate <- getDelegateRemote external ps+		Result <$> listImportableContents (importActions delegate)+	go _ _ UNSUPPORTED_REQUEST = result Nothing+	go _ _ _ = Nothing+ {- Sends a Request to the external remote, and waits for it to generate  - a Response. That is fed into the responsehandler, which should return  - the action to run for it (or Nothing if there's a protocol error).@@ -451,12 +625,23 @@  - May throw exceptions, for example on protocol errors, or  - when the repository cannot be used.  -}-handleRequest :: External -> Request -> Maybe MeterUpdate -> ResponseHandler a -> Annex a+handleRequest+	:: External+	-> Request+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a handleRequest external req mp responsehandler =  	withExternalState external $ \st ->  		handleRequest' st external req mp responsehandler -handleRequestKey :: External -> (SafeKey -> Request) -> Key -> Maybe MeterUpdate -> ResponseHandler a -> Annex a+handleRequestKey+	:: External+	-> (SafeKey -> Request)+	-> Key+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a handleRequestKey external mkreq k mp responsehandler =  	withSafeKey k $ \sk -> handleRequest external (mkreq sk) mp responsehandler @@ -465,21 +650,72 @@ 	Right sk -> a sk 	Left e -> giveup e -{- Export location is first sent in an EXPORT message before- - the main request. This is done because the ExportLocation can- - contain spaces etc. -}-handleRequestExport :: External -> ExportLocation -> (SafeKey -> Request) -> Key -> Maybe MeterUpdate -> ResponseHandler a -> Annex a-handleRequestExport external loc mkreq k mp responsehandler = +handleRequestExport+	:: External+	-> ExportLocation+	-> (SafeKey -> Request)+	-> Key+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a+handleRequestExport = handleRequestExportImport EXPORT++handleRequestImport+	:: External+	-> ImportLocation+	-> (SafeKey -> Request)+	-> Key+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a+handleRequestImport = handleRequestExportImport IMPORT++handleRequestImport'+	:: External+	-> ImportLocation+	-> Request+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a+handleRequestImport' = handleRequestExportImport' IMPORT++handleRequestExportImport+	:: (ExportLocation -> Request)+	-> External+	-> ImportLocation+	-> (SafeKey -> Request)+	-> Key+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a+handleRequestExportImport mklocrequest external loc mkreq k mp responsehandler =  	withSafeKey k $ \sk ->-		-- Both the EXPORT and subsequent request must be sent to the-		-- same external process, so run both with the same external-		-- state.-		withExternalState external $ \st -> do-			checkPrepared st external-			sendMessage st (EXPORT loc)-			handleRequest' st external (mkreq sk) mp responsehandler+		handleRequestExportImport' mklocrequest external loc (mkreq sk) mp responsehandler -handleRequest' :: ExternalState -> External -> Request -> Maybe MeterUpdate -> ResponseHandler a -> Annex a+handleRequestExportImport'+	:: (ExportLocation -> Request)+	-> External+	-> ImportLocation+	-> Request+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a+handleRequestExportImport' mklocrequest external loc req mp responsehandler = +	-- Both the location request and subsequent request must be+	-- sent to the same external process, so run both with the+	-- same external state.+	withExternalState external $ \st -> do+		checkPrepared st external+		sendMessage st (mklocrequest loc)+		handleRequest' st external req mp responsehandler++handleRequest'+	:: ExternalState+	-> External+	-> Request+	-> Maybe MeterUpdate+	-> ResponseHandler a+	-> Annex a handleRequest' st external req mp responsehandler 	| needsPREPARE req = do 		checkPrepared st external@@ -488,18 +724,24 @@   where 	go = do 		sendMessage st req-		loop-	loop = receiveMessage st external responsehandler-		(\rreq -> Just $ handleRemoteRequest rreq >> loop)-		(\msg -> Just $ handleExceptionalMessage msg >> loop)+		cleanupv <- liftIO $ atomically $ newTMVar []+		loop cleanupv+			`finally` cleanup cleanupv+	+	loop cleanupv = receiveMessage st external responsehandler+		(\rreq -> Just $ handleRemoteRequest cleanupv rreq >> loop cleanupv)+		(\msg -> Just $ handleExceptionalMessage msg >> loop cleanupv) -	handleRemoteRequest (PROGRESS bytesprocessed) =+	cleanup cleanupv = liftIO $+		sequence =<< atomically (takeTMVar cleanupv)++	handleRemoteRequest _ (PROGRESS bytesprocessed) = 		maybe noop (\a -> liftIO $ a bytesprocessed) mp-	handleRemoteRequest (DIRHASH k) = +	handleRemoteRequest _ (DIRHASH k) =  		send $ VALUE $ fromOsPath $ hashDirMixed def k-	handleRemoteRequest (DIRHASH_LOWER k) = +	handleRemoteRequest _ (DIRHASH_LOWER k) =  		send $ VALUE $ fromOsPath $ hashDirLower def k-	handleRemoteRequest (SETCONFIG setting value) =+	handleRemoteRequest _ (SETCONFIG setting value) = 		liftIO $ atomically $ do 			ParsedRemoteConfig m c <- takeTMVar (externalConfig st) 			let !m' = M.insert@@ -514,13 +756,13 @@ 			f <- takeTMVar (externalConfigChanges st) 			let !f' = M.insert (Accepted setting) (Accepted value) . f 			putTMVar (externalConfigChanges st) f'-	handleRemoteRequest (GETCONFIG setting) = do+	handleRemoteRequest _ (GETCONFIG setting) = do 		value <- maybe "" fromProposedAccepted 			. (M.lookup (Accepted setting)) 			. unparsedRemoteConfig 			<$> liftIO (atomically $ readTMVar $ externalConfig st) 		send $ VALUE value-	handleRemoteRequest (SETCREDS setting login password) = case (externalUUID external, externalGitConfig external) of+	handleRemoteRequest _ (SETCREDS setting login password) = case (externalUUID external, externalGitConfig external) of 		(Just u, Just gc) -> do 			pc <- liftIO $ atomically $ takeTMVar (externalConfig st) 			pc' <- setRemoteCredPair' pc encryptionAlreadySetup gc@@ -536,56 +778,78 @@ 				let !f' = M.union configchanges . f 				putTMVar (externalConfigChanges st) f' 		_ -> senderror "cannot send SETCREDS here"-	handleRemoteRequest (GETCREDS setting) = case (externalUUID external, externalGitConfig external) of+	handleRemoteRequest _ (GETCREDS setting) = case (externalUUID external, externalGitConfig external) of 		(Just u, Just gc) -> do 			c <- liftIO $ atomically $ readTMVar $ externalConfig st 			creds <- fromMaybe ("", "") <$>  				getRemoteCredPair c gc (credstorage setting u) 			send $ CREDS (fst creds) (snd creds) 		_ -> senderror "cannot send GETCREDS here"-	handleRemoteRequest GETUUID = case externalUUID external of+	handleRemoteRequest _ GETUUID = case externalUUID external of 		Just u -> send $ VALUE $ fromUUID u 		Nothing -> senderror "cannot send GETUUID here"-	handleRemoteRequest GETGITDIR = +	handleRemoteRequest _ GETGITDIR =  		send . VALUE . fromOsPath =<< fromRepo Git.localGitDir-	handleRemoteRequest GETGITREMOTENAME =+	handleRemoteRequest _ GETGITREMOTENAME = 		case externalRemoteName external of 			Just n -> send $ VALUE n 			Nothing -> senderror "git remote name not known"-	handleRemoteRequest (SETWANTED expr) = case externalUUID external of+	handleRemoteRequest _ (SETWANTED expr) = case externalUUID external of 		Just u -> preferredContentSet u expr 		Nothing -> senderror "cannot send SETWANTED here"-	handleRemoteRequest GETWANTED = case externalUUID external of+	handleRemoteRequest _ GETWANTED = case externalUUID external of 		Just u -> do 			expr <- fromMaybe "" . M.lookup u 				<$> preferredContentMapRaw 			send $ VALUE expr 		Nothing -> senderror "cannot send GETWANTED here"-	handleRemoteRequest (SETSTATE key state) =+	handleRemoteRequest _ (SETSTATE key state) = 		case externalRemoteStateHandle external of 			Just h -> setRemoteState h key state 			Nothing -> senderror "cannot send SETSTATE here"-	handleRemoteRequest (GETSTATE key) =+	handleRemoteRequest _ (GETSTATE key) = 		case externalRemoteStateHandle external of 			Just h -> do 				state <- fromMaybe "" 					<$> getRemoteState h key 				send $ VALUE state 			Nothing -> senderror "cannot send GETSTATE here"-	handleRemoteRequest (SETURLPRESENT key url) =+	handleRemoteRequest _ (SETURLPRESENT key url) = 		setUrlPresent key url-	handleRemoteRequest (SETURLMISSING key url) =+	handleRemoteRequest _ (SETURLMISSING key url) = 		setUrlMissing key url-	handleRemoteRequest (SETURIPRESENT key uri) =-		withurl (SETURLPRESENT key) uri-	handleRemoteRequest (SETURIMISSING key uri) =-		withurl (SETURLMISSING key) uri-	handleRemoteRequest (GETURLS key prefix) = do+	handleRemoteRequest cleanupv (SETURIPRESENT key uri) =+		withurl cleanupv (SETURLPRESENT key) uri+	handleRemoteRequest cleanupv (SETURIMISSING key uri) =+		withurl cleanupv (SETURLMISSING key) uri+	handleRemoteRequest _ (GETURLS key prefix) = do 		mapM_ (send . VALUE) =<< getUrlsWithPrefix key prefix 		send (VALUE "") -- end of list-	handleRemoteRequest (DEBUG msg) = fastDebug "Remote.External" msg-	handleRemoteRequest (INFO msg) = showInfo (UnquotedString msg)-	handleRemoteRequest (VERSION _) = senderror "too late to send VERSION"+	handleRemoteRequest _ (DEBUG msg) = fastDebug "Remote.External" msg+	handleRemoteRequest _ (INFO msg) = showInfo (UnquotedString msg)+	handleRemoteRequest cleanupv (DOWNLOAD_URL url) = do+		case externalGitConfig external of+			Just gc -> do+				(tmpf, h) <- liftIO $ do+					tmpdir <- systemTmpDirectory+					openTmpFileIn tmpdir (literalOsPath "url")+				liftIO $ hClose h+				liftIO $ atomically $ do+					l <- takeTMVar cleanupv+					putTMVar cleanupv (removeTmpFile tmpf:l)+				res <- withUrlOptions (Just gc) $+					downloadUrl' False UnknownSize +						nullMeterUpdate Nothing [url]+						tmpf+				case res of+					Right True -> +						send $ DOWNLOAD_URL_SUCCESS (fromOsPath tmpf)+					Left err -> +						send $ DOWNLOAD_URL_FAILURE err+					Right False -> +						send $ DOWNLOAD_URL_FAILURE "download failed"+			_ -> senderror "cannot send DOWNLOAD-URL here"+	handleRemoteRequest _ (VERSION _) = senderror "too late to send VERSION"  	handleExceptionalMessage (ERROR err) = giveup $ "external special remote error: " ++ err @@ -599,23 +863,33 @@ 		} 	  where 		base = replace "/" "_" $ fromUUID u ++ "-" ++ setting-			-	withurl mk uri = handleRemoteRequest $ mk $+	+	withurl cleanupv mk uri = handleRemoteRequest cleanupv $ mk $ 		setDownloader (show uri) OtherDownloader -sendMessage :: (Sendable m, ToAsyncWrapped m) => ExternalState -> m -> Annex ()+sendMessage+	:: (Sendable m, ToAsyncWrapped m)+	=> ExternalState+	-> m+	-> Annex () sendMessage st m = liftIO $ externalSend st m -sendMessageAddonProcess :: Sendable m => AddonProcess.ExternalAddonProcess -> m -> IO ()+sendMessageAddonProcess+	:: Sendable m+	=> AddonProcess.ExternalAddonProcess+	-> m+	-> IO () sendMessageAddonProcess p m = do 	AddonProcess.protocolDebug p True line 	hPutStrLn h line 	hFlush h   where 	h = AddonProcess.externalSend p-	line = unwords $ formatMessage m+	line = genMessage m -receiveMessageAddonProcess :: AddonProcess.ExternalAddonProcess -> IO (Maybe String)+receiveMessageAddonProcess+	:: AddonProcess.ExternalAddonProcess+	-> IO (Maybe String) receiveMessageAddonProcess p = do 	v <- catchMaybeIO $ hGetLine $ AddonProcess.externalReceive p 	maybe noop (AddonProcess.protocolDebug p False) v@@ -635,6 +909,9 @@ result :: a -> Maybe (Annex (ResponseHandlerResult a)) result = Just . return . Result +getResult :: Annex a -> Maybe (Annex (ResponseHandlerResult a))+getResult a = Just $ Result <$> a+ {- Waits for a message from the external remote, and passes it to the  - appropriate handler.   -@@ -827,9 +1104,8 @@ 		Unprepared -> 			handleRequest' st external PREPARE Nothing $ \resp -> 				case resp of-					PREPARE_SUCCESS -> Just $ do+					PREPARE_SUCCESS -> getResult $ 						setprepared Prepared-						return (Result ()) 					PREPARE_FAILURE errmsg -> Just $ do 						let errmsg' = respErrorMessage "PREPARE" errmsg 						setprepared $ FailedPrepare errmsg'@@ -908,13 +1184,13 @@ 	unlessM (withUrlOptions (Just gc) $ downloadUrl True k p iv us f) $ 		giveup downloadFailed -retrieveUrl' :: RemoteGitConfig -> URLString -> OsPath -> Key -> MeterUpdate -> Maybe (Annex (ResponseHandlerResult (Either String ())))-retrieveUrl' gc url dest k p = -	Just $ withUrlOptions (Just gc) $ \uo ->-		downloadUrl' False k p Nothing [url] dest uo >>= return . \case-			Left msg -> Result (Left msg)-			Right True -> Result (Right ())-			Right False -> Result (Left downloadFailed)+retrieveUrl' :: MeterSize sizer => RemoteGitConfig -> URLString -> OsPath -> sizer -> MeterUpdate -> Annex (Either String ())+retrieveUrl' gc url dest sizer p = +	withUrlOptions (Just gc) $ \uo ->+		downloadUrl' False sizer p Nothing [url] dest uo >>= return . \case+			Left msg -> Left msg+			Right True -> Right ()+			Right False -> Left downloadFailed  downloadFailed :: String downloadFailed = "failed to download content"

@@ -111,7 +111,7 @@ 		sendloop st sendq 	Nothing -> return ()   where-	wrapjid msg jid = AsyncMessage jid $ unwords $ Proto.formatMessage msg+	wrapjid msg jid = AsyncMessage jid $ Proto.genMessage msg  shutdown :: External -> ExternalState -> SendQueue -> Async () -> Async () -> Bool -> IO () shutdown external st sendq sendthread receivethread b = do

@@ -21,6 +21,7 @@ 	ExternalAsync(..), 	ExternalAsyncRelay(..), 	Proto.parseMessage,+	Proto.genMessage, 	Proto.Sendable(..), 	Proto.Receivable(..), 	Request(..),@@ -49,6 +50,7 @@ import Config.Cost (Cost) import Types.RemoteState import Types.RemoteConfig+import Types.Import import Types.Export import Types.Availability (Availability(..)) import Types.Key@@ -191,6 +193,11 @@ 	| REMOVEEXPORT SafeKey 	| REMOVEEXPORTDIRECTORY ExportDirectory 	| RENAMEEXPORT SafeKey ExportLocation+	| IMPORTSUPPORTED+	| LISTIMPORTABLECONTENTS+	| IMPORT ImportLocation+	| RETRIEVEIMPORT FilePath+	| CHECKPRESENTIMPORT SafeKey 	deriving (Show)  -- Does PREPARE need to have been sent before this request?@@ -199,49 +206,69 @@ needsPREPARE (EXTENSIONS _) = False needsPREPARE INITREMOTE = False needsPREPARE EXPORTSUPPORTED = False+needsPREPARE IMPORTSUPPORTED = False needsPREPARE LISTCONFIGS = False needsPREPARE _ = True  instance Proto.Sendable Request where-	formatMessage (EXTENSIONS l) = ["EXTENSIONS", Proto.serialize l]-	formatMessage PREPARE = ["PREPARE"]-	formatMessage INITREMOTE = ["INITREMOTE"]-	formatMessage GETCOST = ["GETCOST"]-	formatMessage GETAVAILABILITY = ["GETAVAILABILITY"]-	formatMessage GETORDERED = ["GETORDERED"]-	formatMessage (CLAIMURL url) = [ "CLAIMURL", Proto.serialize url ]-	formatMessage (CHECKURL url) = [ "CHECKURL", Proto.serialize url ]-	formatMessage (TRANSFER direction key file) =+	formatMessage (EXTENSIONS l) = Proto.mkMessage+		["EXTENSIONS", Proto.serialize l]+	formatMessage PREPARE = Proto.mkMessage ["PREPARE"]+	formatMessage INITREMOTE = Proto.mkMessage ["INITREMOTE"]+	formatMessage GETCOST = Proto.mkMessage ["GETCOST"]+	formatMessage GETAVAILABILITY = Proto.mkMessage ["GETAVAILABILITY"]+	formatMessage GETORDERED = Proto.mkMessage ["GETORDERED"]+	formatMessage (CLAIMURL url) = Proto.mkMessage+		[ "CLAIMURL", Proto.serialize url ]+	formatMessage (CHECKURL url) = Proto.mkMessage+		[ "CHECKURL", Proto.serialize url ]+	formatMessage (TRANSFER direction key file) = Proto.mkMessage 		[ "TRANSFER" 		, Proto.serialize direction 		, Proto.serialize key 		, Proto.serialize file 		]-	formatMessage (CHECKPRESENT key) =+	formatMessage (CHECKPRESENT key) = Proto.mkMessage 		[ "CHECKPRESENT", Proto.serialize key ]-	formatMessage (REMOVE key) = [ "REMOVE", Proto.serialize key ]-	formatMessage (WHEREIS key) = [ "WHEREIS", Proto.serialize key ]-	formatMessage LISTCONFIGS = [ "LISTCONFIGS" ]-	formatMessage GETINFO = [ "GETINFO" ]-	formatMessage EXPORTSUPPORTED = ["EXPORTSUPPORTED"]-	formatMessage (EXPORT loc) = [ "EXPORT", Proto.serialize loc ]-	formatMessage (TRANSFEREXPORT direction key file) = +	formatMessage (REMOVE key) = Proto.mkMessage+		[ "REMOVE", Proto.serialize key ]+	formatMessage (WHEREIS key) = Proto.mkMessage+		[ "WHEREIS", Proto.serialize key ]+	formatMessage LISTCONFIGS = Proto.mkMessage ["LISTCONFIGS"]+	formatMessage GETINFO = Proto.mkMessage ["GETINFO"]+	formatMessage EXPORTSUPPORTED = Proto.mkMessage ["EXPORTSUPPORTED"]+	formatMessage (EXPORT loc) = Proto.mkMessage+		[ "EXPORT", Proto.serialize loc ]+	formatMessage (TRANSFEREXPORT direction key file) = Proto.mkMessage 		[ "TRANSFEREXPORT" 		, Proto.serialize direction 		, Proto.serialize key 		, Proto.serialize file 		]-	formatMessage (CHECKPRESENTEXPORT key) =+	formatMessage (CHECKPRESENTEXPORT key) = Proto.mkMessage 		[ "CHECKPRESENTEXPORT", Proto.serialize key ]-	formatMessage (REMOVEEXPORT key) =+	formatMessage (REMOVEEXPORT key) = Proto.mkMessage 		[ "REMOVEEXPORT", Proto.serialize key ]-	formatMessage (REMOVEEXPORTDIRECTORY dir) =+	formatMessage (REMOVEEXPORTDIRECTORY dir) = Proto.mkMessage 		[ "REMOVEEXPORTDIRECTORY", Proto.serialize dir ]-	formatMessage (RENAMEEXPORT key newloc) =+	formatMessage (RENAMEEXPORT key newloc) = Proto.mkMessage 		[ "RENAMEEXPORT" 		, Proto.serialize key 		, Proto.serialize newloc 		]+	formatMessage IMPORTSUPPORTED = Proto.mkMessage ["IMPORTSUPPORTED"]+	formatMessage LISTIMPORTABLECONTENTS = Proto.mkMessage+		[ "LISTIMPORTABLECONTENTS" ]+	formatMessage (IMPORT loc) = Proto.mkMessage+		[ "IMPORT", Proto.serialize loc ]+	formatMessage (RETRIEVEIMPORT file) = Proto.mkMessage+		[ "RETRIEVEIMPORT"+		, Proto.serialize file+		]+	formatMessage (CHECKPRESENTIMPORT key) = Proto.mkMessage+		[ "CHECKPRESENTIMPORT"+		, Proto.serialize key+		]  -- Responses the external remote can make to requests. data Response@@ -265,8 +292,8 @@ 	| INITREMOTE_FAILURE ErrorMsg 	| CLAIMURL_SUCCESS 	| CLAIMURL_FAILURE-	| CHECKURL_CONTENTS Size FilePath-	| CHECKURL_MULTI [(URLString, Size, FilePath)]+	| CHECKURL_CONTENTS MaybeSize FilePath+	| CHECKURL_MULTI [(URLString, MaybeSize, FilePath)] 	| CHECKURL_FAILURE ErrorMsg 	| WHEREIS_SUCCESS String 	| WHEREIS_FAILURE@@ -281,6 +308,16 @@ 	| REMOVEEXPORTDIRECTORY_FAILURE 	| RENAMEEXPORT_SUCCESS Key 	| RENAMEEXPORT_FAILURE Key+	| IMPORTSUPPORTED_SUCCESS+	| IMPORTSUPPORTED_FAILURE+	| IMPORTREQUIRED+	| IMPORTABLECONTENT Size FilePath+	| IMPORTABLECONTENTIDENTIFIER ContentIdentifier+	| LISTIMPORTABLECONTENTS_SUCCESS+	| LISTIMPORTABLECONTENTS_FAILURE ErrorMsg+	| RETRIEVEIMPORT_SUCCESS+	| RETRIEVEIMPORT_FAILURE ErrorMsg+	| RETRIEVEIMPORT_URL URLString 	| DELEGATE [String] 	| UNSUPPORTED_REQUEST 	deriving (Show)@@ -322,6 +359,16 @@ 	parseCommand "REMOVEEXPORTDIRECTORY-FAILURE" = Proto.parse0 REMOVEEXPORTDIRECTORY_FAILURE 	parseCommand "RENAMEEXPORT-SUCCESS" = Proto.parse1 RENAMEEXPORT_SUCCESS 	parseCommand "RENAMEEXPORT-FAILURE" = Proto.parse1 RENAMEEXPORT_FAILURE+	parseCommand "IMPORTSUPPORTED-SUCCESS" = Proto.parse0 IMPORTSUPPORTED_SUCCESS+	parseCommand "IMPORTSUPPORTED-FAILURE" = Proto.parse0 IMPORTSUPPORTED_FAILURE+	parseCommand "IMPORTREQUIRED" = Proto.parse0 IMPORTREQUIRED+	parseCommand "IMPORTABLECONTENT" = Proto.parse2 IMPORTABLECONTENT+	parseCommand "IMPORTABLECONTENTIDENTIFIER" = Proto.parse1 IMPORTABLECONTENTIDENTIFIER+	parseCommand "LISTIMPORTABLECONTENTS-SUCCESS" = Proto.parse0 LISTIMPORTABLECONTENTS_SUCCESS+	parseCommand "LISTIMPORTABLECONTENTS-FAILURE" = Proto.parse1 LISTIMPORTABLECONTENTS_FAILURE+	parseCommand "RETRIEVEIMPORT-SUCCESS" = Proto.parse0 RETRIEVEIMPORT_SUCCESS+	parseCommand "RETRIEVEIMPORT-FAILURE" = Proto.parse1 RETRIEVEIMPORT_FAILURE+	parseCommand "RETRIEVEIMPORT-URL" = Proto.parse1 RETRIEVEIMPORT_URL 	parseCommand "DELEGATE" = Proto.parseList DELEGATE 	parseCommand "UNSUPPORTED-REQUEST" = Proto.parse0 UNSUPPORTED_REQUEST 	parseCommand _ = Proto.parseFail@@ -350,6 +397,7 @@ 	| GETURLS Key String 	| DEBUG String 	| INFO String+	| DOWNLOAD_URL URLString 	deriving (Show)  instance Proto.Receivable RemoteRequest where@@ -375,17 +423,26 @@ 	parseCommand "GETURLS" = Proto.parse2 GETURLS 	parseCommand "DEBUG" = Proto.parse1 DEBUG 	parseCommand "INFO" = Proto.parse1 INFO+	parseCommand "DOWNLOAD-URL" = Proto.parse1 DOWNLOAD_URL 	parseCommand _ = Proto.parseFail  -- Responses to RemoteRequest. data RemoteResponse 	= VALUE String 	| CREDS String String+	| DOWNLOAD_URL_SUCCESS FilePath+	| DOWNLOAD_URL_FAILURE String 	deriving (Show)  instance Proto.Sendable RemoteResponse where-	formatMessage (VALUE s) = [ "VALUE", Proto.serialize s ]-	formatMessage (CREDS login password) = [ "CREDS", Proto.serialize login, Proto.serialize password ]+	formatMessage (VALUE s) = Proto.mkMessage+		[ "VALUE", Proto.serialize s ]+	formatMessage (CREDS login password) = Proto.mkMessage+		[ "CREDS", Proto.serialize login, Proto.serialize password ]+	formatMessage (DOWNLOAD_URL_SUCCESS file) = Proto.mkMessage+		[ "DOWNLOAD-URL-SUCCESS", Proto.serialize file ]+	formatMessage (DOWNLOAD_URL_FAILURE msg) = Proto.mkMessage+		[ "DOWNLOAD-URL-FAILURE", Proto.serialize msg ]  -- Messages that can be sent at any time by either git-annex or the remote. data ExceptionalMessage@@ -393,7 +450,8 @@ 	deriving (Show)  instance Proto.Sendable ExceptionalMessage where-	formatMessage (ERROR err) = [ "ERROR", Proto.serialize err ]+	formatMessage (ERROR err) = Proto.mkMessage+		[ "ERROR", Proto.serialize err ]  instance Proto.Receivable ExceptionalMessage where 	parseCommand "ERROR" = Proto.parse1 ERROR@@ -406,7 +464,8 @@ 	parseCommand _ = Proto.parseFail  instance Proto.Sendable AsyncMessage where-	formatMessage (AsyncMessage jid msg) = ["J", Proto.serialize jid, msg]+	formatMessage (AsyncMessage jid msg) = Proto.mkMessage+		["J", Proto.serialize jid, msg]  data AsyncWrapped 	= AsyncWrappedRemoteResponse RemoteResponse@@ -435,7 +494,8 @@ type Setting = String type Description = String type ProtocolVersion = Int-type Size = Maybe Integer+type Size = Integer+type MaybeSize = Maybe Integer type WrappedMsg = String newtype JobId = JobId Integer 	deriving (Eq, Ord, Show)@@ -463,7 +523,7 @@ 	serialize = show 	deserialize = readish -instance Proto.Serializable Size where+instance Proto.Serializable MaybeSize where 	serialize (Just s) = show s 	serialize Nothing = "UNKNOWN" 	deserialize "UNKNOWN" = Just Nothing@@ -479,7 +539,7 @@ 	deserialize "UNAVAILABLE" = Just Unavailable 	deserialize _ = Nothing -instance Proto.Serializable [(URLString, Size, FilePath)] where+instance Proto.Serializable [(URLString, MaybeSize, FilePath)] where 	serialize = unwords . map go 	  where 		go (url, sz, f) = url ++ " " ++ maybe "UNKNOWN" show sz ++ " " ++ f@@ -503,3 +563,8 @@ instance Proto.Serializable ExtensionList where 	serialize (ExtensionList l) = unwords l 	deserialize = Just . ExtensionList . words++instance Proto.Serializable ContentIdentifier where+	serialize (ContentIdentifier cid) = decodeBS cid+	deserialize = Just . ContentIdentifier . encodeBS+

@@ -76,6 +76,7 @@ 	, setup = gCryptSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -146,6 +147,7 @@ 		, checkPresentCheap = repoCheap r 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -93,6 +93,7 @@ 	, setup = gitSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -243,6 +244,7 @@ 			, checkPresentCheap = repoCheap r 			, exportActions = exportUnsupported 			, importActions = importUnsupported+			, exportImportActions = exportImportUnsupported 			, whereisKey = Nothing 			, remoteFsck = if Git.repoIsUrl r 				then Nothing

@@ -73,6 +73,7 @@ 	, setup = mySetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -124,6 +125,7 @@ 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -50,6 +50,7 @@ 	, setup = glacierSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -94,6 +95,7 @@ 			, checkPresentCheap = False 			, exportActions = exportUnsupported 			, importActions = importUnsupported+			, exportImportActions = exportImportUnsupported 			, whereisKey = Nothing 			, remoteFsck = Nothing 			, repairKey = Nothing

@@ -1,6 +1,6 @@ {- Helper to make remotes support export and import (or not).  -- - Copyright 2017-2024 Joey Hess <id@joeyh.name>+ - Copyright 2017-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -33,8 +33,8 @@ class HasExportUnsupported a where 	exportUnsupported :: a -instance HasExportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool) where-	exportUnsupported = \_ _ -> return False+instance HasExportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex ExportSupported) where+	exportUnsupported = \_ _ -> return (ExportSupported False)  instance HasExportUnsupported (ExportActions Annex) where 	exportUnsupported = ExportActions@@ -52,12 +52,28 @@ class HasImportUnsupported a where 	importUnsupported :: a -instance HasImportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool) where-	importUnsupported = \_ _ -> return False+instance HasImportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex ImportSupported) where+	importUnsupported = \_ _ -> return (ImportSupported False)  instance HasImportUnsupported (ImportActions Annex) where 	importUnsupported = ImportActions 		{ listImportableContents = nope+		, retrieveImport = nope+		, checkPresentImport = \_ _ -> return False+		}+	  where+		nope = giveup "import not supported"++-- | Use for remotes that do not support exports and imports.+class HasExportImportUnsupported a where+	exportImportUnsupported :: a++instance HasExportImportUnsupported (ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool) where+	exportImportUnsupported = \_ _ -> return False++instance HasExportImportUnsupported (ExportImportActions Annex) where+	exportImportUnsupported = ExportImportActions+		{ listImportableOrExportedContents = nope 		, importKey = Nothing 		, retrieveExportWithContentIdentifier = nope 		, storeExportWithContentIdentifier = nope@@ -66,14 +82,17 @@ 		, checkPresentExportWithContentIdentifier = \_ _ _ -> return False 		} 	  where-		nope = giveup "import not supported"+		nope = giveup "import combined with export not supported" -exportIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool-exportIsSupported = \_ _ -> return True+exportIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex ExportSupported+exportIsSupported = \_ _ -> return (ExportSupported True) -importIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool-importIsSupported = \_ _ -> return True+importIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex ImportSupported+importIsSupported = \_ _ -> return (ImportSupported True) +exportImportIsSupported :: ParsedRemoteConfig -> RemoteGitConfig -> Annex Bool+exportImportIsSupported = \_ _ -> return True+ -- | Prevent or allow exporttree=yes and importtree=yes when -- setting up a new remote, depending on the remote's capabilities. adjustExportImportRemoteType :: RemoteType -> RemoteType@@ -83,7 +102,11 @@ 		pc <- either giveup return . parseRemoteConfig c 			=<< configParser rt c 		let checkconfig supported configured configfield cont =-			ifM (supported rt pc gc <&&> pure (not (thirdPartyPopulated rt)))+			let allowed = +				( pure supported+					<||> exportImportSupported rt pc gc)+				<&&> pure (not (thirdPartyPopulated rt))+			in ifM allowed 				( case st of 					Init 						| configured pc && encryptionIsEnabled pc ->@@ -95,9 +118,25 @@ 					then giveup $ fromProposedAccepted configfield ++ " is not supported by this special remote" 					else cont 				)-		checkconfig exportSupported exportTree exportTreeField $-			checkconfig importSupported importTree importTreeField $-				setup rt st mu remotename cp c gc+		let checkexportimport cont+			| importTree pc && exportTree pc =+				ifM (exportImportSupported rt pc gc)+					( cont+					, giveup $ "This special remote does not support enabling both "+						++ fromProposedAccepted importTreeField+						++ " and "+						++ fromProposedAccepted exportTreeField+					)+			| otherwise = cont+		exportsupported <- exportSupported rt pc gc+		importsupported <- importSupported rt pc gc+		when (isImportRequired importsupported && not (importTree pc)) $+			giveup $ "This special remote must be configured with " ++ +				fromProposedAccepted importTreeField ++ "=" ++ yesNoGenerator True+		checkconfig (isExportSupported' exportsupported) exportTree exportTreeField $+			checkconfig (isImportSupported' importsupported) importTree importTreeField $+				checkexportimport $+					setup rt st mu remotename cp c gc 	 	enable oldc pc configured configfield cont = do 		oldpc <- parsedRemoteConfig rt oldc@@ -108,13 +147,19 @@ -- | Adjust a remote to support exporttree=yes and/or importree=yes. adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote adjustExportImport r rs = do-	isexport <- pure (exportTree (config r))-		<&&> isExportSupported r-	-- When thirdPartyPopulated is True, the remote-	-- does not need to be configured with importTree to support-	-- imports.-	isimport <- pure (importTree (config r) || thirdPartyPopulated (remotetype r))-		<&&> isImportSupported r+	isexport <- pure exportconfigured <&&> isExportSupported r+	isimport <- pure importconfigured <&&> isImportSupported r+	isexportimport <- pure+		-- Use ExportImportActions even when+		-- not configured with exporttree=yes,+		-- when it's supported, since it+		-- handles content identifiers more+		-- strongly than ImportActions does.+		( importconfigured+		-- thirdPartyPopulated is handled using +		-- ExportImportActions+		|| thirdPartyPopulated (remotetype r))+		<&&> isExportImportSupported r 	let r' = r 		{ remotetype = (remotetype r) 			{ exportSupported = if isexport@@ -123,28 +168,39 @@ 			, importSupported = if isimport 				then importSupported (remotetype r) 				else importUnsupported+			, exportImportSupported = if isexportimport+				then exportImportSupported (remotetype r)+				else exportImportUnsupported 			} 		} 	let annexobjects = isexport && annexObjects (config r)-	if not isexport && not isimport+	if not isexport && not isimport && not isexportimport 		then return r' 		else do 			gc <- Annex.getGitConfig-			adjustExportImport' isexport isimport annexobjects r' rs gc+			adjustExportImport' isexport isimport isexportimport annexobjects r' rs gc+  where+	exportconfigured = exportTree (config r)+	importconfigured = importTree (config r) -adjustExportImport' :: Bool -> Bool -> Bool -> Remote -> RemoteStateHandle -> GitConfig -> Annex Remote-adjustExportImport' isexport isimport annexobjects r rs gc = do+adjustExportImport' :: Bool -> Bool -> Bool -> Bool -> Remote -> RemoteStateHandle -> GitConfig -> Annex Remote+adjustExportImport' isexport isimport isexportimport annexobjects r rs gc = do 	dbv <- prepdbv 	ciddbv <- prepciddb 	return $ r 		{ exportActions = if isexport-			then if isimport-				then exportActionsForImport dbv ciddbv (exportActions r)+			then if isexportimport+				then exportActionsForExportImport dbv ciddbv (exportActions r) 				else exportActions r 			else exportUnsupported-		, importActions = if isimport-			then importActions r-			else importUnsupported+		, importActions = if isexportimport+			then importActionsForExportImport ciddbv+			else if isimport+				then importActions r+				else importUnsupported+		, exportImportActions = if isexportimport+			then exportImportActions r+			else exportImportUnsupported 		, storeKey = \k af o p -> 			-- Storing a key to an export location could be 			-- implemented, but it would perform unnecessary work@@ -157,7 +213,7 @@ 					then if annexobjects 						then storeannexobject k o p 						else giveup "remote is configured with exporttree=yes; use `git-annex export` to store content on it"-					else if isimport+					else if isexportimport || isimport 						then giveup "remote is configured with importtree=yes and without exporttree=yes; cannot modify content stored on it" 						else storeKey r k af o p 		, removeKey = \proof k -> @@ -173,14 +229,14 @@ 					then if annexobjects 						then removeannexobject dbv k 						else giveup "dropping content from an export is not supported; use `git annex export` to export a tree that lacks the files you want to remove"-					else if isimport+					else if isexportimport || isimport 						then giveup "dropping content from this remote is not supported because it is configured with importtree=yes" 						else removeKey r proof k 		, lockContent = if versioned 			then lockContent r 			else Nothing 		, retrieveKeyFile = \k af dest p vc ->-			if isimport || isexport+			if isexportimport || isexport || isimport 				then supportversionedretrieve k af dest p vc $ 					supportretrieveannexobject dbv k af dest p $ 						retrieveFromImportOrExport (tryexportlocs dbv k) ciddbv k af dest p@@ -190,26 +246,19 @@ 			else Nothing 		, checkPresent = \k -> if versioned 			then checkPresent r k-			else if isimport+			else if isexportimport 				then checkpresentwith k $-					anyM (checkPresentImport ciddbv k)+					anyM (checkPresentExportImport ciddbv k) 						=<< getanyexportlocs dbv k 				else if isexport-					-- Check if any of the files a key-					-- was exported to are present. This -					-- doesn't guarantee the export-					-- contains the right content,-					-- if the remote is an export,-					-- or if something else can write-					-- to it. Remotes that have such -					-- problems are made untrusted,-					-- so it's not worried about here.-					then checkpresentwith k $-						anyM (checkPresentExport (exportActions r) k)-							=<< getanyexportlocs dbv k-					else checkPresent r k-		-- checkPresent from an export is more expensive-		-- than otherwise, so not cheap. Also, this+					then checkpresentloc dbv k+						(checkPresentExport (exportActions r))+					else if isimport+						then checkpresentloc dbv k+							(checkPresentImport (importActions r))+						else checkPresent r k+		-- checkPresent from an export or import is more+		-- expensive than otherwise, so not cheap. Also, this 		-- avoids things that look at checkPresentCheap and 		-- silently skip non-present files from behaving 		-- in confusing ways when there's an export@@ -242,7 +291,7 @@ 							else Nothing 						] 				else return is-			return $ if isimport && not thirdpartypopulated+			return $ if (isexportimport || isimport) && not thirdpartypopulated 				then (is'++[("importtree", "yes")]) 				else is' 		}@@ -251,32 +300,42 @@ 	 	thirdpartypopulated = thirdPartyPopulated (remotetype r) -	-- exportActions adjusted to use the equivalent import actions,-	-- which take ContentIdentifiers into account.-	exportActionsForImport dbv ciddbv ea = ea+	-- exportActions adjusted to use the equivalent+	-- exportImportActions, which take ContentIdentifiers+	-- into account.+	exportActionsForExportImport dbv ciddbv ia = ia   		{ storeExport = \f k loc p -> do 			db <- getciddb ciddbv 			exportdb <- getexportdb dbv 			oldks <- liftIO $ Export.getExportTreeKey exportdb loc 			oldcids <- liftIO $ concat 				<$> mapM (ContentIdentifier.getContentIdentifiers db rs) oldks-			newcid <- storeExportWithContentIdentifier (importActions r) f k loc oldcids p+			newcid <- storeExportWithContentIdentifier (exportImportActions r) f k loc oldcids p 			cidlck <- calcRepo' gitAnnexContentIdentifierLock 			withExclusiveLock cidlck $ do 				liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k 				liftIO $ ContentIdentifier.flushDbQueue db 			recordContentIdentifier rs newcid k 		, removeExport = \k loc ->-			removeExportWithContentIdentifier (importActions r) k loc+			removeExportWithContentIdentifier (exportImportActions r) k loc 				=<< getkeycids ciddbv k-		, removeExportDirectory = removeExportDirectoryWhenEmpty (importActions r)+		, removeExportDirectory = removeExportDirectoryWhenEmpty (exportImportActions r) 		-- 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 = Nothing-		, checkPresentExport = checkPresentImport ciddbv+		, checkPresentExport = checkPresentExportImport ciddbv 		} 	+	-- importActions adjusted to use the equivalent+	-- exportImportActions, which check ContentIdentifiers+	-- more strongly.+	importActionsForExportImport ciddbv = ImportActions+		{ listImportableContents = listImportableOrExportedContents (exportImportActions r)+		, retrieveImport = retrieveExportWithContentIdentifier (exportImportActions r)+		, checkPresentImport = checkPresentExportImport ciddbv+		}+ 	prepciddb = do 		lcklckv <- liftIO newEmptyTMVarIO 		dbtv <- liftIO newEmptyTMVarIO@@ -366,8 +425,9 @@ 		liftIO $ ContentIdentifier.getContentIdentifiers db rs k  	retrieveFromImportOrExport getlocs ciddbv k af dest p-		| isimport = retrieveFromImport getlocs ciddbv k af dest p-		| otherwise = retrieveFromExport getlocs k af dest p+		| isexportimport = retrieveFromExportImport getlocs ciddbv k af dest p+		| isexport = retrieveFromExport getlocs k af dest p+		| otherwise = retrieveFromImport getlocs ciddbv k af dest p  	-- Keys can be retrieved using retrieveExport, but since that 	-- retrieves from a path in the remote that another writer could@@ -375,34 +435,60 @@ 	-- has to be strongly verified. 	retrieveFromExport getlocs k _af dest p = ifM (isVerifiable k) 		( getlocs $ \loc -> -			retrieveExport (exportActions r) k loc dest p >>= return . \case-				UnVerified -> MustVerify-				IncompleteVerify iv -> MustFinishIncompleteVerify iv-				v -> v+			stronglyverify $+				retrieveExport (exportActions r) k loc dest p 		, giveup $ "exported content cannot be verified due to using the " ++ decodeBS (formatKeyVariety (fromKey keyVariety k)) ++ " backend" 		) 	+	retrieveFromExportImport getlocs ciddbv k af dest p = do+		cids <- getkeycids ciddbv k+		if not (null cids)+			then getlocs $ \loc ->+				snd <$> retrieveExportWithContentIdentifier (exportImportActions r) loc cids dest (Left k) p+			-- In case a content identifier is somehow missing,+			-- try this instead.+			else retrieveWithoutContentIdentifier $+				retrieveFromExport getlocs k af dest p+	 	retrieveFromImport getlocs ciddbv k af dest p = do 		cids <- getkeycids ciddbv k 		if not (null cids) 			then getlocs $ \loc ->-				snd <$> retrieveExportWithContentIdentifier (importActions r) loc cids dest (Left k) p+				-- retrieveImport does not guarantee that+				-- the file it retrieves has the content+				-- identifier, so it must be strongly+				-- verified.+				stronglyverify $+					snd <$> retrieveImport (importActions r) loc cids dest (Left k) p 			-- In case a content identifier is somehow missing, 			-- try this instead.-			else if isexport-				then retrieveFromExport getlocs k af dest p-				else giveup "no content identifier is recorded, unable to retrieve"+			else retrieveWithoutContentIdentifier $+				retrieveFromExport getlocs k af dest p +	retrieveWithoutContentIdentifier a+		| isexport = a+		| otherwise = giveup "no content identifier is recorded, unable to retrieve"+ 	checkpresentwith k a = ifM a 		( return True 		, if annexobjects 			then checkpresentannexobject k 			else return False 		)+	+	-- Check if any of the recorded locations for a key+	-- are present. The action doesn't guarantee that the+	-- file contains the right content if the remote+	-- is an export or import something else can write to+	-- it. Such remotes are made untrusted, so it's not+	-- worried about here.+	checkpresentloc dbv k a = +		checkpresentwith k $+			anyM (a k) =<< getanyexportlocs dbv k -	checkPresentImport ciddbv k loc =+	checkPresentExportImport ciddbv k loc = 		checkPresentExportWithContentIdentifier-			(importActions r)+			(exportImportActions r) 			k loc  			=<< getkeycids ciddbv k @@ -466,3 +552,8 @@ 			retrieveKeyFile r k af dest p vc 				`catchNonAsync` const a 		| otherwise = a+	+	stronglyverify a = a >>= return . \case+		UnVerified -> MustVerify+		IncompleteVerify iv -> MustFinishIncompleteVerify iv+		v -> v

@@ -36,7 +36,7 @@ 			, removeExportDirectory = Just readonlyRemoveExportDirectory 			, renameExport = Nothing 			}-		, importActions = (importActions r)+		, exportImportActions = (exportImportActions r) 			{ storeExportWithContentIdentifier = readonlyStoreExportWithContentIdentifier 			, removeExportWithContentIdentifier = readonlyRemoveExportWithContentIdentifier 			, removeExportDirectoryWhenEmpty = Just readonlyRemoveExportDirectory

@@ -41,6 +41,7 @@ 	, setup = hookSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -73,6 +74,7 @@ 			, checkPresentCheap = False 			, exportActions = exportUnsupported 			, importActions = importUnsupported+			, exportImportActions = exportImportUnsupported 			, whereisKey = Nothing 			, remoteFsck = Nothing 			, repairKey = Nothing

@@ -42,6 +42,7 @@ 	, setup = httpAlsoSetup 	, exportSupported = exportIsSupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -85,6 +86,7 @@ 			, renameExport = cannotModify 			} 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -41,6 +41,7 @@ 	, setup = maskSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -64,6 +65,7 @@ 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -43,6 +43,7 @@ 	, setup = giveup "P2P remotes are set up using git-annex p2p" 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -68,6 +69,7 @@ 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -1,6 +1,6 @@ {- Rclone special remote, using "rclone gitannex"  -- - Copyright 2024 Joey Hess <id@joeyh.name>+ - Copyright 2024-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -22,8 +22,9 @@ 	, generate = External.gen remote p 	, configParser = External.remoteConfigParser p 	, setup = External.externalSetup p setgitconfig -	, exportSupported = External.checkExportSupported p-	, importSupported = importUnsupported+	, exportSupported = External.checkSupportedWith p External.checkExportSupported+	, importSupported = External.checkSupportedWith p External.checkImportSupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	}   where

@@ -1,11 +1,11 @@ {- A remote that is only accessible by rsync.  -- - Copyright 2011-2020 Joey Hess <id@joeyh.name>+ - Copyright 2011-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} -{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-}  module Remote.Rsync ( 	remote,@@ -32,6 +32,7 @@ import Remote.Helper.Special import Remote.Helper.ExportImport import Remote.Helper.Path+import Types.Import import Types.Export import Types.ProposedAccepted import Remote.Rsync.RsyncUrl@@ -52,6 +53,7 @@  import qualified Data.Map as M import qualified Data.List.NonEmpty as NE+import Text.Read  remote :: RemoteType remote = specialRemoteType $ RemoteType@@ -64,7 +66,8 @@ 		] 	, setup = rsyncSetup 	, exportSupported = exportIsSupported-	, importSupported = importUnsupported+	, importSupported = importIsSupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -105,11 +108,16 @@ 				{ storeExport = storeExportM o 				, retrieveExport = retrieveExportM o 				, removeExport = removeExportM o-				, checkPresentExport = checkPresentExportM o+				, checkPresentExport = checkPresentImportExportM o 				, removeExportDirectory = Nothing 				, renameExport = Just $ renameExportM o 				}-			, importActions = importUnsupported+			, importActions = ImportActions+				{ listImportableContents = listImportableContentsM o+				, retrieveImport = retrieveImportM o+				, checkPresentImport = checkPresentImportExportM o+				}+			, exportImportActions = exportImportUnsupported 			, whereisKey = Nothing 			, remoteFsck = Nothing 			, repairRepo = Nothing@@ -330,8 +338,8 @@   where 	rsyncurl = mkRsyncUrl o (fromOsPath (fromExportLocation loc)) -checkPresentExportM :: RsyncOpts -> Key -> ExportLocation -> Annex Bool-checkPresentExportM o _k loc = checkPresentGeneric o [rsyncurl]+checkPresentImportExportM :: RsyncOpts -> Key -> ExportLocation -> Annex Bool+checkPresentImportExportM o _k loc = checkPresentGeneric o [rsyncurl]   where 	rsyncurl = mkRsyncUrl o (fromOsPath (fromExportLocation loc)) @@ -345,6 +353,59 @@  renameExportM :: RsyncOpts -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe ()) renameExportM _ _ _ _ = return Nothing++listImportableContentsM :: RsyncOpts -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableContentsM o =+	withRsyncScratchDir $ \tmp -> do+		opts <- rsyncOptions o+		let p = rsyncCreateProcess $ opts +++			[ Param "--recursive"+			, Param "--dry-run"+			, Param $ "--out-format=" ++ formatstring+			, Param url+			, Param $ fromOsPath tmp+			]+		l <- mapMaybe parse . lines <$> liftIO (readProcess' p)+		return $ Just $ ImportableContentsComplete $ ImportableContents+			{ importableContents = l+			, importableHistory = []+			}+  where+	-- Make the url end in a slash so rsync will avoid prefixing+	-- filenames it outputs with part of the url.+	url = fromOsPath $ addTrailingPathSeparator $ toOsPath $ rsyncUrl o++	formatstring = "%l|%M|%L|%n"++	parse s+		| "/" `isSuffixOf` s = Nothing+		| otherwise = case splitc '|' s of+			(ssz:sdate:ssymlink:rest)+				| not (null ssymlink) -> Nothing+				| otherwise -> do+					sz <- readMaybe ssz+					let loc = mkImportLocation $ toOsPath $+						rsyncPathUnescape $+							intercalate "|" rest+					let cid = ContentIdentifier $ encodeBS $ +						ssz ++ "|" ++ sdate+					Just (loc, (cid, sz))+			_ -> Nothing++retrieveImportM :: RsyncOpts -> ImportLocation -> [ContentIdentifier] -> OsPath -> Either Key (Annex Key) -> MeterUpdate -> Annex (Key, Verification)+retrieveImportM o loc _ dest gk p =+	case gk of+		Right mkkey -> do+			go Nothing+			k <- mkkey+			return (k, UnVerified)+		Left k -> do+			v <- verifyKeyContentIncrementally AlwaysVerify k go+			return (k, v)+  where+	go iv = tailVerify iv dest $+		rsyncRetrieve o [rsyncurl] dest (Just p)+	rsyncurl = mkRsyncUrl o (fromOsPath (fromImportLocation loc))  {- Rsync params to enable resumes of sending files safely,  - ensure that files are only moved into place once complete

@@ -127,7 +127,8 @@ 		} 	, setup = s3Setup 	, exportSupported = exportIsSupported-	, importSupported = importIsSupported+	, importSupported = importUnsupported+	, exportImportSupported = exportImportIsSupported 	, thirdPartyPopulated = False 	} @@ -240,8 +241,9 @@ 				, removeExportDirectory = Nothing 				, renameExport = Just $ renameExportS3 hdl this rs info 				}-			, importActions = ImportActions-                                { listImportableContents = listImportableContentsS3 hdl this info c+			, importActions = importUnsupported+			, exportImportActions = ExportImportActions+                                { listImportableOrExportedContents = listImportableOrExportedContentsS3 hdl this info c 				, importKey = Nothing                                 , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierS3 hdl this rs info                                 , storeExportWithContentIdentifier = storeExportWithContentIdentifierS3 hdl this rs info magic@@ -609,8 +611,8 @@ 	srcobject = T.pack $ bucketExportLocation info src 	dstobject = T.pack $ bucketExportLocation info dest -listImportableContentsS3 :: S3HandleVar -> Remote -> S3Info -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))-listImportableContentsS3 hv r info c =+listImportableOrExportedContentsS3 :: S3HandleVar -> Remote -> S3Info -> ParsedRemoteConfig -> Annex (Maybe (ImportableContentsChunkable Annex (ContentIdentifier, ByteSize)))+listImportableOrExportedContentsS3 hv r info c = 	withS3Handle hv $ \case 		Right h -> Just <$> go h 		Left p -> giveupS3HandleProblem p (uuid r)@@ -786,7 +788,7 @@  -- Does not check if content on S3 is safe to overwrite, because there -- is no atomic way to do so. When the bucket is versioned, this is--- acceptable because listImportableContentsS3 will find versions+-- acceptable because listImportableOrExportedContentsS3 will find versions -- of files that were overwritten by this and no data is lost. -- -- When the bucket is not versioned, data loss can result.@@ -806,7 +808,7 @@  -- Does not guarantee that the removed object has the content identifier, -- but when the bucket is versioned, the removed object content can still--- be recovered (and listImportableContentsS3 will find it).+-- be recovered (and listImportableOrExportedContentsS3 will find it). --  -- When the bucket is not versioned, data loss can result. -- This is why that configuration requires --force to enable.@@ -1513,7 +1515,7 @@ 					return True 				Left problem -> giveupS3HandleProblem problem (uuid r) 			Nothing -> return False-		v <- snd <$> finishVerifyKeyContentIncrementally' True miv+		v <- snd <$> finishVerifyKeyContentIncrementally miv 		case v of 			Verified -> return True 			_

@@ -70,6 +70,7 @@ 	, setup = tahoeSetup 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -106,6 +107,7 @@ 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Just (getWhereisKey rs) 		, remoteFsck = Nothing 		, repairKey = Nothing@@ -233,7 +235,7 @@ 				Just s | "\n" `isSuffixOf` s || "\r" `isSuffixOf` s -> 					return $ takeWhile (`notElem` ("\n\r" :: String)) s 				_ -> do-					threadDelaySeconds (Seconds 1)+					threadDelaySeconds (SecondsDelay 1) 					go (n - 1)  convergenceFile :: TahoeConfigDir -> OsPath@@ -274,7 +276,7 @@ 			if ok 				then return () 				else do-					threadDelaySeconds (Seconds 1)+					threadDelaySeconds (SecondsDelay 1) 					waitready (pred n)  {- Ensures that tahoe has been started, before running an action

@@ -47,6 +47,7 @@ 	, setup = setupInstance 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -87,6 +88,7 @@ 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported+		, exportImportActions = exportImportUnsupported 		, whereisKey = Nothing 		, remoteFsck = Nothing 		, repairKey = Nothing

@@ -58,6 +58,7 @@ 	, setup = webdavSetup 	, exportSupported = exportIsSupported 	, importSupported = importUnsupported+	, exportImportSupported = exportImportUnsupported 	, thirdPartyPopulated = False 	} @@ -107,6 +108,7 @@ 				, renameExport = Just $ renameExportDav hdl 				} 			, importActions = importUnsupported+			, exportImportActions = exportImportUnsupported 			, whereisKey = Nothing 			, remoteFsck = Nothing 			, repairKey = Nothing

@@ -60,7 +60,7 @@   where 	caught ConnectionStopping = return () 	caught ConnectionClosed = do-		threadDelaySeconds (Seconds backoff)+		threadDelaySeconds (SecondsDelay backoff) 		robustConnection increasedbackoff a  	increasedbackoff

@@ -44,7 +44,7 @@ 			Just cmd -> atomically $ writeTChan ichan cmd 	let writer = forever $ do 		msg <- atomically $ readTChan ochan-		hPutStrLn writeh $ unwords $ formatMessage msg+		hPutStrLn writeh $ genMessage msg 		hFlush writeh 	let controller = runController ichan ochan 	@@ -59,7 +59,7 @@ 	ochan <- newTChanIO :: IO (TChan Emitted) 	 	let reader = forever $ do-		threadDelaySeconds (Seconds (60*60))+		threadDelaySeconds (SecondsDelay (60*60)) 		atomically $ writeTChan ichan RELOAD 	let writer = forever $ 		void $ atomically $ readTChan ochan

@@ -23,8 +23,9 @@ 	| CHANGED ChangedRefs  instance Proto.Sendable Notification where-	formatMessage READY = ["READY"]-	formatMessage (CHANGED shas) = ["CHANGED", Proto.serialize shas]+	formatMessage READY = Proto.mkMessage ["READY"]+	formatMessage (CHANGED shas) = Proto.mkMessage+		["CHANGED", Proto.serialize shas]  instance Proto.Receivable Notification where 	parseCommand "READY" = Proto.parse0 READY

@@ -63,24 +63,25 @@ 	deriving (Show)  instance Proto.Sendable Emitted where-	formatMessage (CONNECTED remote) =+	formatMessage (CONNECTED remote) = Proto.mkMessage 		["CONNECTED", Proto.serialize remote]-	formatMessage (DISCONNECTED remote) =+	formatMessage (DISCONNECTED remote) = Proto.mkMessage 		["DISCONNECTED", Proto.serialize remote]-	formatMessage (SYNCING remote) =+	formatMessage (SYNCING remote) = Proto.mkMessage 		["SYNCING", Proto.serialize remote]-	formatMessage (DONESYNCING remote status) =+	formatMessage (DONESYNCING remote status) = Proto.mkMessage 		["DONESYNCING", Proto.serialize remote, Proto.serialize status]-	formatMessage (WARNING remote message) =+	formatMessage (WARNING remote message) = Proto.mkMessage 		["WARNING", Proto.serialize remote, Proto.serialize message]  instance Proto.Sendable Consumed where-	formatMessage PAUSE = ["PAUSE"]-	formatMessage LOSTNET = ["LOSTNET"]-	formatMessage RESUME = ["RESUME"]-	formatMessage (CHANGED refs) =["CHANGED", Proto.serialize refs]-	formatMessage RELOAD = ["RELOAD"]-	formatMessage STOP = ["STOP"]+	formatMessage PAUSE = Proto.mkMessage ["PAUSE"]+	formatMessage LOSTNET = Proto.mkMessage ["LOSTNET"]+	formatMessage RESUME = Proto.mkMessage ["RESUME"]+	formatMessage (CHANGED refs) = Proto.mkMessage+		["CHANGED", Proto.serialize refs]+	formatMessage RELOAD = Proto.mkMessage ["RELOAD"]+	formatMessage STOP = Proto.mkMessage ["STOP"]  instance Proto.Receivable Emitted where 	parseCommand "CONNECTED" = Proto.parse1 CONNECTED

@@ -365,7 +365,7 @@ 		print e 		putStrLn "sleeping 10 seconds and will retry directory cleanup" 		Utility.ThreadScheduler.threadDelaySeconds $-			Utility.ThreadScheduler.Seconds 10+			Utility.ThreadScheduler.SecondsDelay 10 		whenM (doesDirectoryExist (toOsPath tmpdir)) $ 			removeDirectoryForCleanup tmpdir 

@@ -56,7 +56,7 @@ import Utility.HumanTime import Utility.Gpg (GpgCmd, mkGpgCmd) import Utility.StatelessOpenPGP (SOPCmd(..), SOPProfile(..))-import Utility.ThreadScheduler (Seconds(..))+import Utility.ThreadScheduler (SecondsDelay(..)) import Utility.Url (Scheme, mkScheme) import Network.Socket (PortNumber) import P2P.Http.Url@@ -138,13 +138,13 @@ 	, annexVerify :: Bool 	, annexFastCopy :: Bool 	, annexPidLock :: Bool-	, annexPidLockTimeout :: Seconds+	, annexPidLockTimeout :: SecondsDelay 	, annexDbDir :: Maybe OsPath 	, annexAddUnlocked :: GlobalConfigurable (Maybe String) 	, annexSecureHashesOnly :: Bool 	, annexRetry :: Maybe Integer 	, annexForwardRetry :: Maybe Integer-	, annexRetryDelay :: Maybe Seconds+	, annexRetryDelay :: Maybe SecondsDelay 	, annexAllowedUrlSchemes :: S.Set Scheme 	, annexAllowedIPAddresses :: String 	, annexAllowInsecureHttps :: Bool@@ -253,7 +253,7 @@ 	, annexVerify = getbool (annexConfig "verify") True 	, annexFastCopy = getbool (annexConfig "fastcopy") False 	, annexPidLock = getbool (annexConfig "pidlock") False-	, annexPidLockTimeout = Seconds $ fromMaybe 300 $+	, annexPidLockTimeout = SecondsDelay $ fromMaybe 300 $ 		getmayberead (annexConfig "pidlocktimeout") 	, annexDbDir = (\d -> toOsPath d </> fromUUID hereuuid) 		<$> getmaybe (annexConfig "dbdir")@@ -262,7 +262,7 @@ 	, annexSecureHashesOnly = getbool (annexConfig "securehashesonly") False 	, annexRetry = getmayberead (annexConfig "retry") 	, annexForwardRetry = getmayberead (annexConfig "forward-retry")-	, annexRetryDelay = Seconds+	, annexRetryDelay = SecondsDelay 		<$> getmayberead (annexConfig "retrydelay") 	, annexAllowedUrlSchemes = S.fromList $ map mkScheme $ 		maybe ["http", "https", "ftp"] words $@@ -421,7 +421,7 @@ 	, remoteAnnexBare :: Maybe Bool 	, remoteAnnexRetry :: Maybe Integer 	, remoteAnnexForwardRetry :: Maybe Integer-	, remoteAnnexRetryDelay :: Maybe Seconds+	, remoteAnnexRetryDelay :: Maybe SecondsDelay 	, remoteAnnexStallDetection :: Maybe StallDetection 	, remoteAnnexStallDetectionUpload :: Maybe StallDetection 	, remoteAnnexStallDetectionDownload :: Maybe StallDetection@@ -507,7 +507,7 @@ 		, remoteAnnexBare = getmaybebool BareField 		, remoteAnnexRetry = getmayberead RetryField 		, remoteAnnexForwardRetry = getmayberead ForwardRetryField-		, remoteAnnexRetryDelay = Seconds+		, remoteAnnexRetryDelay = SecondsDelay 			<$> getmayberead RetryDelayField 		, remoteAnnexStallDetection = 			readStallDetection =<< getmaybe StallDetectionField

@@ -2,7 +2,7 @@  -  - Most things should not need this, using Types instead  -- - Copyright 2011-2024 Joey Hess <id@joeyh.name>+ - Copyright 2011-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -20,9 +20,16 @@ 	, Verification(..) 	, unVerified 	, RetrievalSecurityPolicy(..)+	, ExportSupported(..) 	, isExportSupported+	, isExportSupported'+	, ImportSupported(..) 	, isImportSupported+	, isImportSupported'+	, isImportRequired+	, isExportImportSupported 	, ExportActions(..)+	, ExportImportActions(..) 	, ImportActions(..) 	, ByteSize 	, SafeDropProof@@ -67,9 +74,12 @@ 	-- initializes or enables a remote 	, setup :: SetupStage -> Maybe UUID -> RemoteName -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID) 	-- check if a remote of this type is able to support export-	, exportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a Bool+	, exportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a ExportSupported 	-- check if a remote of this type is able to support import-	, importSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a Bool+	, importSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a ImportSupported+	-- check if a remote of this type is able to support both import+	-- and export at the same time+	, exportImportSupported :: ParsedRemoteConfig -> RemoteGitConfig -> a Bool 	-- is a remote of this type not a usual key/value store, 	-- or export/import of a tree of files, but instead a collection 	-- of files, populated by something outside git-annex, some of@@ -134,6 +144,8 @@ 	, exportActions :: ExportActions a 	-- Some remotes support import. 	, importActions :: ImportActions a+	-- Some remotes support import as well as export.+	, exportImportActions :: ExportImportActions a 	-- Some remotes can provide additional details for whereis. 	, whereisKey :: Maybe (Key -> a [String]) 	-- Some remotes can run a fsck operation on the remote,@@ -233,6 +245,8 @@ 	| MustFinishIncompleteVerify IncrementalVerifier 	-- ^ Content likely to have been altered during transfer, 	-- finish verification even if verification is normally disabled.+	| VerificationFailed+	-- ^ Content verification has failed.  unVerified :: Monad m => m a -> m (a, Verification) unVerified a = do@@ -265,12 +279,36 @@ 	| RetrievalAllKeysSecure 	-- ^ Any key can be securely retrieved. -isExportSupported :: RemoteA a -> a Bool-isExportSupported r = exportSupported (remotetype r) (config r) (gitconfig r)+newtype ExportSupported = ExportSupported Bool -isImportSupported :: RemoteA a -> a Bool-isImportSupported r = importSupported (remotetype r) (config r) (gitconfig r)+isExportSupported :: Monad a => RemoteA a -> a Bool+isExportSupported r = +	exportSupported (remotetype r) (config r) (gitconfig r)+		>>= return . isExportSupported' +isExportSupported' :: ExportSupported -> Bool+isExportSupported' (ExportSupported b) = b++data ImportSupported = ImportSupported Bool | ImportRequired++isImportSupported :: Monad a => RemoteA a -> a Bool+isImportSupported r = +	importSupported (remotetype r) (config r) (gitconfig r) +		>>= return . \case +			ImportSupported b -> b+			ImportRequired -> True++isImportSupported' :: ImportSupported -> Bool+isImportSupported' (ImportSupported b) = b+isImportSupported' ImportRequired = True++isImportRequired :: ImportSupported -> Bool+isImportRequired (ImportSupported _) = False+isImportRequired ImportRequired = True++isExportImportSupported :: RemoteA a -> a Bool+isExportImportSupported r = exportImportSupported (remotetype r) (config r) (gitconfig r)+ data ExportActions a = ExportActions  	-- Exports content to an ExportLocation. 	-- The exported file should not appear to be present on the remote@@ -315,7 +353,7 @@ 	, renameExport :: Maybe (Key -> ExportLocation -> ExportLocation -> a (Maybe ())) 	} -data ImportActions a = ImportActions+data ExportImportActions a = ExportImportActions 	-- Finds the current set of files that are stored in the remote, 	-- along with their content identifiers and size. 	--@@ -324,7 +362,13 @@ 	-- 	-- Throws exception on failure to access the remote. 	-- May return Nothing when the remote is unchanged since last time.-	{ listImportableContents :: a (Maybe (ImportableContentsChunkable a (ContentIdentifier, ByteSize)))+	--+	-- The ContentIdentifier this returns must be sufficient to detect+	-- any change to a file stored on the remote. Eg, a mtime and+	-- inode. When storeExportWithContentIdentifier was used to store+	-- content to the remote, this should return the same+	-- ContentIdentifier that did.+	{ listImportableOrExportedContents :: a (Maybe (ImportableContentsChunkable a (ContentIdentifier, ByteSize))) 	-- Generates a Key (of any type) for the file stored on the 	-- remote at the ImportLocation. Does not download the file 	-- from the remote.@@ -419,3 +463,27 @@ 		-> a Bool 	} +data ImportActions a = ImportActions+	-- Like listImportableOrExportedContents, but here the+	-- ContentIdentifier is only used to avoid repeatedly+	-- importing the same content from the remote, and does+	-- not need to uniquely identify content.+	-- Eg, a mtime is sufficient.+	{ listImportableContents :: a (Maybe (ImportableContentsChunkable a (ContentIdentifier, ByteSize)))+	-- Like retrieveExportWithContentIdentifier, but does not+	-- need to guarantee that the file it retrieves has one+	-- of the requested ContentIdentifiers.+	, retrieveImport+		:: ImportLocation+		-> [ContentIdentifier]+		-> OsPath+		-> Either Key (a Key)+		-> MeterUpdate+		-> a (Key, Verification)+	-- Checks if anything is present on the remote at the specified+	-- ImportLocation. It may check the size or other characteristics+	-- of the Key, but does not need to guarantee that the content on+	-- the remote is the same as the Key's content.+	-- Throws an exception if the remote cannot be accessed.+	, checkPresentImport :: Key -> ImportLocation -> a Bool+	}

@@ -48,25 +48,25 @@ 	deriving (Show)  instance Proto.Sendable TransferRequest where-	formatMessage (UploadRequest r kd af) =+	formatMessage (UploadRequest r kd af) = Proto.mkMessage 		[ "u" 		, Proto.serialize r 		, Proto.serialize kd 		, Proto.serialize af 		]-	formatMessage (DownloadRequest r kd af) =+	formatMessage (DownloadRequest r kd af) = Proto.mkMessage 		[ "d" 		, Proto.serialize r 		, Proto.serialize kd 		, Proto.serialize af 		]-	formatMessage (AssistantUploadRequest r kd af) =+	formatMessage (AssistantUploadRequest r kd af) = Proto.mkMessage 		[ "au" 		, Proto.serialize r 		, Proto.serialize kd 		, Proto.serialize af 		]-	formatMessage (AssistantDownloadRequest r kd af) =+	formatMessage (AssistantDownloadRequest r kd af) = Proto.mkMessage 		[ "ad" 		, Proto.serialize r 		, Proto.serialize kd@@ -81,27 +81,27 @@ 	parseCommand _ = Proto.parseFail  instance Proto.Sendable TransferResponse where-	formatMessage (TransferOutput (OutputMessage m)) =+	formatMessage (TransferOutput (OutputMessage m)) = Proto.mkMessage 		["om", Proto.serialize (decodeBS (encode_c isUtf8Byte m))]-	formatMessage (TransferOutput (OutputError e)) =+	formatMessage (TransferOutput (OutputError e)) = Proto.mkMessage 		["oe", Proto.serialize (decodeBS (encode_c isUtf8Byte (encodeBS e)))]-	formatMessage (TransferOutput BeginProgressMeter) =+	formatMessage (TransferOutput BeginProgressMeter) = Proto.mkMessage 		["opb"]-	formatMessage (TransferOutput (UpdateProgressMeterTotalSize (TotalSize sz))) =+	formatMessage (TransferOutput (UpdateProgressMeterTotalSize (TotalSize sz))) = Proto.mkMessage 		["ops", Proto.serialize sz]-	formatMessage (TransferOutput (UpdateProgressMeter n)) =+	formatMessage (TransferOutput (UpdateProgressMeter n)) = Proto.mkMessage 		["op", Proto.serialize n]-	formatMessage (TransferOutput EndProgressMeter) =+	formatMessage (TransferOutput EndProgressMeter) = Proto.mkMessage 		["ope"]-	formatMessage (TransferOutput BeginPrompt) =+	formatMessage (TransferOutput BeginPrompt) = Proto.mkMessage 		["oprb"]-	formatMessage (TransferOutput EndPrompt) =+	formatMessage (TransferOutput EndPrompt) = Proto.mkMessage 		["opre"]-	formatMessage (TransferOutput (JSONObject b)) =+	formatMessage (TransferOutput (JSONObject b)) = Proto.mkMessage 		["oj", Proto.serialize (decodeBS (encode_c isUtf8Byte (L.toStrict b)))]-	formatMessage (TransferResult True) =+	formatMessage (TransferResult True) = Proto.mkMessage 		["t"]-	formatMessage (TransferResult False) =+	formatMessage (TransferResult False) = Proto.mkMessage 		["f"]  instance Proto.Receivable TransferResponse where@@ -130,7 +130,8 @@ 	parseCommand _ = Proto.parseFail  instance Proto.Sendable TransferSerializedOutputResponse where-	formatMessage (TransferSerializedOutputResponse ReadyPrompt) = ["opr"]+	formatMessage (TransferSerializedOutputResponse ReadyPrompt) =+		Proto.mkMessage ["opr"]  instance Proto.Receivable TransferSerializedOutputResponse where 	parseCommand "opr" = Proto.parse0 (TransferSerializedOutputResponse ReadyPrompt)

@@ -25,7 +25,7 @@  import Data.Maybe import Data.Char-import qualified Data.ByteArray as BA+import qualified "memory" Data.ByteArray as BA import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.ByteString.Lazy as L

@@ -69,7 +69,7 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.IORef-import qualified Data.ByteArray as BA+import qualified "memory" Data.ByteArray as BA import "crypton" Crypto.Hash  import Utility.Hash.Types

@@ -6,12 +6,13 @@  -}  {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE PackageImports #-}  module Utility.Hash.Types where  import qualified Data.ByteString as S-import Data.ByteArray-import qualified Data.ByteArray.Encoding as BAE+import "memory" Data.ByteArray+import qualified "memory" Data.ByteArray.Encoding as BAE import Data.String import Control.DeepSeq import GHC.Generics

@@ -6,6 +6,7 @@  -}  {-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE PackageImports #-}  -- Note that some extensions are necessary for reasons outlined in -- my July 2021 blog post. -- JEH@@ -21,7 +22,7 @@  import Network.Socket import Data.Word-import Data.Memory.Endian+import "memory" Data.Memory.Endian import Data.List import Text.Printf 

@@ -265,25 +265,25 @@ -- -- After the first second waiting, runs the callback to display a message, -- so the user knows why it's stalled.-waitLock :: MonadIO m => Seconds -> PidLockFile -> (String -> m ()) -> (Bool -> IO ()) -> m LockHandle-waitLock (Seconds timeout) lockfile displaymessage sem = go timeout+waitLock :: MonadIO m => SecondsDelay -> PidLockFile -> (String -> m ()) -> (Bool -> IO ()) -> m LockHandle+waitLock (SecondsDelay timeout) lockfile displaymessage sem = go timeout   where 	go n 		| n > 0 = liftIO (tryLock lockfile) >>= \case 			Nothing -> do 				when (n == pred timeout) $ 					displaymessage $ "waiting for pid lock file " ++ fromOsPath lockfile ++ " which is held by another process (or may be stale)"-				liftIO $ threadDelaySeconds (Seconds 1)+				liftIO $ threadDelaySeconds (SecondsDelay 1) 				go (pred n) 			Just lckh -> do 				liftIO $ sem True 				return lckh 		| otherwise = do 			liftIO $ sem False-			waitedLock (Seconds timeout) lockfile displaymessage+			waitedLock (SecondsDelay timeout) lockfile displaymessage -waitedLock :: MonadIO m => Seconds -> PidLockFile -> (String -> m ()) -> m a-waitedLock (Seconds timeout) lockfile displaymessage = do+waitedLock :: MonadIO m => SecondsDelay -> PidLockFile -> (String -> m ()) -> m a+waitedLock (SecondsDelay timeout) lockfile displaymessage = do 	displaymessage $ show timeout ++ " second timeout exceeded while waiting for pid lock file " ++ fromOsPath lockfile 	giveup $ "Gave up waiting for pid lock file " ++ fromOsPath lockfile 

@@ -33,7 +33,7 @@ import Control.Monad.IO.Class  -- Does locking using a pid lock, blocking until the lock is available--- or the Seconds timeout if the pid lock is held by another process.+-- or the SecondsDelay timeout if the pid lock is held by another process. -- -- There are two levels of locks. A STM lock is used to handle -- fine-grained locking among threads, locking a specific lockfile,@@ -47,7 +47,7 @@ 	:: (MonadIO m, MonadMask m) 	=> LockFile 	-> LockMode-	-> Seconds+	-> SecondsDelay 	-> F.PidLockFile 	-> (String -> m ()) 	-> m LockHandle

@@ -1,6 +1,6 @@ {- various rsync stuff  -- - Copyright 2010-2013 Joey Hess <id@joeyh.name>+ - Copyright 2010-2026 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -13,10 +13,12 @@ 	rsyncServerReceive, 	rsyncUseDestinationPermissions, 	rsync,+	rsyncCreateProcess, 	rsyncUrlIsShell, 	rsyncUrlIsPath, 	rsyncProgress, 	filterRsyncSafeOptions,+	rsyncPathUnescape, ) where  import Common@@ -69,6 +71,9 @@ rsync :: [CommandParam] -> IO Bool rsync = boolSystem "rsync" . rsyncParamsFixup +rsyncCreateProcess :: [CommandParam] -> CreateProcess+rsyncCreateProcess = proc "rsync" . toCommand . rsyncParamsFixup+ {- On Windows, rsync is from msys2, and expects to get msys2 formatted  - paths to files. (It thinks that C:foo refers to a host named "C").  - Fix up the Params appropriately. -}@@ -187,3 +192,17 @@ 		| otherwise = s #endif +{- When listing files with eg --dry-run, rsync escapes some characters+ - to 3 octal digits. Eg, "\#012" is '\n'+ -}+rsyncPathUnescape :: String -> FilePath+rsyncPathUnescape = go+  where+	go [] = []+	go ('\\':'#':d1:d2:d3:cs)+		| isOctDigit d1 && isOctDigit d2 && isOctDigit d3 =+			case (readish [d1], readish [d2], readish [d3]) of+				(Just n1, Just n2, Just n3) ->+					chr (n3+8*n2+8*8*n1) : go cs+				_ -> error "internal"+	go (c:cs) = c : go cs

@@ -1,6 +1,6 @@ {- Simple line-based protocols.  -- - Copyright 2013-2024 Joey Hess <id@joeyh.name>+ - Copyright 2013-2026 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -11,6 +11,9 @@ module Utility.SimpleProtocol ( 	Sendable(..), 	Receivable(..),+	SendableMessage,+	mkMessage,+	genMessage, 	parseMessage, 	Serializable(..), 	Parser,@@ -34,7 +37,7 @@  -- Messages that can be sent. class Sendable m where-	formatMessage :: m -> [String]+	formatMessage :: m -> SendableMessage  -- Messages that can be received. class Receivable m where@@ -42,6 +45,25 @@ 	-- a Parser that can be be fed the rest of the message to generate 	-- the value. 	parseCommand :: String -> Parser m++-- Destructor not exported,  to force use of genMessage.+newtype SendableMessage = SendableMessage [String]++mkMessage :: [String] -> SendableMessage+mkMessage = SendableMessage++-- Generate a message to be sent, not including the trailing newline.+genMessage :: Sendable m => m -> String+genMessage m = +	let (SendableMessage l) = formatMessage m+	in unwords $ map removeunsafe l+  where+  	-- Guard against a newline somehow slipping into the message,+	-- which is not supported since this is a line-based protocol.+	-- If it somehow happens, it's stripped, so the protocol may+	-- request the wrong filename, for example, but at least won't+	-- get messed up at the line level.+	removeunsafe s = filter (/= '\n') s  parseMessage :: (Receivable m) => String -> Maybe m parseMessage s = parseCommand command rest

@@ -8,8 +8,8 @@ {-# LANGUAGE CPP #-}  module Utility.ThreadScheduler (-	Seconds(..),-	Microseconds,+	SecondsDelay(..),+	MicrosecondsDelay, 	runEvery, 	threadDelaySeconds, 	waitForTermination,@@ -29,30 +29,30 @@ import System.Posix.Terminal #endif -newtype Seconds = Seconds { fromSeconds :: Int }+newtype SecondsDelay = SecondsDelay { fromSecondsDelay :: Int } 	deriving (Eq, Ord, Show) -type Microseconds = Integer+type MicrosecondsDelay = Integer  {- Runs an action repeatedly forever, sleeping at least the specified number  - of seconds in between. -}-runEvery :: Seconds -> IO a -> IO a+runEvery :: SecondsDelay -> IO a -> IO a runEvery n a = forever $ do 	threadDelaySeconds n 	a -threadDelaySeconds :: Seconds -> IO ()-threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond)+threadDelaySeconds :: SecondsDelay -> IO ()+threadDelaySeconds (SecondsDelay n) = unboundDelay (fromIntegral n * oneSecond)  {- Like threadDelay, but not bounded by an Int. -}-unboundDelay :: Microseconds -> IO ()+unboundDelay :: MicrosecondsDelay -> IO () unboundDelay = Unbounded.delay  {- Pauses the main thread, letting children run until program termination. -} waitForTermination :: IO () waitForTermination = do #ifdef mingw32_HOST_OS-	forever $ threadDelaySeconds (Seconds 6000)+	forever $ threadDelaySeconds (SecondsDelay 6000) #else 	lock <- newEmptyMVar 	let check sig = void $@@ -63,5 +63,5 @@ 	takeMVar lock #endif -oneSecond :: Microseconds+oneSecond :: MicrosecondsDelay oneSecond = 1000000

@@ -1,6 +1,6 @@ {- Temporary files.  -- - Copyright 2010-2025 Joey Hess <id@joeyh.name>+ - Copyright 2010-2026 Joey Hess <id@joeyh.name>  -  - License: BSD-2-clause  -}@@ -15,12 +15,15 @@ 	withTmpFile, 	withTmpFileIn, 	openTmpFileIn,+	removeTmpFile,+	systemTmpDirectory, 	relatedTemplate, 	relatedTemplate', ) where  import System.IO import Control.Monad.IO.Class+import Control.Monad import System.IO.Error #ifndef mingw32_HOST_OS import Data.Char@@ -49,6 +52,10 @@ 		let loc = ioeGetLocation e ++ " template " ++ decodeBS (fromOsPath template) 		in annotateIOError e loc Nothing Nothing +{- Remove a temporary file if it is still present. -}+removeTmpFile :: OsPath -> IO ()+removeTmpFile = void . tryIO . removeFile+ {- Runs an action like writeFileString, writing to a temp file first and  - then moving it into place. The temp file is stored in the same  - directory as the final file to avoid cross-device renames.@@ -85,8 +92,12 @@  - (or in "." if there is none) then removes the file. -} withTmpFile :: (MonadIO m, MonadMask m) => Template -> (OsPath -> Handle -> m a) -> m a withTmpFile template a = do-	tmpdir <- liftIO $ catchDefaultIO (literalOsPath ".") getTemporaryDirectory+	tmpdir <- liftIO systemTmpDirectory 	withTmpFileIn tmpdir template a+	+{- The system's tmp directory (or "." if there is none). -} +systemTmpDirectory :: IO OsPath+systemTmpDirectory = catchDefaultIO (literalOsPath ".") getTemporaryDirectory  {- Runs an action with a tmp file located in the specified directory,  - then removes the file.@@ -100,7 +111,7 @@ 	create = liftIO $ openTmpFileIn tmpdir template 	remove (name, h) = liftIO $ do 		hClose h-		tryIO $ removeFile name+		removeTmpFile name 	use (name, h) = a name h  {- It's not safe to use a FilePath of an existing file as the template

@@ -118,7 +118,7 @@ 			Right s | ".onion\n" `isSuffixOf` s -> 				return (OnionAddress (takeWhile (/= '\n') s), p) 			_ -> do-				threadDelaySeconds (Seconds 1)+				threadDelaySeconds (SecondsDelay 1) 				waithiddenservice (n-1) p  -- | A hidden service directory to use.

@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20260624+Version: 10.20260717 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -36,6 +36,7 @@ Extra-Source-Files:   stack.yaml   stack-botan.yaml+  stack-NoLLMDependencies.yaml   README   CHANGELOG   NEWS@@ -146,6 +147,12 @@   templates/notifications/longpolling.julius   Utility/libkqueue.h +Flag NoLLMDependencies+  Description: Avoid building with versions of dependencies that contain +    LLM generated code <https://git-annex.branchable.com/no_llm_code/>+  Default: False+  Manual: True+ Flag Assistant   Description: Enable git-annex assistant, webapp, and watch command   Default: True@@ -213,7 +220,6 @@ Executable git-annex   Main-Is: git-annex.hs   Build-Depends:-   base (>= 4.18.2.1 && < 5),    network-uri (>= 2.6),    optparse-applicative (>= 0.14.2),    containers (>= 0.5.8),@@ -252,7 +258,6 @@    conduit,    time (>= 1.9.1),    persistent-sqlite (>= 2.13.3),-   persistent (>= 2.13.3),    persistent-template (>= 2.8.0),    unliftio-core,    microlens,@@ -277,22 +282,22 @@    tasty-quickcheck,    tasty-rerun,    ansi-terminal >= 0.9,-   aws (>= 0.24.1),    DAV (>= 1.0),    network (>= 3.0.0.0),    network-bsd,    git-lfs (>= 1.2.0),    clock (>= 0.3.0),-   crypton,-   crypton-connection (>= 0.4.3),-   crypton-x509-store,-   tls,    servant,    servant-server,    servant-client,    servant-client-core,    warp (>= 3.2.8),-   warp-tls (>= 3.2.2)+   warp-tls (>= 3.2.2),+   crypton,+   crypton-connection (>= 0.4.3),+   crypton-x509-store,+   tls,+   aws (>= 0.24.1)   CC-Options: -Wall   GHC-Options: -Wall -fno-warn-tabs  -Wincomplete-uni-patterns   Default-Language: Haskell2010@@ -300,6 +305,17 @@   Other-Extensions: TemplateHaskell   -- Some things don't work with the non-threaded RTS.   GHC-Options: -threaded+   +  if flag(NoLLMDependencies)+    CPP-Options: -DWITH_NOLLMDEPENDENCIES+    Build-Depends:+     base (>= 4.18.2.1 && < 4.23),+     ram (< 0.21.0),+     persistent (>= 2.13.3) && (< 2.15.0.0)+  else+    Build-Depends:+     base (>= 4.18.2.1 && < 5),+     persistent (>= 2.13.3)    -- Fully optimize for production.   if flag(Production)@@ -366,10 +382,6 @@     CPP-Options: -DWITH_ASSISTANT -DWITH_WEBAPP     Build-Depends:       mountpoints,-      yesod (>= 1.4.3), -      yesod-static (>= 1.5.1),-      yesod-form (>= 1.4.8),-      yesod-core (>= 1.6.0),       path-pieces (>= 0.2.1),       wai,       wai-extra,@@ -377,6 +389,18 @@       clientsession,       template-haskell,       shakespeare (>= 2.0.11)+    if flag(NoLLMDependencies)+      Build-Depends:+        yesod (>= 1.4.3) && (< 1.7.0.0), +        yesod-static (>= 1.5.1) && (<1.6.1.3),+        yesod-form (>= 1.4.8) && (< 1.7.9.3),+        yesod-core (>= 1.6.0) && (< 1.7.0.0)+    else+      Build-Depends:+        yesod (>= 1.4.3), +        yesod-static (>= 1.5.1),+        yesod-form (>= 1.4.8),+        yesod-core (>= 1.6.0)     Other-Modules:       Assistant       Assistant.Alert

@@ -0,0 +1,30 @@+flags:+  git-annex:+    NoLLMDependencies: true+    production: true+    parallelbuild: true+    assistant: true+    torrentparser: true+    magicmime: false+    dbus: false+    debuglocks: false+    benchmark: true+    ospath: true+    botan: false+    blake3: true+    xxh3: true+  file-io:+    os-string: true+  xxhash-ffi:+    pkg-config: false+packages:+- '.'+resolver: lts-24.26+extra-deps:+- aws-0.25.2+- file-io-0.2.0+- blake3-0.3+- xxhash-ffi-0.3.1+- ram-0.20.1+- persistent-2.14.6.3+- persistent-sqlite-2.13.3.0

@@ -1,5 +1,6 @@ flags:   git-annex:+    NoLLMDependencies: false     production: true     parallelbuild: true     assistant: true

@@ -1,5 +1,6 @@ flags:   git-annex:+    NoLLMDependencies: false     production: true     parallelbuild: true     assistant: true