diff --git a/Annex.hs b/Annex.hs --- a/Annex.hs +++ b/Annex.hs @@ -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 diff --git a/Annex/Hook.hs b/Annex/Hook.hs --- a/Annex/Hook.hs +++ b/Annex/Hook.hs @@ -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 + - Copyright 2013-2026 Joey Hess - - 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." diff --git a/Annex/Init.hs b/Annex/Init.hs --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -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 diff --git a/Annex/Locations.hs b/Annex/Locations.hs --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -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. -} diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs --- a/Annex/SpecialRemote.hs +++ b/Annex/SpecialRemote.hs @@ -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 diff --git a/Annex/SpecialRemote/Config.hs b/Annex/SpecialRemote/Config.hs --- a/Annex/SpecialRemote/Config.hs +++ b/Annex/SpecialRemote/Config.hs @@ -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 diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -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 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 diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -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 diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs --- a/CmdLine/GitRemoteAnnex.hs +++ b/CmdLine/GitRemoteAnnex.hs @@ -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 diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2013-2024 Joey Hess + - Copyright 2013-2026 Joey Hess - - 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 diff --git a/Command/Init.hs b/Command/Init.hs --- a/Command/Init.hs +++ b/Command/Init.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2020 Joey Hess + - Copyright 2010-2026 Joey Hess - - 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 diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -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) $ diff --git a/Command/PrePush.hs b/Command/PrePush.hs new file mode 100644 --- /dev/null +++ b/Command/PrePush.hs @@ -0,0 +1,30 @@ +{- git-annex command + - + - Copyright 2026 Joey Hess + - + - 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 diff --git a/Command/VerifyRemote.hs b/Command/VerifyRemote.hs new file mode 100644 --- /dev/null +++ b/Command/VerifyRemote.hs @@ -0,0 +1,257 @@ +{- git-annex command + - + - Copyright 2026 Joey Hess + - + - 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 + diff --git a/Config.hs b/Config.hs --- a/Config.hs +++ b/Config.hs @@ -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 diff --git a/Logs/File.hs b/Logs/File.hs --- a/Logs/File.hs +++ b/Logs/File.hs @@ -1,6 +1,6 @@ {- git-annex log files - - - Copyright 2018-2023 Joey Hess + - Copyright 2018-2026 Joey Hess - - 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 diff --git a/Logs/Remote.hs b/Logs/Remote.hs --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -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 diff --git a/Logs/Remote/Pure.hs b/Logs/Remote/Pure.hs --- a/Logs/Remote/Pure.hs +++ b/Logs/Remote/Pure.hs @@ -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 diff --git a/Logs/VerifiedRemote.hs b/Logs/VerifiedRemote.hs new file mode 100644 --- /dev/null +++ b/Logs/VerifiedRemote.hs @@ -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 + - + - 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 diff --git a/NEWS b/NEWS --- a/NEWS +++ b/NEWS @@ -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 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 diff --git a/Remote/External.hs b/Remote/External.hs --- a/Remote/External.hs +++ b/Remote/External.hs @@ -99,9 +99,9 @@ exportUnsupported importUnsupported return $ Just $ specialRemote c - readonlyStorer + (readonlyStorer readonlyWarning) (retrieveUrlReadOnly gc) - readonlyRemoveKey + (readonlyRemoveKey readonlyWarning) (checkKeyUrlReadOnly gc) rmt | otherwise = do diff --git a/Remote/Helper/ReadOnly.hs b/Remote/Helper/ReadOnly.hs --- a/Remote/Helper/ReadOnly.hs +++ b/Remote/Helper/ReadOnly.hs @@ -1,15 +1,17 @@ {- Adds readonly support to remotes. - - - Copyright 2013-2019 Joey Hess + - Copyright 2013-2026 Joey Hess - - 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" diff --git a/Remote/List.hs b/Remote/List.hs --- a/Remote/List.hs +++ b/Remote/List.hs @@ -1,6 +1,6 @@ {- git-annex remote list - - - Copyright 2011-2020 Joey Hess + - Copyright 2011-2026 Joey Hess - - 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 = diff --git a/Test.hs b/Test.hs --- a/Test.hs +++ b/Test.hs @@ -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" diff --git a/Test/Framework.hs b/Test/Framework.hs --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -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 () diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs --- a/Types/GitConfig.hs +++ b/Types/GitConfig.hs @@ -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" diff --git a/Types/RemoteConfig.hs b/Types/RemoteConfig.hs --- a/Types/RemoteConfig.hs +++ b/Types/RemoteConfig.hs @@ -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 diff --git a/git-annex.cabal b/git-annex.cabal --- a/git-annex.cabal +++ b/git-annex.cabal @@ -1,5 +1,5 @@ Name: git-annex -Version: 10.20261020 +Version: 10.20261026 Cabal-Version: 1.12 License: AGPL-3 Maintainer: Joey Hess @@ -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