From 90c502e675eabfd9fc2f17fdc28d5d3eb8dc68fb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 11 Apr 2025 11:17:24 -0400 Subject: [PATCH] mask special remote working Still needs some handling of edge cases, cycles, etc. --- CHANGELOG | 1 + Remote/Mask.hs | 111 +++++++++++++++++++++++++++++++++---------------- 2 files changed, 76 insertions(+), 36 deletions(-) diff --git a/CHANGELOG b/CHANGELOG index d4a82d27dd..8e28fbbc68 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,6 @@ git-annex (10.20250321) UNRELEASED; urgency=medium + * Added the mask special remote. * updatecluster, updateproxy: When a remote that has no annex-uuid is configured as annex-cluster-node, warn and avoid writing bad data to the git-annex branch. diff --git a/Remote/Mask.hs b/Remote/Mask.hs index 04ebd2553e..c1c9597bff 100644 --- a/Remote/Mask.hs +++ b/Remote/Mask.hs @@ -23,8 +23,10 @@ import Annex.UUID import Types.ProposedAccepted import Annex.SpecialRemote.Config import Logs.UUID +import Utility.Metered import qualified Remote.Git +import Control.Concurrent.STM import qualified Data.Map as M remote :: RemoteType @@ -44,13 +46,9 @@ remote = specialRemoteType $ RemoteType gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote) gen r u rc gc rs = do - maskedremote <- getMaskedRemote rc gc - let inherited d f = case maskedremote of - Right mr -> f mr - Left _ -> d + maskedremote <- mkMaskedRemote rc gc c <- parsedRemoteConfig remote rc - cst <- remoteCost gc c $ encryptedRemoteCostAdj + - inherited semiExpensiveRemoteCost cost + cst <- remoteCost gc c $ encryptedRemoteCostAdj + semiExpensiveRemoteCost let this = Remote { uuid = u , cost = cst @@ -59,11 +57,11 @@ gen r u rc gc rs = do , retrieveKeyFile = retrieveKeyFileDummy , retrieveKeyFileInOrder = pure True , retrieveKeyFileCheap = Nothing - , retrievalSecurityPolicy = inherited RetrievalVerifiableKeysSecure retrievalSecurityPolicy + , retrievalSecurityPolicy = RetrievalVerifiableKeysSecure , removeKey = removeKeyDummy , lockContent = Nothing , checkPresent = checkPresentDummy - , checkPresentCheap = inherited False checkPresentCheap + , checkPresentCheap = False , exportActions = exportUnsupported , importActions = importUnsupported , whereisKey = Nothing @@ -74,12 +72,12 @@ gen r u rc gc rs = do , gitconfig = gc , localpath = Nothing , remotetype = remote - , availability = inherited (pure Unavailable) availability - , readonly = inherited False readonly - , appendonly = inherited False appendonly - , untrustworthy = inherited False untrustworthy + , availability = pure LocallyAvailable + , readonly = False + , appendonly = False + , untrustworthy = False , mkUnavailable = return Nothing - , getInfo = inherited (pure []) getInfo + , getInfo = getInfo =<< getMaskedRemote maskedremote , claimUrl = Nothing , checkUrl = Nothing , remoteStateHandle = rs @@ -149,27 +147,44 @@ maskSetup setupstage mu _ c gc = do giveup "It's not secure to use encryption=shared with a git remote." _ -> noop -getMaskedRemote :: RemoteConfig -> RemoteGitConfig -> Annex (Either UUID Remote) -getMaskedRemote c gc = case remoteAnnexMask gc of +newtype MaskedRemote = MaskedRemote { getMaskedRemote :: Annex Remote } + +-- findMaskedRemote won't work until the remote list has been populated, +-- so has to be done on the fly rather than at generation time. +-- This caches it for speed. +mkMaskedRemote :: RemoteConfig -> RemoteGitConfig -> Annex MaskedRemote +mkMaskedRemote c gc = do + v <- liftIO $ newTMVarIO Nothing + return $ MaskedRemote $ + liftIO (atomically (takeTMVar v)) >>= \case + Just maskedremote -> return maskedremote + Nothing -> do + maskedremote <- findMaskedRemote c gc + liftIO $ atomically $ putTMVar v (Just maskedremote) + return maskedremote + +-- XXX prevent using self as masked remote, and prevent using mask special +-- remote, to avoid cycles +findMaskedRemote :: RemoteConfig -> RemoteGitConfig -> Annex Remote +findMaskedRemote c gc = case remoteAnnexMask gc of -- This remote was autoenabled, so use any remote with the -- uuid of the masked remote, so that it can also be autoenabled. Just "true" -> case getmaskedremoteuuid of Just maskremoteuuid -> - selectremote (\r -> uuid r == maskremoteuuid) - maskremoteuuid - Nothing -> return (Left NoUUID) + selectremote maskremoteuuid + (\r -> uuid r == maskremoteuuid) + Nothing -> missingMaskedRemote NoUUID Just maskremotename -> - selectremote (\r -> name r == maskremotename) $ - (fromMaybe NoUUID getmaskedremoteuuid) - Nothing -> return (Left NoUUID) + selectremote NoUUID (\r -> name r == maskremotename) + Nothing -> missingMaskedRemote NoUUID where getmaskedremoteuuid = toUUID . fromProposedAccepted <$> M.lookup remoteField c - selectremote f fallback = do + selectremote u f = do remotelist <- Annex.getState Annex.remotes case filter f remotelist of - (r:_) -> return (Right r) - [] -> return (Left fallback) + (r:_) -> return r + [] -> missingMaskedRemote u missingMaskedRemote :: UUID -> Annex a missingMaskedRemote maskremoteuuid = do @@ -182,21 +197,45 @@ missingMaskedRemote maskremoteuuid = do , " " ++ fromUUID maskremoteuuid ++ " -- " ++ desc ] -store :: Either UUID Remote -> Storer -store (Right maskedremote) k src p = undefined -store (Left maskedremoteuuid) _ _ _ = missingMaskedRemote maskedremoteuuid +store :: MaskedRemote -> Storer +store maskedremote k src p = do + r <- getMaskedRemote maskedremote + storeMasked r k src p -retrieve :: Either UUID Remote -> Retriever -retrieve (Right maskedremote) k p dest iv callback = undefined -retrieve (Left maskedremoteuuid) _ _ _ _ _ = missingMaskedRemote maskedremoteuuid +storeMasked :: Remote -> Storer +storeMasked maskedremote = + fileStorer $ \k f p -> storeKey maskedremote k af (Just f) p + where + af = AssociatedFile Nothing -remove :: Either UUID Remote -> Remover -remove (Right maskedremote) proof k = undefined -remove (Left maskedremoteuuid) _ _ = missingMaskedRemote maskedremoteuuid +retrieve :: MaskedRemote -> Retriever +retrieve maskedremote k p dest iv callback = do + r <- getMaskedRemote maskedremote + fileRetriever (retrieveMasked r) k p dest iv callback -checkKey :: Either UUID Remote -> CheckPresent -checkKey (Right maskedremote) k = undefined -checkKey (Left maskedremoteuuid) _ = missingMaskedRemote maskedremoteuuid +retrieveMasked :: Remote -> OsPath -> Key -> MeterUpdate -> Annex () +retrieveMasked maskedremote dest k p = + -- The masked remote does not need to verify, because fileRetriever + -- does its own verification. + void $ retrieveKeyFile maskedremote k af dest p NoVerify + where + af = AssociatedFile Nothing + +remove :: MaskedRemote -> Remover +remove maskedremote proof k = do + r <- getMaskedRemote maskedremote + removeMasked r proof k + +removeMasked :: Remote -> Remover +removeMasked maskedremote = removeKey maskedremote + +checkKey :: MaskedRemote -> CheckPresent +checkKey maskedremote k = do + r <- getMaskedRemote maskedremote + checkKeyMasked r k + +checkKeyMasked :: Remote -> CheckPresent +checkKeyMasked maskedremote = checkPresent maskedremote remoteField :: RemoteConfigField remoteField = Accepted "remote"