packages feed

git-annex 10.20261020 → 10.20261026

raw patch · 28 files changed

+1059/−108 lines, 28 filesdep ~crypton

Dependency ranges changed: crypton

Files

Annex.hs view
@@ -208,6 +208,7 @@ 	, preferredcontentmap :: Maybe (FileMatcherMap Annex) 	, requiredcontentmap :: Maybe (FileMatcherMap Annex) 	, remoteconfigmap :: Maybe (M.Map UUID RemoteConfig)+	, verifiedremoteconfigmap :: Maybe (Maybe (M.Map UUID RemoteConfig)) 	, clusters :: Maybe (Annex Clusters) 	, maxsizes :: Maybe (M.Map UUID MaxSize) 	, forcetrust :: TrustMap@@ -268,6 +269,7 @@ 		, preferredcontentmap = Nothing 		, requiredcontentmap = Nothing 		, remoteconfigmap = Nothing+		, verifiedremoteconfigmap = Nothing 		, clusters = Nothing 		, maxsizes = Nothing 		, forcetrust = M.empty
Annex/Hook.hs view
@@ -4,7 +4,7 @@  - git-annex not change, otherwise removing old hooks using an old  - version of the script would fail.  -- - Copyright 2013-2025 Joey Hess <id@joeyh.name>+ - Copyright 2013-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -26,14 +26,27 @@  postReceiveHook :: Git.Hook postReceiveHook = Git.Hook (literalOsPath "post-receive")-	-- Only run git-annex post-receive when git-annex supports it,-	-- to avoid failing if the repository with this hook is used-	-- with an older version of git-annex.-	(mkHookScript "if git annex post-receive --help >/dev/null 2>&1; then git annex post-receive; fi")+	(mkHookScript (runHookCommandWhenSupported "post-receive")) 	-- This is an old version of the hook script. 	[ mkHookScript "git annex post-receive" 	] +-- Only run a git-annex hook command when git-annex supports it, to avoid+-- failing if the repository with a hook is used with an older version of+-- git-annex.+runHookCommandWhenSupported :: String -> String+runHookCommandWhenSupported command = concat+	[ "if git annex "+	, command+	, " --help >/dev/null 2>&1; then git annex "+	, command+	, "; fi"+	]++prePushHook :: Git.Hook+prePushHook = Git.Hook (literalOsPath "pre-push")+	(mkHookScript (runHookCommandWhenSupported "pre-push")) []+ postCheckoutHook :: Git.Hook postCheckoutHook = Git.Hook (literalOsPath "post-checkout") smudgeHook [] @@ -80,16 +93,21 @@ hookWrite h = unlessM (inRepo $ Git.hookWrite h) $ 	hookWarning h "already exists, not configuring" +tryHookWrite :: Git.Hook -> Annex (Either SomeException Bool)+tryHookWrite h = tryNonAsync (inRepo $ Git.hookWrite h)+ hookUnWrite :: Git.Hook -> Annex () hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $ 	hookWarning h "contents modified; not deleting. Edit it to remove call to git annex."  hookWarning :: Git.Hook -> String -> Annex ()-hookWarning h msg = do+hookWarning h msg = warning . UnquotedString =<< hookMessage h msg++hookMessage :: Git.Hook -> String -> Annex String+hookMessage h msg = do 	r <- gitRepo-	warning $ UnquotedString $-		fromOsPath (Git.hookName h) ++ -			" hook (" ++ fromOsPath (Git.hookFile h r) ++ ") " ++ msg+	return $ fromOsPath (Git.hookName h) ++ +		" hook (" ++ fromOsPath (Git.hookFile h r) ++ ") " ++ msg  {- To avoid checking if the hook exists every time, the existing hooks  - are cached. -}@@ -170,3 +188,11 @@ 		Nothing -> return Nothing 		Just command -> liftIO $  			Just <$> readProcess "sh" ["-c", command]++enablePrePushHook :: Annex (Maybe String)+enablePrePushHook = tryHookWrite prePushHook >>= \case+	Right True -> return Nothing+	Right False -> Just <$> hookMessage prePushHook+		"is not configured by git-annex."+	Left _ex -> Just <$> hookMessage prePushHook+		"does not exist and unable to write it."
Annex/Init.hs view
@@ -165,6 +165,7 @@ 	unlessM isBareRepo $ do 		hookWrite postCheckoutHook 		hookWrite postMergeHook+	hookWrite prePushHook  	AdjustedBranch.checkAdjustedClone >>= \case 		AdjustedBranch.InAdjustedClone -> return ()@@ -193,6 +194,7 @@ 	hookUnWrite postReceiveHook 	hookUnWrite postCheckoutHook 	hookUnWrite postMergeHook+	hookUnWrite prePushHook 	deconfigureSmudgeFilter 	removeRepoUUID 	removeVersion@@ -538,7 +540,7 @@ 	_ <- remotelist 	rp <- fromRepo Git.repoPath 	withNullHandle $ \nullh -> gitAnnexChildProcess "init"-		[ Param "--autoenable" ]+		[ Param "--autoenable", Param "--force" ] 		(\p -> p 			{ std_out = UseHandle nullh 			, std_err = UseHandle nullh
Annex/Locations.hs view
@@ -61,6 +61,10 @@ 	gitAnnexRestageLog, 	gitAnnexRestageLogOld, 	gitAnnexRestageLock,+	gitAnnexVerifiedRemoteLog,+	gitAnnexVerifiedRemoteLock,+	gitAnnexVerifyingRemoteLog,+	gitAnnexVerifyingRemoteLock, 	gitAnnexAdjustedBranchUpdateLog, 	gitAnnexAdjustedBranchUpdateLock, 	gitAnnexMigrateLog,@@ -486,6 +490,23 @@  gitAnnexRestageLock :: Git.Repo -> OsPath gitAnnexRestageLock r = gitAnnexDir r </> literalOsPath "restage.lck"++{- .git/annex/verified-remote.log is used to store the verified configs+ - of remotes. The git-annex branch remote.log may have newer versions,+ - which will not be used until after they have been verified. -}+gitAnnexVerifiedRemoteLog :: Git.Repo -> OsPath+gitAnnexVerifiedRemoteLog r = gitAnnexDir r </> literalOsPath "verified-remote.log"++gitAnnexVerifiedRemoteLock :: Git.Repo -> OsPath+gitAnnexVerifiedRemoteLock r = gitAnnexDir r </> literalOsPath "verified-remote.lck"++{- git/annex/verifying-remote.log is used by git-annex verify to record+ - the config that a user is in the process of verifying. -}+gitAnnexVerifyingRemoteLog :: Git.Repo -> OsPath+gitAnnexVerifyingRemoteLog r = gitAnnexDir r </> literalOsPath "verifying-remote.log"++gitAnnexVerifyingRemoteLock :: Git.Repo -> OsPath+gitAnnexVerifyingRemoteLock r = gitAnnexDir r </> literalOsPath "verifying-remote.lck"  {- .git/annex/adjust.log is used to log when the adjusted branch needs to  - be updated. -}
Annex/SpecialRemote.hs view
@@ -14,6 +14,7 @@  import Annex.Common import Annex.SpecialRemote.Config+import Annex.Hook import Types.Remote (RemoteConfig, SetupStage(..), setup) import Types.GitConfig import Types.ProposedAccepted@@ -74,7 +75,8 @@ 				dummycfg <- liftIO dummyRemoteGitConfig 				tryNonAsync (setup t (AutoEnable c) (Just u) name Nothing c dummycfg) >>= \case 					Left e -> warning (UnquotedString (show e))-					Right (_c, _u) ->+					Right (_c, _u) -> do+						setRemoteConfigVerification name Remote.RemoteConfigUnverifiedAutoEnabled 						when (cu /= u) $ 							setRemoteConfigUUID c cu 			_ -> return ()@@ -94,10 +96,14 @@ 		| otherwise = do 			rs <- remoteList' False 			case filter (\rmt -> Remote.name rmt == name) rs of-				(rmt:_) | Remote.uuid rmt /= u -> warning $ -					UnquotedString $ "Cannot auto enable special remote " -						++ name ++ " because there is another remote with the same name."-				_ -> cont+				(rmt:_) | Remote.uuid rmt /= u -> cannotenable name +						"there is another remote with the same name."+				_ -> enablePrePushHook >>= \case+					Nothing -> cont+					Just msg -> cannotenable name msg+	cannotenable name msg = warning $+		UnquotedString $ "Cannot auto enable special remote "+			++ name ++ " because " ++ msg  autoEnableable :: Annex (M.Map UUID RemoteConfig) autoEnableable = do
Annex/SpecialRemote/Config.hs view
@@ -116,6 +116,23 @@ annexObjects :: ParsedRemoteConfig -> Bool annexObjects = fromMaybe False . getRemoteConfigValue annexObjectsField +{- This is the order used in examples. Putting the typeField first+ - in particular makes it easier to understand a RemoteConfig. -}+conventionalConfigOrder :: RemoteConfigField -> RemoteConfigField -> Ordering+conventionalConfigOrder a b = compare (n a) (n b)+  where+	n :: RemoteConfigField -> (Int, RemoteConfigField)+	n f+		| f == typeField       = (1, f)+		| f == exportTreeField = (3, f)+		| f == importTreeField = (4, f)+		--                        5+		| f == autoEnableField = (6, f)+		| f == chunkField      = (7, f)+		| f == chunksizeField  = (8, f)+		| f == encryptionField = (9, f)+		| otherwise            = (5, f)+ {- Parsers for fields that are common to all special remotes. -} commonFieldParsers :: [RemoteConfigFieldParser] commonFieldParsers =@@ -168,6 +185,16 @@ 	-- for the sameas remote, since it's reading whatever chunks were 	-- stored 	, chunkField+	]++{- Fields that are used for encrypted special remotes, and are not user+ - visible. -}+hiddenEncryptionFields :: S.Set RemoteConfigField+hiddenEncryptionFields = S.fromList+	[ macField+	, cipherField+	, cipherkeysField+	, pubkeysField 	]  {- Each RemoteConfig that has a sameas-uuid inherits some fields
CHANGELOG view
@@ -1,3 +1,35 @@+git-annex (10.20261026) upstream; urgency=high++  * This releases fixes a security hole that allowed private data +    exfiltration from special remotes. (CVE-2026-112818)+    https://git-annex.branchable.com/security/cross_repository_data_exfiltration_via_special_remote/+  * verifyremote: New command, used to verify the configuration of special+    remotes is safe.+  * enableremote: Display configuration and prompt for verifyremote to be+    run. Until it is verified, the special remote cannot be used,+    and git pushes to all remotes will be prevented.+  * When a special remote has been autoenabled, allow it to be used without+    verification, but prevent sending annexed files or git pushes to any+    remote until it is verified.+  * After upgrading git-annex, existing special remotes will continue to work+    as before. If a special remote could have been configured by a third+    party, you should verify its configuration using the +    `git-annex verifyremote` command.+  * Changes to special remote configuration received in the git-annex+    branch no longer take effect until git-annex verifyremote is run to+    review and verify the new configuration.+  * init: When run in an already initialized repository, avoid +    autoenabling new special remotes, since files received from+    them could leak out via other git-annex processes running in the+    repository.+  * init --autoenable: Refuse to perform probably unsafe action unless+    forced.+  * Added remote.name.annex-verified git config.+  * git-annex.cabal: Added Memory build flag to support building with+    older versions of crypton that don't use ram.++ -- Joey Hess <id@joeyh.name>  Mon, 26 Oct 2026 14:00:00 -0400+ git-annex (10.20261020) upstream; urgency=medium    * adjust --hide-unwanted: New option to make an adjusted branch
CmdLine/GitAnnex.hs view
@@ -56,6 +56,7 @@ import qualified Command.Describe import qualified Command.InitRemote import qualified Command.EnableRemote+import qualified Command.VerifyRemote import qualified Command.ConfigRemote import qualified Command.RenameRemote import qualified Command.DisableRemote@@ -69,6 +70,7 @@ import qualified Command.Unlock import qualified Command.Lock import qualified Command.PreCommit+import qualified Command.PrePush import qualified Command.PostReceive import qualified Command.FilterBranch import qualified Command.Find@@ -174,6 +176,7 @@ 	, Command.Describe.cmd 	, Command.InitRemote.cmd 	, Command.EnableRemote.cmd+	, Command.VerifyRemote.cmd 	, Command.ConfigRemote.cmd 	, Command.RenameRemote.cmd 	, Command.DisableRemote.cmd@@ -184,6 +187,7 @@ 	, Command.Uninit.cmd 	, Command.Reinit.cmd 	, Command.PreCommit.cmd+	, Command.PrePush.cmd 	, Command.PostReceive.cmd 	, Command.NumCopies.cmd 	, Command.MinCopies.cmd
CmdLine/GitRemoteAnnex.hs view
@@ -27,6 +27,7 @@ import qualified Annex.Url as Url import qualified Types.Remote as Remote import qualified Logs.Remote+import qualified Logs.VerifiedRemote import qualified Remote.External import Remote.Helper.Encryptable (parseEncryptionMethod) import Annex.Transfer@@ -52,6 +53,7 @@ import Annex.SpecialRemote.Config import Remote.List import Remote.List.Util+import Remote.Helper.ReadOnly import Utility.Tmp import Utility.Tmp.Dir import Utility.Env@@ -613,7 +615,9 @@ 				-- This change will never be committed to the 				-- git-annex branch. 				Logs.Remote.configSet cu c'+				Logs.VerifiedRemote.configSet cu c' 			Nothing -> noop+		setRemoteConfigVerification remotename RemoteConfigVerified 		remotesChanged 		getEnabledSpecialRemoteByName remotename >>= \case 			Just rmt -> return rmt@@ -684,7 +688,9 @@ 	| otherwise = do 		m <- Logs.Remote.remoteConfigMap 		r <- Remote.getRepo rmt-		remoteGen' adjustconfig m (Remote.remotetype rmt) r >>= \case+		u <- getRepoUUID r+		gc <- Annex.getRemoteGitConfig r+		remoteGen' adjustconfig adjustReadOnly m (Remote.remotetype rmt) r gc u >>= \case 			Just rmt' -> return rmt' 			Nothing -> giveup "Failed to use importtree=yes remote."   where
Command/EnableRemote.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2013-2024 Joey Hess <id@joeyh.name>+ - Copyright 2013-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -12,6 +12,7 @@ import Command import qualified Annex import qualified Logs.Remote+import qualified Logs.VerifiedRemote import qualified Types.Remote as R import qualified Git import qualified Annex.SpecialRemote as SpecialRemote@@ -20,10 +21,13 @@ import qualified Command.InitRemote import Logs.UUID import Annex.UUID+import Annex.Hook import Config import Config.DynamicConfig import Types.GitConfig+import Types.RemoteConfig import Types.ProposedAccepted+import Command.VerifyRemote (remoteVerificationMessage)  import qualified Data.Map as M @@ -116,23 +120,35 @@  performSpecialRemote :: EnableRemoteOptions -> PerformSpecialRemote performSpecialRemote o t u name oldc c gc mcu = do-	-- Avoid enabling a special remote if there is another remote-	-- with the same name. 	rs <- Remote.remoteList-	case filter (\rmt -> Remote.name rmt == name) rs of-		(rmt:_) | Remote.uuid rmt /= u ->-			giveup $ "Not overwriting currently configured git remote named \"" ++ name ++ "\""-		_ -> noop+	prevrmt <- case filter (\rmt -> Remote.name rmt == name) rs of+		(rmt:_) -> return (Just rmt)+		_ -> return Nothing+	unless (maybe u Remote.uuid prevrmt == u) $+		giveup $ "Not overwriting currently configured git remote named \"" ++ name ++ "\""+	enablePrePushHook >>= \case+		Nothing -> noop+		Just msg -> giveup $ "Cannot enable this special remote because " ++ msg+	let reenabling = isJust prevrmt 	(c', u') <- R.setup t (R.Enable oldc) (Just u) name Nothing c gc-	next $ cleanupSpecialRemote o t u' c' mcu+	next $ cleanupSpecialRemote o t u' c' mcu reenabling name -cleanupSpecialRemote :: EnableRemoteOptions -> RemoteType -> UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandCleanup-cleanupSpecialRemote o t u c mcu = do-	case mcu of-		Nothing -> Logs.Remote.configSet u c+cleanupSpecialRemote :: EnableRemoteOptions -> RemoteType -> UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> Bool -> RemoteName -> CommandCleanup+cleanupSpecialRemote o t u c mcu reenabling name = do+	cu <- case mcu of+		Nothing -> do+			Logs.Remote.configSet u c+			return u 		Just (SpecialRemote.ConfigFrom cu) -> do 			setRemoteConfigUUID c cu 			Logs.Remote.configSet cu c+			return cu+	if reenabling+		then Logs.VerifiedRemote.configUpdate cu c+		else setRemoteConfigVerification name RemoteConfigUnverifiedManualEnabled+	remoteVerificationMessage name cu c >>= \case+		Just msg -> showLongNote (UnquotedString msg)+		Nothing -> noop 	Remote.byUUID u >>= \case 		Nothing -> noop 		Just r -> do
Command/Init.hs view
@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2010-2020 Joey Hess <id@joeyh.name>+ - Copyright 2010-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -14,6 +14,7 @@ import Annex.Version import Annex.Startup import Types.RepoVersion+import qualified Annex import qualified Annex.SpecialRemote  import Control.Monad.Fail as Fail (MonadFail(..))@@ -72,20 +73,23 @@  perform :: InitOptions -> CommandPerform perform os = do+	startversion <- getVersion 	case initVersion os of 		Nothing -> noop-		Just wantversion -> getVersion >>= \case+		Just wantversion -> case startversion of 			Just v | v /= wantversion -> 				giveup $ "This repository is already a initialized with version " ++ show (fromRepoVersion v) ++ ", not changing to requested version." 			_ -> noop 	initialize startupAnnex 		(if null (initDesc os) then Nothing else Just (initDesc os)) 		(initVersion os)-	unless (noAutoEnable os)+	unless (noAutoEnable os || isJust startversion) $ 		Annex.SpecialRemote.autoEnable 	next $ return True  performAutoEnableOnly :: CommandPerform performAutoEnableOnly = do+	unlessM (Annex.getRead Annex.force) $+		giveup "It is not safe to autoenable new special remotes if any other git-annex processes may be running. Pass --force if you are sure you want to do this." 	Annex.SpecialRemote.autoEnable 	next $ return True
Command/InitRemote.hs view
@@ -16,7 +16,8 @@ import Types.RemoteConfig import Annex.UUID import Logs.UUID-import Logs.Remote+import qualified Logs.Remote+import qualified Logs.VerifiedRemote import Types.GitConfig import Types.ProposedAccepted import Config@@ -96,7 +97,7 @@ 			(sameas o)  		c <- newConfig name sameasuuid 			(Logs.Remote.keyValToConfig Proposed ws)-			<$> remoteConfigMap+			<$> Logs.Remote.remoteConfigMap 		t <- either giveup return (findType c) 		a c t 	@@ -129,10 +130,13 @@ 			describeUUID u (toUUIDDesc name) 			propigateInitGitConfigs u 			Logs.Remote.configSet u c+			Logs.VerifiedRemote.configSet u c 		Just _ -> do 			cu <- liftIO genUUID 			setRemoteConfigUUID c cu 			Logs.Remote.configSet cu c+			Logs.VerifiedRemote.configSet cu c+	setRemoteConfigVerification name RemoteConfigVerified 	when (withUrl o) $ 		setAnnexUrl c 	unless (Remote.gitSyncableRemoteType t || withUrl o) $
+ Command/PrePush.hs view
@@ -0,0 +1,30 @@+{- git-annex command+ -+ - Copyright 2026 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Command.PrePush where++import Command+import Remote.List+import Types.Remote+import qualified Logs.Remote+import Logs.VerifiedRemote++cmd :: Command+cmd = noCommit $ command "pre-push" SectionPlumbing+	"run by git pre-push hook"+	paramPaths+	(withParams seek)++seek :: CmdParams -> CommandSeek+seek _ = do+	rs <- map (\r -> (uuid r, gitconfig r, Just (name r))) <$> remoteList+	m <- Logs.Remote.remoteConfigMap+	unverifiedRemoteAmelioration rs m >>= \case+		Nothing -> noop+		Just amelioration ->+			maybe noop giveup $+				preventGitPush amelioration
+ Command/VerifyRemote.hs view
@@ -0,0 +1,257 @@+{- git-annex command+ -+ - Copyright 2026 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE OverloadedStrings #-}++module Command.VerifyRemote where++import Command+import qualified Logs.Remote+import qualified Logs.VerifiedRemote+import Logs.VerifiedRemote (VerifyingRemoteConfigId(..))+import qualified Remote+import qualified Types.Remote as Remote+import Types.RemoteConfig+import Types.ProposedAccepted+import Config+import Annex.SpecialRemote.Config++import qualified Data.Map as M+import qualified Data.Set as S++cmd :: Command+cmd = command "verifyremote" SectionSetup+	"verify if a special remote is safe to use"+	paramName+	(seek <$$> optParser)++data VerifyRemoteOptions = VerifyRemoteOptions+	{ remote :: DeferredParse Remote+	, safeunsafe :: Maybe SafeUnsafe+	}++data SafeUnsafe = Safe VerifyingRemoteConfigId | Unsafe++optParser :: CmdParamsDesc -> Parser VerifyRemoteOptions+optParser _ = VerifyRemoteOptions+	<$> (mkParseRemoteOption <$> remotearg)+	<*> optional safeUnsafeParser+  where+	remotearg = strArgument+		( metavar paramRemote+		<> help "remote to verify"+		<> completeRemotes+		)++safeUnsafeParser :: Parser SafeUnsafe+safeUnsafeParser = safe <|> unsafe+  where+	safe = option (Safe . VerifyingRemoteConfigId <$> maybeReader readish)+		( long "safe" <> metavar "ID"+		<> help "special remote configuration is safe"+		)+	unsafe = flag' Unsafe+		( long "unsafe"+		<> help "special remote configuration is unsafe"+		)++seek :: VerifyRemoteOptions -> CommandSeek+seek = commandAction . start++start :: VerifyRemoteOptions -> CommandStart+start o = do+	r <- getParsed (remote o)+	let si = SeekInput [Remote.name r]+	let ai = ActionItemUUID+		(Remote.uuid r)+		(UnquotedString (Remote.name r))+	case safeunsafe o of+		Just (Safe cid) -> starting "verifyremote" ai si $+			performVerifySafe cid r+		Just Unsafe -> starting "verifyremote" ai si $+			performVerifyUnsafe r+		Nothing -> startVerify r si++startVerify :: Remote -> SeekInput -> CommandStart+startVerify r si = do+	showCustom "verifyremote" si $ do+		remoteconfig <- getUnverifiedRemoteConfig (logUUID r)+		cid <- Logs.VerifiedRemote.storeVerifyingRemoteLog remoteconfig+		verifiedremoteconfig <- getVerifiedRemoteConfig (logUUID r)+		let msg = fromMaybe nochanges $+			remoteVerificationMessage' (Remote.name r) remoteconfig cid verifiedremoteconfig+		showRaw (encodeBS msg)+		return True+	stop+  where+	nochanges = "There have been no changes to the remote's configuration since it was last verified."++remoteVerificationMessage :: RemoteName -> UUID -> RemoteConfig -> Annex (Maybe String)+remoteVerificationMessage remotename u remoteconfig = +	remoteVerificationMessage' remotename remoteconfig+		<$> Logs.VerifiedRemote.storeVerifyingRemoteLog remoteconfig+		<*> getVerifiedRemoteConfig u++-- Nothing when there are no changes to the RemoteConfig +-- that need verification.+remoteVerificationMessage' :: RemoteName -> RemoteConfig -> VerifyingRemoteConfigId -> RemoteConfig -> Maybe String+remoteVerificationMessage' remotename remoteconfig cid verifiedremoteconfig+	| visiblefields verifiedremoteconfig == visibleremoteconfig = Nothing+	| otherwise = Just $+		if verifiedremoteconfig /= mempty+			then updatemessage+			else newmessage+  where+	newmessage = unlines+		[ "This is the configuration of the remote:"+		, "\t" ++ displayRemoteConfig visibleremoteconfig+		, ""+		, askexpected+		, "If so, run:  " ++ verifysafecommand+		, "If not, run: " ++ verifyunsafecommand+		]+	+	updatemessage = unlines+		[ "There is an updated configuration of the remote:"+		, "\t" ++ displayRemoteConfig visibleremoteconfig+		, ""+		, askexpected+		, "If so, run:  " ++ verifysafecommand+		, "If not, you do not need to do anything; the previously"+		, "verified configuration of the remote will continue to"+		, "be used."+		]+	+	askexpected = "Is this a location that you expected to be using?"++	verifysafecommand = "git-annex verifyremote "+		 ++ remotename ++ " --safe "+		 ++ show (fromVerifyingRemoteConfigId cid)++	verifyunsafecommand = "git-annex verifyremote "+		++ remotename ++ " --unsafe"+	+	visibleremoteconfig = visiblefields remoteconfig+	+	visiblefields = Logs.VerifiedRemote.omitUnverifiableFields+		. flip M.withoutKeys omitfields+	+	-- Fields that do not need to be verified.+	omitfields = S.fromList+		[ nameField+		, sameasNameField+		, sameasUUIDField+		]++performVerifySafe :: VerifyingRemoteConfigId -> Remote -> CommandPerform+performVerifySafe cid r = do+	remoteconfig <- getUnverifiedRemoteConfig (logUUID r)+	m <- Logs.VerifiedRemote.readVerifyingRemoteLog+	case M.lookup cid m of+		Just rc+			| rc == Logs.VerifiedRemote.omitUnverifiableFields remoteconfig -> do+				Logs.VerifiedRemote.configSet (logUUID r) remoteconfig+				setRemoteConfigVerification r RemoteConfigVerified+				Logs.VerifiedRemote.removeVerifyingLog cid+				next $ return True+		_ -> do+			warning "invalid ID"+			next $ return False++performVerifyUnsafe :: Remote -> CommandPerform+performVerifyUnsafe r = do+	m <- fromMaybe mempty <$> Logs.VerifiedRemote.readRemoteLog+	let hasverifiedconfig = M.member (logUUID r) m+	warning $ UnquotedString $ unlines $ +		warningVerifyUnsafe+			(Remote.name r)+			hasverifiedconfig+			(remoteAnnexVerified (Remote.gitconfig r))+	next $ return False++warningVerifyUnsafe :: RemoteName -> Bool -> RemoteConfigVerification -> [String]+warningVerifyUnsafe name False RemoteConfigUnverifiedAutoEnabled =+	[ "So the autoenabled remote " ++ name ++ " is in a location"+	, "you did not expect to be using. You may be under attack."+	, ""+	, "No annexed files have been sent to that remote or any other"+	, "remote since it was enabled, and git pushes to all remotes"+	, "have also been prevented since that time."+	, ""+	, "But, annexed files may have been copied from that remote into"+	, "the local repository. There is a risk that those files could"+	, "be sent on to other remotes, or that information in the git-annex"+	, "branch could be pushed later, leaking information about the"+	, "content of " ++ name ++ "."+	, ""+	, "Also, if the remote supports git pulls, branches may have been"+	, "pulled from it into this repository, which may leak data"+	, "to it when pushed elsewhere."+	, ""+	, "Your options for dealing with this include:"+	, "* Identify who caused " ++ name ++ " to be configured this way,"+	, "  and remove any remotes under their control to avoid leaking data"+	, "  to them."+	, "* Delete this local git repository and all its contents."+	, "  A good choice if you know you will not lose any work or data."+	, ""+	, "As long as the remote " ++ name ++ " exists, annexed files"+	, "will continue to be blocked from being sent to any remote,"+	, "and git pushes will also be blocked. Once you have dealt"+	, "with this attack, you can unblock by running:"+	, "\tgit remote remove " ++ name+	]+warningVerifyUnsafe name False RemoteConfigUnverifiedManualEnabled =+	[ "So the remote " ++ name ++ " is in a location you did not expect"+	, "to be using. You may be under attack."+	, ""+	, "No annexed files have been sent to or retrieved from the"+	, "remote since it was enabled."+	, ""+	, "But, if the remote supports git fetch, branches may have been"+	, "pulled from it into this repository. If you determine that"+	, "git has fetched information from the remote, you may need to"+	, "clean up those branches to avoid leaking information from the"+	, "remote. Bear in mind that the git-annex branch could be amoung"+	, "them."+	, ""+	, "Git pushes to all remotes have been blocked since remote"+	, name ++ " was enabled, and will stay blocked as long as it exists."+	, "Once you have dealt with this attack, you can unblock by running:"+	, "\tgit remote remove " ++ name+	]+warningVerifyUnsafe name _ _ =+	[ "Unfortunately, information may have leaked from " ++ name ++ "."+	, ""+	, "Either it has already been verified as safe, or it was"+	, "enabled by a previous version of git-annex that did not verify"+	, "the location of special remotes. So nothing prevented"+	, "information from it being sent to other remotes."+	]++getUnverifiedRemoteConfig :: UUID -> Annex RemoteConfig+getUnverifiedRemoteConfig u = do+	m <- Logs.Remote.readRemoteLog+	return $ fromMaybe mempty (M.lookup u m)++getVerifiedRemoteConfig :: UUID -> Annex RemoteConfig+getVerifiedRemoteConfig u = do+	m <- fromMaybe mempty <$> Logs.VerifiedRemote.readRemoteLog+	return $ fromMaybe mempty (M.lookup u m)++logUUID :: Remote -> UUID+logUUID r = fromMaybe (Remote.uuid r) $+	remoteAnnexConfigUUID (Remote.gitconfig r)++displayRemoteConfig :: RemoteConfig -> String+displayRemoteConfig = intercalate " " . map display . sortBy order . M.toList+  where+	display (f, v) =+		fromProposedAccepted f ++ "=" ++ fromProposedAccepted v+	order (f1, v1) (f2, v2) = +		conventionalConfigOrder f1 f2 <> compare v1 v2+
Config.hs view
@@ -99,6 +99,12 @@ setRemoteSkipFetchAll :: RemoteNameable r => r -> Bool -> Annex () setRemoteSkipFetchAll r b = setConfig (remoteConfig r "skipFetchAll") (Git.Config.boolConfig b) +setRemoteConfigVerification :: RemoteNameable r => r -> RemoteConfigVerification -> Annex ()+setRemoteConfigVerification r = +	maybe (unsetConfig c) (setConfig c) . formatRemoteConfigVerification+  where+	c = remoteAnnexConfig r "verified"+ isBareRepo :: Annex Bool isBareRepo = fromRepo Git.repoIsLocalBare
Logs/File.hs view
@@ -1,6 +1,6 @@ {- git-annex log files  -- - Copyright 2018-2023 Joey Hess <id@joeyh.name>+ - Copyright 2018-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -9,10 +9,12 @@  module Logs.File ( 	writeLogFile,+	writeLogFile', 	withLogHandle, 	appendLogFile, 	appendLogFile', 	modifyLogFile,+	readLogFile, 	streamLogFile, 	streamLogFileUnsafe, 	checkLogFile,@@ -36,10 +38,13 @@ -- making the new file have whatever permissions the git repository is -- configured to use. Creates the parent directory when necessary. writeLogFile :: OsPath -> String -> Annex ()-writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog f c+writeLogFile f c = writeLogFile' f (\tmp -> writeFileString tmp c)++writeLogFile' :: OsPath -> (OsPath -> IO ()) -> Annex ()+writeLogFile' f writer = createDirWhenNeeded f $ viaTmp writelog f ()   where-	writelog tmp c' = do-		liftIO $ writeFileString tmp c'+	writelog tmp () = do+		liftIO $ writer tmp 		setAnnexFilePerm tmp  -- | Runs the action with a handle connected to a temp file.@@ -89,6 +94,10 @@ 	writelog lf b = do 		liftIO $ F.writeFile lf b 		setAnnexFilePerm lf++-- | Reads a log file if it exists.+readLogFile :: OsPath -> OsPath -> Annex (Maybe L.ByteString)+readLogFile f lck = withSharedLock lck $ liftIO $ tryWhenExists $ F.readFile f  -- | Checks the content of a log file to see if any line matches. checkLogFile :: OsPath -> OsPath -> (L.ByteString -> Bool) -> Annex Bool
Logs/Remote.hs view
@@ -25,6 +25,7 @@ import Logs import Logs.UUIDBased import Logs.Remote.Pure+import qualified Logs.VerifiedRemote import Annex.SpecialRemote.Config  import qualified Data.Map as M@@ -39,18 +40,28 @@ 			. parseRemoteConfigLog 	Annex.changeState $ \s -> s { Annex.remoteconfigmap = Nothing } -{- Map of remotes by uuid containing key/value config maps.- - Cached for speed. -}+{- Map of remotes by uuid with their RemoteConfigs. Cached for speed.+ -+ - When the verified remote log has a RemoteConfig, it is used, otherwise+ - the value from the git-annex branch log is used. This ensures that, once+ - a user has verified a RemoteConfig, it does not change unexpectedly.+ - + - Fields that are not verifiable are always taken from the git-annex+ - branch log.+ -} remoteConfigMap :: Annex (M.Map UUID RemoteConfig)-remoteConfigMap = maybe remoteConfigMapLoad return-	=<< Annex.getState Annex.remoteconfigmap--remoteConfigMapLoad :: Annex (M.Map UUID RemoteConfig)-remoteConfigMapLoad = do-	m <- readRemoteLog-	Annex.changeState $ \s -> s { Annex.remoteconfigmap = Just m }-	return m+remoteConfigMap = maybe load return =<< Annex.getState Annex.remoteconfigmap+  where+	load = do+		logged <- readRemoteLog+		verified <- Logs.VerifiedRemote.addUnverifiableFields logged+			. fromMaybe mempty+			<$> Logs.VerifiedRemote.remoteConfigMap+		let m = M.union verified logged+		Annex.changeState $ \s ->+			s { Annex.remoteconfigmap = Just m }+		return m  readRemoteLog :: Annex (M.Map UUID RemoteConfig)-readRemoteLog = calcRemoteConfigMap +readRemoteLog = calcRemoteConfigMap 	<$> Annex.Branch.get remoteLog
Logs/Remote/Pure.hs view
@@ -7,10 +7,13 @@  module Logs.Remote.Pure ( 	calcRemoteConfigMap,+	calcRemoteConfigMapBase, 	parseRemoteConfigLog, 	buildRemoteConfigLog,+	remoteConfigParser,         keyValToConfig,         configToKeyVal,+	buildRemoteConfig,         showConfig,          prop_isomorphic_configEscape,@@ -32,17 +35,22 @@  calcRemoteConfigMap :: L.ByteString -> M.Map UUID RemoteConfig calcRemoteConfigMap = (\m -> M.map (addSameasInherited m) m)-	. simpleMap-	. parseRemoteConfigLog+	. calcRemoteConfigMapBase +calcRemoteConfigMapBase :: L.ByteString -> M.Map UUID RemoteConfig+calcRemoteConfigMapBase = simpleMap . parseRemoteConfigLog+ parseRemoteConfigLog :: L.ByteString -> Log RemoteConfig parseRemoteConfigLog = parseLogOld remoteConfigParser  buildRemoteConfigLog :: Log RemoteConfig -> Builder-buildRemoteConfigLog = buildLogOld (byteString . encodeBS . showConfig)+buildRemoteConfigLog = buildLogOld buildRemoteConfig  remoteConfigParser :: A.Parser RemoteConfig remoteConfigParser = keyValToConfig Accepted . words . decodeBS <$> A.takeByteString++buildRemoteConfig :: RemoteConfig -> Builder+buildRemoteConfig = byteString . encodeBS . showConfig  showConfig :: RemoteConfig -> String showConfig = unwords . configToKeyVal
+ Logs/VerifiedRemote.hs view
@@ -0,0 +1,276 @@+{- git-annex verified remote log+ - + - This is similar to the git-annex remote log, but only remote configs+ - that have been verified by the user to be safe to use.+ -+ - Copyright 2026 Joey Hess <id@joeyh.name>+ - + - Licensed under the GNU AGPL version 3 or higher.+ -}++{-# LANGUAGE TupleSections #-}++module Logs.VerifiedRemote (+	remoteConfigMap,+	readRemoteLog,+	configSet,+	configUpdate,+	omitUnverifiableFields,+	addUnverifiableFields,+	VerifyingRemoteConfigId(..),+	UnverifiedRemoteAmelioration(..),+	unverifiedRemoteAmelioration,+	readVerifyingRemoteLog,+	storeVerifyingRemoteLog,+	removeVerifyingLog+) where++import Annex.Common+import qualified Annex+import Types.Remote+import Types.VectorClock+import Logs.File+import Logs.UUIDBased+import Logs.Remote.Pure+import Logs.MapLog+import Annex.SpecialRemote.Config+import qualified Utility.FileIO as F++import qualified Data.Map as M+import qualified Data.ByteString.Lazy as L+import qualified Data.Attoparsec.ByteString.Char8 as A8+import Data.ByteString.Builder++configSet :: UUID -> RemoteConfig -> Annex ()+configSet u c = configSetMulti [(u, c)]++{- Only sets the RemoteConfig if the log already contains a RemoteConfig+ - for this UUID. -}+configUpdate :: UUID -> RemoteConfig -> Annex ()+configUpdate u c = configSetMulti' (M.member u . fromMapLog) [(u, c)]++configSetMulti :: [(UUID, RemoteConfig)] -> Annex ()+configSetMulti = configSetMulti' (const True)++configSetMulti'+	:: (Log RemoteConfig -> Bool)+	-> [(UUID, RemoteConfig)]+	-> Annex ()+configSetMulti' shouldset ucfgs = do+	c <- currentVectorClock+	logf <- fromRepo gitAnnexVerifiedRemoteLog+	lck <- fromRepo gitAnnexVerifiedRemoteLock+	old <- parseRemoteConfigLog . fromMaybe mempty+		<$> readLogFile logf lck+	writeLogFile' logf $ \tmp -> F.writeFile tmp $+		toLazyByteString $ buildRemoteConfigLog $+			foldl' (accumchange c) old ucfgs+	Annex.changeState $ \s ->+		s { Annex.verifiedremoteconfigmap = Nothing }+  where+	accumchange c old (u, cfg)+		| shouldset old =+			changeLog c u (omitUnverifiableFields cfg) old+		| otherwise = old++{- Hidden encryption fields cannot be verified by the user, and in any+ - case do not configure the location that the remote accesses, and so+ - are omitted from this log file.+ -}+omitUnverifiableFields :: RemoteConfig -> RemoteConfig+omitUnverifiableFields c = M.withoutKeys c hiddenEncryptionFields++addUnverifiableFields+	:: M.Map UUID RemoteConfig+	-> M.Map UUID RemoteConfig+	-> M.Map UUID RemoteConfig+addUnverifiableFields unverifiedconfigs verifiedconfigs =+	M.mapWithKey go verifiedconfigs+  where+	go u verifiedconfig = case M.lookup u unverifiedconfigs of+		Just unverifiedconfig ->+			let unverifiable = M.restrictKeys+				unverifiedconfig+				hiddenEncryptionFields+			in M.union unverifiable verifiedconfig+		Nothing -> verifiedconfig++{- Map of remotes by uuid with their RemoteConfigs. Cached for speed.+ -+ - Nothing when the verified remote config log file does not exist yet.+ -}+remoteConfigMap :: Annex (Maybe (M.Map UUID RemoteConfig))+remoteConfigMap =+	maybe load return =<< Annex.getState Annex.verifiedremoteconfigmap+  where+	load = do+		m <- readRemoteLog+		Annex.changeState $ \s ->+			s { Annex.verifiedremoteconfigmap = Just m }+		return m++readRemoteLog :: Annex (Maybe (M.Map UUID RemoteConfig))+readRemoteLog = do+	logf <- fromRepo gitAnnexVerifiedRemoteLog+	lck <- fromRepo gitAnnexVerifiedRemoteLock+	fmap calcRemoteConfigMapBase <$> readLogFile logf lck++data UnverifiedRemoteAmelioration = UnverifiedRemoteAmelioration+	{ preventGitPush :: Maybe String+	-- ^ Prevent git push to all remotes.+	, preventAnnexWrite :: Maybe String+	-- ^ Prevent any git-annex object modification of all remotes.+	, preventAnnexAccess :: UUID -> Maybe String+	-- ^ Prevent any git-annex object access to remotes whose UUID+	-- the function selects. The returned message explains why.+	}++{- Given a list of UUIDs of all currently enabled remotes, check if any of+ - them are not in the verified remote log, and depending on their+ - remote.name.unverified configuration, returns the necessary+ - amelioration to prevent exfiltation of data from an unverified remote+ - to an attacker controlled remote.+ -}+unverifiedRemoteAmelioration+	:: [(UUID, RemoteGitConfig, Maybe RemoteName)]+	-> (M.Map UUID RemoteConfig)+	-- ^ Logs.Remote.remoteConfigMap+	-> Annex (Maybe UnverifiedRemoteAmelioration)+unverifiedRemoteAmelioration rs configmap = remoteConfigMap >>= \case+	Just m -> return $ +		let l = mapMaybe (notinmap m) rs+		in Just $ UnverifiedRemoteAmelioration+			{ preventGitPush = +				checkprevented pushblocker l "Push"+			, preventAnnexWrite =+				checkprevented writeblocker l "Write"+			, preventAnnexAccess =+				accessblocker l+			}++	-- The log file does not exist yet. This is either a newly+	-- initialized repository, or git-annex has been upgraded from a+	-- version that did not use this log.+	--+	-- Handle upgrade by populating the log with the+	-- current configs of all the currently enabled remotes.+	--+	-- In a newly initialized repository, there are not yet+	-- any enabled remotes, and this creates an empty log file.+	Nothing -> do+		configSetMulti $ mapMaybe (copyfromconfigmap configmap) rs+		return Nothing+  where+	-- Any special remote that is unverified prevents git push to all+	-- remotes.+	pushblocker (_, gc, remotename)+		| remoteAnnexVerified gc /= RemoteConfigVerified = remotename+		| otherwise = Nothing++	-- Any autoenabled special remote that is unverified prevents+	-- annex object write to all remotes.+	writeblocker (_, gc, remotename)+		| remoteAnnexVerified gc == RemoteConfigUnverifiedAutoEnabled = remotename+		| remoteAnnexVerified gc == RemoteConfigUnverified = remotename+		| otherwise = Nothing++	-- Prevent annex object access to any special remote that was+	-- enabled manually but is not yet verified.+	accessblocker l u = case filter (\(u',_, _) -> u' == u) l of+		((_, gc, Just remotename):_)+			| remoteAnnexVerified gc == RemoteConfigUnverifiedManualEnabled ->+				preventedunverified remotename+			| remoteAnnexVerified gc == RemoteConfigUnverified ->+				preventedunverified remotename+		_ -> Nothing+	+	prevented remotename msg = Just $ unwords+		[ msg+		, "Run this command to verify it:"+		, "git-annex verifyremote"+		, remotename+		]++	preventdueto remotetoverify action =+		prevented remotetoverify $ unwords+			[ action+			, "prevented due to an unverified special"+			, "remote."+			]+	+	preventedunverified remotename = +		prevented remotename $+			"This special remote cannot be used since " ++ +				"it's not verified."++	checkprevented blocker l action =+		case mapMaybe blocker l of+			[] -> Nothing+			(remotename:_) -> preventdueto remotename action+	+	notinmap m i@(u, gc, _)+		| M.notMember u' configmap = Nothing+		| M.member u' m = Nothing+		| otherwise = Just i+	  where+		u' = getcu u gc++	copyfromconfigmap m (u, gc, _) =+		(getcu u gc, ) <$> M.lookup u m+	+	getcu u gc = fromMaybe u (remoteAnnexConfigUUID gc)++data VerifyingRemoteConfigId = VerifyingRemoteConfigId+	{ fromVerifyingRemoteConfigId :: Integer }+	deriving (Eq, Ord)++readVerifyingRemoteLog :: Annex (M.Map VerifyingRemoteConfigId RemoteConfig)+readVerifyingRemoteLog = do+	logf <- fromRepo gitAnnexVerifyingRemoteLog+	lck <- fromRepo gitAnnexVerifyingRemoteLock+	simpleMap . parseVerifyingRemoteLog . fromMaybe mempty+		<$> readLogFile logf lck++storeVerifyingRemoteLog :: RemoteConfig -> Annex VerifyingRemoteConfigId+storeVerifyingRemoteLog cfg =+	modifyVerifyingRemoteLog $ \c n ->+		changeMapLog c n (omitUnverifiableFields cfg)++removeVerifyingLog :: VerifyingRemoteConfigId -> Annex ()+removeVerifyingLog n =+	void $ modifyVerifyingRemoteLog+		(\_ _ (MapLog m) -> MapLog (M.delete n m))++modifyVerifyingRemoteLog+	 :: (CandidateVectorClock -> VerifyingRemoteConfigId -> MapLog VerifyingRemoteConfigId RemoteConfig -> MapLog VerifyingRemoteConfigId RemoteConfig)+	 -> Annex VerifyingRemoteConfigId+modifyVerifyingRemoteLog f = do+	c <- currentVectorClock+	logf <- fromRepo gitAnnexVerifyingRemoteLog+	lck <- fromRepo gitAnnexVerifyingRemoteLock+	old <- parseVerifyingRemoteLog . fromMaybe mempty+		<$> readLogFile logf lck+	let nextcid = VerifyingRemoteConfigId $ succ $+		maybe 0 fromVerifyingRemoteConfigId $+		headMaybe $ reverse $ M.keys $ simpleMap old+	writeLogFile' logf $ \tmp -> F.writeFile tmp $+		toLazyByteString $ buildVerifyingRemoteLog (f c nextcid old)+	return nextcid++parseVerifyingRemoteLog+	:: L.ByteString+	-> MapLog VerifyingRemoteConfigId RemoteConfig+parseVerifyingRemoteLog =+	parseMapLog parseVerifyingRemoteConfigId remoteConfigParser++buildVerifyingRemoteLog+	:: MapLog VerifyingRemoteConfigId RemoteConfig+	-> Builder+buildVerifyingRemoteLog = +	buildMapLog buildVerifyingRemoteConfigId buildRemoteConfig++parseVerifyingRemoteConfigId :: A8.Parser VerifyingRemoteConfigId+parseVerifyingRemoteConfigId = VerifyingRemoteConfigId <$> A8.decimal++buildVerifyingRemoteConfigId :: VerifyingRemoteConfigId -> Builder+buildVerifyingRemoteConfigId = integerDec . fromVerifyingRemoteConfigId
NEWS view
@@ -1,3 +1,16 @@+git-annex (10.20261026) upstream; urgency=high++  A security fix has changed git-annex's behavior in several ways when+  enabling special remotes. The new git-annex verify command needs to be+  used to verify that the configuration of a special remote is safe. +  git-annex will prompt in situations where that is needed.++  Also, changes to a special remote configuration received in the git-annex+  branch no longer take effect until git-annex verifyremote is run to review+  and verify the new configuration.++ -- Joey Hess <id@joeyh.name>  Fri, 16 Oct 2026 09:29:27 -0400+ git-annex (10.20230626) upstream; urgency=medium    Many commands now quote filenames that contain unusual characters the
Remote/External.hs view
@@ -99,9 +99,9 @@ 			exportUnsupported 			importUnsupported 		return $ Just $ specialRemote c-			readonlyStorer+			(readonlyStorer readonlyWarning) 			(retrieveUrlReadOnly gc)-			readonlyRemoveKey+			(readonlyRemoveKey readonlyWarning) 			(checkKeyUrlReadOnly gc) 			rmt 	| otherwise = do
Remote/Helper/ReadOnly.hs view
@@ -1,15 +1,17 @@ {- Adds readonly support to remotes.  -- - Copyright 2013-2019 Joey Hess <id@joeyh.name>+ - Copyright 2013-2026 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}  module Remote.Helper.ReadOnly 	( adjustReadOnly+	, forceReadOnly 	, readonlyStoreKey 	, readonlyStorer 	, readonlyRemoveKey+	, readonlyWarning 	) where  import Annex.Common@@ -26,50 +28,60 @@  -} adjustReadOnly :: Remote -> Remote adjustReadOnly r-	| remoteAnnexReadOnly (gitconfig r) = r-		{ storeKey = readonlyStoreKey-		, removeKey = readonlyRemoveKey-		, repairRepo = Nothing-		, exportActions = (exportActions r)-			{ storeExport = readonlyStoreExport-			, removeExport = readonlyRemoveExport-			, removeExportDirectory = Just readonlyRemoveExportDirectory-			, renameExport = Nothing-			}-		, exportImportActions = (exportImportActions r)-			{ storeExportWithContentIdentifier = readonlyStoreExportWithContentIdentifier-			, removeExportWithContentIdentifier = readonlyRemoveExportWithContentIdentifier-			, removeExportDirectoryWhenEmpty = Just readonlyRemoveExportDirectory-			}-		}+	| remoteAnnexReadOnly (gitconfig r) = makeReadOnly readonlyWarning r 	| otherwise = r -readonlyStoreKey :: Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()-readonlyStoreKey _ _ _ _ = readonlyFail+{- Force a remote that would not usually be read-only to be read-only,+ - with a message explaining why. -}+forceReadOnly :: String -> Remote -> Remote+forceReadOnly msg r+	| remoteAnnexReadOnly (gitconfig r) = makeReadOnly readonlyWarning r+	| otherwise = makeReadOnly msg r -readonlyRemoveKey :: Maybe SafeDropProof -> Key -> Annex ()-readonlyRemoveKey _ _ = readonlyFail+makeReadOnly :: String -> Remote -> Remote+makeReadOnly msg r = r+	{ storeKey = readonlyStoreKey msg+	, removeKey = readonlyRemoveKey msg+	, repairRepo = Nothing+	, exportActions = (exportActions r)+		{ storeExport = readonlyStoreExport msg+		, removeExport = readonlyRemoveExport msg+		, removeExportDirectory = Just (readonlyRemoveExportDirectory msg)+		, renameExport = Nothing+		}+	, exportImportActions = (exportImportActions r)+		{ storeExportWithContentIdentifier = readonlyStoreExportWithContentIdentifier msg+		, removeExportWithContentIdentifier = readonlyRemoveExportWithContentIdentifier msg+		, removeExportDirectoryWhenEmpty = Just (readonlyRemoveExportDirectory msg)+		}+	} -readonlyStorer :: Storer-readonlyStorer _ _ _ = readonlyFail+readonlyStoreKey :: String -> Key -> AssociatedFile -> Maybe OsPath -> MeterUpdate -> Annex ()+readonlyStoreKey msg _ _ _ _ = readonlyFail msg -readonlyStoreExport :: OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex ()-readonlyStoreExport _ _ _ _ = readonlyFail+readonlyRemoveKey :: String -> Maybe SafeDropProof -> Key -> Annex ()+readonlyRemoveKey msg _ _ = readonlyFail msg -readonlyRemoveExport :: Key -> ExportLocation -> Annex ()-readonlyRemoveExport _ _ = readonlyFail+readonlyStorer :: String -> Storer+readonlyStorer msg _ _ _ = readonlyFail msg -readonlyRemoveExportDirectory :: ExportDirectory -> Annex ()-readonlyRemoveExportDirectory _ = readonlyFail+readonlyStoreExport :: String -> OsPath -> Key -> ExportLocation -> MeterUpdate -> Annex ()+readonlyStoreExport msg _ _ _ _ = readonlyFail msg -readonlyStoreExportWithContentIdentifier :: OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier-readonlyStoreExportWithContentIdentifier _ _ _ _ _ = readonlyFail+readonlyRemoveExport :: String -> Key -> ExportLocation -> Annex ()+readonlyRemoveExport msg _ _ = readonlyFail msg -readonlyRemoveExportWithContentIdentifier :: Key -> ExportLocation -> [ContentIdentifier] -> Annex ()-readonlyRemoveExportWithContentIdentifier _ _ _ = readonlyFail+readonlyRemoveExportDirectory :: String -> ExportDirectory -> Annex ()+readonlyRemoveExportDirectory msg _ = readonlyFail msg -readonlyFail :: Annex a-readonlyFail = giveup readonlyWarning+readonlyStoreExportWithContentIdentifier :: String -> OsPath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier+readonlyStoreExportWithContentIdentifier msg _ _ _ _ _ = readonlyFail msg++readonlyRemoveExportWithContentIdentifier :: String -> Key -> ExportLocation -> [ContentIdentifier] -> Annex ()+readonlyRemoveExportWithContentIdentifier msg _ _ _ = readonlyFail msg++readonlyFail :: String -> Annex a+readonlyFail = giveup  readonlyWarning :: String readonlyWarning = "this remote is readonly"
Remote/List.hs view
@@ -1,6 +1,6 @@ {- git-annex remote list  -- - 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.  -}@@ -11,7 +11,8 @@  import Annex.Common import qualified Annex-import Logs.Remote+import qualified Logs.Remote+import Logs.VerifiedRemote import Types.Remote import Types.RemoteState import Annex.UUID@@ -80,44 +81,102 @@  remoteList' :: Bool -> Annex [Remote] remoteList' autoinit = do-	m <- remoteConfigMap-	rs <- concat <$> mapM (process m) remoteTypes+	m <- Logs.Remote.remoteConfigMap+	l <- concat <$> mapM enumerate' remoteTypes++	let usnames = map (\(u, g, gc, _) -> (u, gc, Git.remoteName g)) l+	adjustremote <- mkadjustremote+		<$> unverifiedRemoteAmelioration usnames m+	+	rs <- catMaybes <$> mapM (generate' adjustremote m) l 	Annex.changeState $ \s -> s 		{ Annex.remotes = rs 		, Annex.remotetypes = remoteTypes 		} 	return rs   where-	process m t = enumerate t autoinit -		>>= mapM (remoteGen m t) -		>>= return . catMaybes+	enumerate' t = do+		gs <- enumerate t autoinit+		forM gs $ \g -> do+			u <- getRepoUUID g+			gc <- Annex.getRemoteGitConfig g+			return (u, g, gc, t) +	generate' adjustremote m (u, g, gc, t) = +		remoteGen adjustremote m t g gc u+	+	mkadjustremote Nothing = adjustReadOnly+	mkadjustremote (Just amelioration) = \r ->+		case preventAnnexAccess amelioration (uuid r) of+			Just msg -> preventaccess r msg+			Nothing -> +				case preventAnnexWrite amelioration of+					Just msg -> forceReadOnly msg r+					Nothing -> adjustReadOnly r++	preventaccess r msg = +		let ro = forceReadOnly msg r+		in ro+			{ retrieveKeyFile = giveup msg+			, retrieveKeyFileCheap = Nothing+			, lockContent = Nothing+			, checkPresent = giveup msg+			, exportActions = (exportActions ro)+				{ retrieveExport = giveup msg+				, checkPresentExport = giveup msg+				}+			, importActions =  (importActions ro)+				{ listImportableContents = giveup msg+				, importKey = giveup msg+				, retrieveImport = giveup msg+				, checkPresentImport = giveup msg+				}+			, exportImportActions = (exportImportActions ro)+				{ listImportableOrExportedContents = giveup msg+				, importKeyWithContentIdentifier = giveup msg+				, retrieveExportWithContentIdentifier = giveup msg+				, checkPresentExportWithContentIdentifier = giveup msg+				}+			, repairKey = Nothing+			, claimUrl = Nothing+			, checkUrl = Nothing+			}+ {- Generates a Remote. -}-remoteGen :: M.Map UUID RemoteConfig -> RemoteType -> Git.Repo -> Annex (Maybe Remote)+remoteGen+	:: (Remote -> Remote)+	-> M.Map UUID RemoteConfig+	-> RemoteType+	-> Git.Repo+	-> RemoteGitConfig+	-> UUID+	-> Annex (Maybe Remote) remoteGen = remoteGen' id  remoteGen' 	:: (RemoteConfig -> RemoteConfig)+	-> (Remote -> Remote) 	-> M.Map UUID RemoteConfig 	-> RemoteType 	-> Git.Repo+	-> RemoteGitConfig+	-> UUID 	-> Annex (Maybe Remote)-remoteGen' adjustconfig m t g = do-	u <- getRepoUUID g-	gc <- Annex.getRemoteGitConfig g+remoteGen' adjustconfig adjustremote m t g gc u = do 	let cu = fromMaybe u $ remoteAnnexConfigUUID gc 	let rs = RemoteStateHandle cu 	let c = adjustconfig (fromMaybe M.empty $ M.lookup cu m) 	generate t g u c gc rs >>= \case 		Nothing -> return Nothing-		Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r)) rs+		Just r -> Just <$> adjustExportImport (adjustremote (addHooks r)) rs  {- Updates a local git Remote, re-reading its git config. -} updateRemote :: Remote -> Annex (Maybe Remote) updateRemote remote = do-	m <- remoteConfigMap-	remote' <- updaterepo =<< getRepo remote-	remoteGen m (remotetype remote) remote'+	m <- Logs.Remote.remoteConfigMap+	g <- updaterepo =<< getRepo remote+	gc <- Annex.getRemoteGitConfig g+	remoteGen adjustReadOnly m (remotetype remote) g gc (uuid remote)   where 	updaterepo r 		| Git.repoIsLocal r || Git.repoIsLocalUnknown r =
Test.hs view
@@ -376,6 +376,8 @@ 	, testCase "addurl" test_addurl 	, testCase "repair" test_repair 	, testCase "enableremote encryption changes" test_enableremote_encryption_changes+	, testCase "autoenable verifyremote" (test_verifyremote True)+	, testCase "enableremote verifyremote" (test_verifyremote False) 	]   where 	mk l = inOrderTestGroup groupname (initTests : map adddep l)@@ -2218,3 +2220,71 @@ 			(Just environ) 			"enableremote enabling already enabled onlyencryptcreds" #endif++test_verifyremote :: Bool -> Assertion+test_verifyremote autoenable = +	withtmpclonerepo $ \r1 -> do+		withtmpclonerepo $ \sr -> do+			intopdir r1 (r1_tests sr)+			withtmpcloneof r1 $ \r2 -> +				intopdir r2 (r2_tests sr)+  where+	srname = "baz"+	r1_tests sr = do+		git_annex "get" [] "get"+		git_annex "pre-push" [""] "pre-push succeeds normally"+		let initoptions = catMaybes+			[ Just srname+			, Just "type=git"+			, if autoenable then Just "autoenable=true" else Nothing+			, Just ("location=../"++sr)+			]+		git_annex "initremote" initoptions "initremote"+		git_annex "pre-push" [""] "pre-push succeeds after initremote"+		git_annex "copy" ["--to", srname] "copy"+	r2_tests sr = do+		unless autoenable $+			git_annex "enableremote" [srname] "enableremote"+		annexaccesstests+		git_annex_shouldfail "pre-push" [""]+			"pre-push blocks with unverified remote"+		git_shouldfail "push" ["origin", "git-annex:git-annex-new"]+			"git push is prevented by unverified remote"+		git_annex "enableremote" [srname, "location=../"++sr]+			"enableremote"+		annexaccesstests -- not changed by second enableremote+		git_annex_shouldfail "pre-push" [""]+			"pre-push blocks with unverified remote after second enableremote"+		git_shouldfail "push" ["origin", "git-annex:git-annex-new"]+			"git push is prevented by unverified remote after second enableremote"+		git_annex "verifyremote" [srname, "--safe", "1"]+			"verifyremote --safe"+		git_annex "move" ["--from=origin"]+			"annex write to other remotes after verifyremote"+		git_annex "move" ["--to", srname]+			"annex write after verifyremote"+		git_annex "pre-push" [""]+			"pre-push succeeds after verifyremote"+		git "push" ["origin", "git-annex:git-annex-new"]+			"git push after verifyremote"+	annexaccesstests+		| autoenable = do+			git_annex_shouldfail "move" ["--from=origin"]+				"annex write to other remotes is prevented by unverified autoenabled remote"+			git_annex_shouldfail "move" ["--from", srname]+				"annex write prevented to autoenabled unverified remote"+			git_annex "get" ["--from", srname]+				"annex read allowed from autoenabled unverified remote"+			git_annex "drop" [] "drop"+			git_annex "get" ["--from=origin"]+				"annex read allowed from other remote with autoenabled unverified remote"+			git_annex "drop" [] "drop"+		| otherwise = do+			git_annex "move" ["--from=origin"]+				"annex write to other remotes is allowed with unverified remote"+			git_annex "move" ["--to=origin"]+				"annex write to other remotes is allowed with unverified remote"+			git_annex_shouldfail "move" ["--from", srname]+				"annex write access not allowed to manually enabled unverified remote"+			git_annex_shouldfail "get" ["--from", srname]+				"annex read access not allowed to manually enabled unverified remote"
Test/Framework.hs view
@@ -198,11 +198,18 @@ withtmpclonerepo :: (FilePath -> Assertion) -> Assertion withtmpclonerepo = withtmpclonerepo' newCloneRepoConfig +withtmpcloneof :: FilePath -> (FilePath -> Assertion) -> Assertion+withtmpcloneof = withtmpclonerepo'' newCloneRepoConfig+ withtmpclonerepo' :: CloneRepoConfig -> (FilePath -> Assertion) -> Assertion withtmpclonerepo' cfg a = do+	origindir <- mainrepodir+	withtmpclonerepo'' cfg origindir a++withtmpclonerepo'' :: CloneRepoConfig -> FilePath -> (FilePath -> Assertion) -> Assertion+withtmpclonerepo'' cfg origindir a = do 	dir <- tmprepodir-	maindir <- mainrepodir-	clone <- clonerepo maindir dir cfg+	clone <- clonerepo origindir dir cfg 	r <- tryNonAsync (a clone) 	case r of 		Right () -> return ()
Types/GitConfig.hs view
@@ -52,6 +52,7 @@ import Types.View import Types.Cluster import Types.Group+import Types.RemoteConfig import Config.DynamicConfig import Utility.HumanTime import Utility.Gpg (GpgCmd, mkGpgCmd)@@ -410,6 +411,7 @@ 	, remoteAnnexPull :: Bool 	, remoteAnnexPush :: Bool 	, remoteAnnexReadOnly :: Bool+	, remoteAnnexVerified :: RemoteConfigVerification 	, remoteAnnexVerify :: Bool 	, remoteAnnexFastCopy :: Bool 	, remoteAnnexCheckUUID :: Bool@@ -492,6 +494,8 @@ 		, remoteAnnexPull = getbool PullField True 		, remoteAnnexPush = getbool PushField True 		, remoteAnnexReadOnly = getbool ReadOnlyField False+		, remoteAnnexVerified = parseRemoteConfigVerification $+			getmaybe VerifiedField 		, remoteAnnexCheckUUID = getbool CheckUUIDField True 		, remoteAnnexVerify = getbool VerifyField True 		, remoteAnnexFastCopy = getbool FastCopyField False@@ -604,6 +608,7 @@ 	| PullField 	| PushField 	| ReadOnlyField+	| VerifiedField 	| CheckUUIDField 	| VerifyField 	| FastCopyField@@ -678,6 +683,7 @@ 	PullField -> inherited True "pull" 	PushField -> inherited True "push" 	ReadOnlyField -> inherited True "readonly"+	VerifiedField -> inherited True "verified" 	CheckUUIDField -> uninherited True "checkuuid" 	VerifyField -> inherited True "verify" 	FastCopyField -> inherited True "fastcopy"
Types/RemoteConfig.hs view
@@ -72,3 +72,31 @@   where 	s = S.fromList (map parserForField (remoteConfigFieldParsers rpc)) 	isnew p = not (S.member (parserForField p) s)++{- Has a RemoteConfig been verified to use the location that the user+ - expected? -}+data RemoteConfigVerification+	= RemoteConfigVerified+	| RemoteConfigUnverifiedManualEnabled+	| RemoteConfigUnverifiedAutoEnabled+	| RemoteConfigUnverified+	-- ^ one or the other, but which is not yet known+	deriving (Eq)++parseRemoteConfigVerification :: Maybe String -> RemoteConfigVerification+parseRemoteConfigVerification (Just "verified") =+	RemoteConfigVerified+parseRemoteConfigVerification (Just "manual") =+	RemoteConfigUnverifiedManualEnabled+parseRemoteConfigVerification (Just "automatic") =+	RemoteConfigUnverifiedAutoEnabled+parseRemoteConfigVerification _ = RemoteConfigUnverified++formatRemoteConfigVerification :: RemoteConfigVerification -> Maybe String+formatRemoteConfigVerification RemoteConfigVerified =+	Just "verified"+formatRemoteConfigVerification RemoteConfigUnverifiedManualEnabled =+	Just "manual"+formatRemoteConfigVerification RemoteConfigUnverifiedAutoEnabled =+	Just "automatic"+formatRemoteConfigVerification RemoteConfigUnverified = Nothing
git-annex.cabal view
@@ -1,5 +1,5 @@ Name: git-annex-Version: 10.20261020+Version: 10.20261026 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -198,6 +198,9 @@   Description: Use tasty-tap to support git-annex test TAP output   Default: True +Flag Memory+  Description: Build with memory rather than ram+ source-repository head   type: git   location: https://git.joeyh.name/git/git-annex.git/@@ -270,7 +273,6 @@    socks (>= 0.6.0),    stm-chans,    crypto-api,-   memory,    deepseq,    split,    attoparsec (>= 0.13.2.2),@@ -319,9 +321,13 @@      base (>= 4.18.2.1 && < 5),      persistent (>= 2.13.3),      crypton,-     ram,      tls +  if flag(Memory)+    Build-Depends: memory, crypton (< 1.1.0)+  else+    Build-Depends: ram, crypton (>= 1.1.0)+   -- Fully optimize for production.   if flag(Production)     -- Lower memory systems can run out of memory with -O2, so@@ -761,6 +767,7 @@     Command.P2PStdIO     Command.PostReceive     Command.PreCommit+    Command.PrePush     Command.Pull     Command.Push     Command.Put@@ -809,6 +816,7 @@     Command.VCycle     Command.VFilter     Command.VPop+    Command.VerifyRemote     Command.Version     Command.Vicfg     Command.View@@ -944,6 +952,7 @@     Logs.UUIDBased     Logs.Unused     Logs.Upgrade+    Logs.VerifiedRemote     Logs.View     Logs.Web     Messages