honor preferred content settings of cluster nodes

Except when no nodes want a file, it has to be stored somewhere, so
store it on all. Which is not really desirable, but neither is having to
pick one.

ProtoAssociatedFile deserialization is rather broken, and this could
possibly affect preferred content expressions that match on filenames.

The inability to roundtrip whitespace like tabs and newlines through is
not a problem because preferred content expressions can't be written
that match on whitespace such as a tab. For example:

joey@darkstar:~/tmp/bench/z>git-annex wanted  origin-node2 'exclude=*CTRL-VTab*'
wanted origin-node2
git-annex: Parse error: Parse failure: near "*"

But, the filtering of control characters could perhaps be a problem. I think
that filtering is now obsolete, git-annex has comprehensive filtering of
control characters when displaying filenames, that happens at a higher level.
However, I don't want to risk a security hole so am leaving in that filtering
in ProtoAssociatedFile deserialization for now.
This commit is contained in:
Joey Hess 2024-06-25 11:35:41 -04:00
parent a23b0abf28
commit 1bfe7f8a53
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 48 additions and 28 deletions

View file

@ -18,6 +18,7 @@ import P2P.Protocol
import P2P.IO
import Annex.Proxy
import Logs.Location
import Logs.PreferredContent
import Types.Command
import Remote.List
import qualified Remote
@ -59,28 +60,30 @@ proxyCluster clusteruuid proxydone servermode clientside protoerrhandler = do
clusterProxySelector :: ClusterUUID -> ProtocolVersion -> Annex ProxySelector
clusterProxySelector clusteruuid protocolversion = do
nodes <- (fromMaybe S.empty . M.lookup clusteruuid . clusterUUIDs)
nodeuuids <- (fromMaybe S.empty . M.lookup clusteruuid . clusterUUIDs)
<$> getClusters
clusternames <- annexClusters <$> Annex.getGitConfig
remotes <- filter (isnode nodes clusternames) <$> remoteList
remotesides <- mapM (proxySshRemoteSide protocolversion) remotes
remotes <- filter (isnode nodeuuids clusternames) <$> remoteList
nodes <- mapM (proxySshRemoteSide protocolversion) remotes
return $ ProxySelector
{ proxyCHECKPRESENT = nodecontaining remotesides
, proxyGET = nodecontaining remotesides
{ proxyCHECKPRESENT = nodecontaining nodes
, proxyGET = nodecontaining nodes
-- The key is sent to multiple nodes at the same time,
-- skipping nodes where it's known/expected to already be
-- present to avoid needing to connect to those.
, proxyPUT = \k -> do
-- present to avoid needing to connect to those, and
-- skipping nodes where it's not preferred content.
, proxyPUT = \af k -> do
locs <- S.fromList <$> loggedLocations k
let l = filter (flip S.notMember locs . remoteUUID) remotesides
return $ if null l
then remotesides
else l
let l = filter (flip S.notMember locs . remoteUUID) nodes
l' <- filterM (\n -> isPreferredContent (Just (remoteUUID n)) mempty (Just k) af True) l
-- PUT to no nodes doesn't work, so fall
-- back to all nodes.
return $ nonempty [l', l] nodes
-- Remove the key from every node that contains it.
-- But, since it's possible the location log for some nodes
-- could be out of date, actually try to remove from every
-- node.
, proxyREMOVE = const (pure remotesides)
, proxyREMOVE = const (pure nodes)
-- Content is not locked on the cluster as a whole,
-- instead it can be locked on individual nodes that are
-- proxied to the client.
@ -90,22 +93,26 @@ clusterProxySelector clusteruuid protocolversion = do
where
-- Nodes of the cluster have remote.name.annex-cluster-node
-- containing its name.
isnode nodes clusternames r =
isnode nodeuuids clusternames r =
case remoteAnnexClusterNode (Remote.gitconfig r) of
Nothing -> False
Just names
| any (isclustername clusternames) names ->
flip S.member nodes $
flip S.member nodeuuids $
ClusterNodeUUID $ Remote.uuid r
| otherwise -> False
isclustername clusternames name =
M.lookup name clusternames == Just clusteruuid
nodecontaining remotesides k = do
nodecontaining nodes k = do
locs <- S.fromList <$> loggedLocations k
case filter (flip S.member locs . remoteUUID) remotesides of
case filter (flip S.member locs . remoteUUID) nodes of
-- TODO: Avoid always using same remote
(r:_) -> return (Just r)
[] -> return Nothing
nonempty (l:ls) fallback
| null l = nonempty ls fallback
| otherwise = l
nonempty [] fallback = fallback