git-annex-shell: proxy nodes located beyond remote cluster gateways

Walking a tightrope between security and convenience here, because
git-annex-shell needs to only proxy for things when there has been
an explicit, local action to configure them.

In this case, the user has to have run `git-annex extendcluster`,
which now sets annex-cluster-gateway on the remote.

Note that any repositories that the gateway is recorded to
proxy for will be proxied onward. This is not limited to cluster nodes,
because checking the node log would not add any security; someone could
add any uuid to it. The gateway of course then does its own
checking to determine if it will allow proxying for the remote.

diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs
index cc4fb406bcfb8e37ee81574994f282fb6d0cf336..6f7456bb51b4ff6480bc264d4d17246c7723ebe9 100644 (file)
--- a/CmdLine/GitAnnexShell.hs
+++ b/CmdLine/GitAnnexShell.hs
@@ -206,17 +206,29 @@ checkProxy remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case
                rs <- concat . byCost <$> remoteList
                myclusters <- annexClusters <$> Annex.getGitConfig
                let sameuuid r = uuid r == remoteuuid
-               -- Only proxy for a remote when the git configuration
-               -- allows it.
-               let proxyconfigured r = remoteAnnexProxy (R.gitconfig r)
-                       || (any (`M.member` myclusters) $ fromMaybe [] $ remoteAnnexClusterNode $ R.gitconfig r)
                let samename r p = name r == proxyRemoteName p
-               case headMaybe (filter (\r -> sameuuid r && proxyconfigured r && any (samename r) ps) rs) of
+               case headMaybe (filter (\r -> sameuuid r && proxyisconfigured rs myclusters r && any (samename r) ps) rs) of
                        Nothing -> notconfigured
                        Just r -> do
                                Annex.changeState $ \st ->
                                        st { Annex.proxyremote = Just (Right r) }
                                return True
+       
+       -- Only proxy for a remote when the git configuration
+       -- allows it. This is important to prevent changes to 
+       -- the git-annex branch making git-annex-shell unexpectedly
+       -- proxy for remotes.
+       proxyisconfigured rs myclusters r
+               | remoteAnnexProxy (R.gitconfig r) = True
+               -- Proxy for remotes that are configured as cluster nodes.
+               | any (`M.member` myclusters) (fromMaybe [] $ remoteAnnexClusterNode $ R.gitconfig r) = True
+               -- Proxy for a remote when it is proxied by another remote
+               -- which is itself configured as a cluster gateway.
+               | otherwise = case remoteAnnexProxiedBy (R.gitconfig r) of
+                       Just proxyuuid -> not $ null $ 
+                               concatMap (remoteAnnexClusterGateway . R.gitconfig) $
+                                       filter (\p -> R.uuid p == proxyuuid) rs
+                       Nothing -> False
 
        proxyforcluster cu = do
                clusters <- getClusters

diff --git a/Command/ExtendCluster.hs b/Command/ExtendCluster.hs
index c83877b05a8ef95c350d642f35f78ef3ec59abeb..6fa248d57a084ab80ba0143c014bd8fd04040447 100644 (file)
--- a/Command/ExtendCluster.hs
+++ b/Command/ExtendCluster.hs
@@ -13,6 +13,7 @@ import Command
 import qualified Annex
 import Types.Cluster
 import Config
+import Types.GitConfig
 import qualified Remote
 
 import qualified Data.Map as M
@@ -23,11 +24,13 @@ cmd = command "extendcluster" SectionSetup "add an gateway to a cluster"
 
 seek :: CmdParams -> CommandSeek
 seek (remotename:clustername:[]) = Remote.byName (Just clusterremotename) >>= \case
-       Just clusterremote -> 
-               case mkClusterUUID (Remote.uuid clusterremote) of
-                       Just cu -> commandAction $ start cu clustername
-                       Nothing -> giveup $ clusterremotename 
-                               ++ " is not a cluster remote."
+       Just clusterremote -> Remote.byName (Just remotename) >>= \case
+               Just gatewayremote -> 
+                       case mkClusterUUID (Remote.uuid clusterremote) of
+                               Just cu -> commandAction $ start cu clustername gatewayremote
+                               Nothing -> giveup $ clusterremotename 
+                                       ++ " is not a cluster remote."
+               Nothing -> giveup $ "No remote named " ++ remotename ++ " exists."
        Nothing -> giveup $ "Expected to find a cluster remote named " 
                ++ clusterremotename
                ++ " that is accessed via " ++ remotename
@@ -38,12 +41,14 @@ seek (remotename:clustername:[]) = Remote.byName (Just clusterremotename) >>= \c
        clusterremotename = remotename ++ "-" ++ clustername
 seek _ = giveup "Expected two parameters, gateway and clustername."
 
-start :: ClusterUUID -> String -> CommandStart
-start cu clustername = starting "extendcluster" ai si $ do
+start :: ClusterUUID -> String -> Remote -> CommandStart
+start cu clustername gatewayremote = starting "extendcluster" ai si $ do
        myclusters <- annexClusters <$> Annex.getGitConfig
+       let setcus f = setConfig f (fromUUID (fromClusterUUID cu))
        unless (M.member clustername myclusters) $ do
-               setConfig (annexConfig ("cluster." <> encodeBS clustername))
-                       (fromUUID (fromClusterUUID cu))
+               setcus $ annexConfig ("cluster." <> encodeBS clustername)
+       setcus $ remoteAnnexConfig gatewayremote $ 
+               remoteGitConfigKey ClusterGatewayField
        next $ return True
   where
        ai = ActionItemOther (Just (UnquotedString clustername))

diff --git a/Command/UpdateCluster.hs b/Command/UpdateCluster.hs
index 72b59233a6d1aaa65df2ed4bd073b51d4c5abb32..f16318bed00d09702c43147ffffc31082fc9904b 100644 (file)
--- a/Command/UpdateCluster.hs
+++ b/Command/UpdateCluster.hs
@@ -80,5 +80,5 @@ findProxiedClusterNodes recordednodes =
   where
        isproxynode r = 
                asclusternode r `S.member` recordednodes
-                       && remoteAnnexProxied (R.gitconfig r)
+                       && isJust (remoteAnnexProxiedBy (R.gitconfig r))
        asclusternode = ClusterNodeUUID . R.uuid

diff --git a/Command/UpdateProxy.hs b/Command/UpdateProxy.hs
index cbe7ae9a81e6210f939787eb07a5394118f96aff..d21b7321c4efca19d2b32d88bf5478ad5e3ec4ec 100644 (file)
--- a/Command/UpdateProxy.hs
+++ b/Command/UpdateProxy.hs
@@ -83,7 +83,7 @@ findRemoteProxiedClusterNodes = do
                <$> Annex.getGitConfig
        clusternodes <- clusterNodeUUIDs <$> getClusters
        let isproxiedclusternode r
-               | remoteAnnexProxied (R.gitconfig r) =
+               | isJust (remoteAnnexProxiedBy (R.gitconfig r)) =
                        case M.lookup (ClusterNodeUUID (R.uuid r)) clusternodes of
                                Nothing -> False
                                Just s -> not $ S.null $ 

diff --git a/Remote.hs b/Remote.hs
index 9038d2a767bb960ea2c0785a2d8b7982c5b75d0d..eea052e2549fc2223c244d0753021f4dbcf5e2c8 100644 (file)
--- a/Remote.hs
+++ b/Remote.hs
@@ -455,7 +455,7 @@ gitSyncableRemote :: Remote -> Bool
 gitSyncableRemote r
        | gitSyncableRemoteType (remotetype r) 
                && isJust (remoteUrl (gitconfig r)) =
-                       not (remoteAnnexProxied (gitconfig r))
+                       not (isJust (remoteAnnexProxiedBy (gitconfig r)))
        | otherwise = case remoteUrl (gitconfig r) of
                Just u | "annex::" `isPrefixOf` u -> True
                _ -> False

diff --git a/Remote/Git.hs b/Remote/Git.hs
index 6c29c28cfe5d121e87767959c4a5495aad6e7464..89e0da38c1bc3179d56ceec238318d353a219637 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -794,21 +794,22 @@ listProxied proxies rs = concat <$> mapM go rs
                        then pure []
                        else case M.lookup cu proxies of
                                Nothing -> pure []
-                               Just s -> catMaybes
-                                       <$> mapM (mkproxied g r s) (S.toList s)
+                               Just proxied -> catMaybes
+                                       <$> mapM (mkproxied g r gc proxied)
+                                               (S.toList proxied)
        
        proxiedremotename r p = do
                n <- Git.remoteName r
                pure $ n ++ "-" ++ proxyRemoteName p
 
-       mkproxied g r proxied p = case proxiedremotename r p of
+       mkproxied g r gc proxied p = case proxiedremotename r p of
                Nothing -> pure Nothing
-               Just proxyname -> mkproxied' g r proxied p proxyname
+               Just proxyname -> mkproxied' g r gc proxied p proxyname
        
        -- The proxied remote is constructed by renaming the proxy remote,
        -- changing its uuid, and setting the proxied remote's inherited
        -- configs and uuid in Annex state.
-       mkproxied' g r proxied p proxyname
+       mkproxied' g r gc proxied p proxyname
                | any isconfig (M.keys (Git.config g)) = pure Nothing
                | otherwise = do
                        clusters <- getClustersWith id
@@ -830,7 +831,7 @@ listProxied proxies rs = concat <$> mapM go rs
                annexconfigadjuster clusters r' = 
                        let c = adduuid (configRepoUUID renamedr) $
                                addurl $
-                               addproxied $
+                               addproxiedby $
                                adjustclusternode clusters $
                                inheritconfigs $ Git.fullconfig r'
                        in r'
@@ -844,7 +845,10 @@ listProxied proxies rs = concat <$> mapM go rs
                addurl = M.insert (remoteConfig renamedr (remoteGitConfigKey UrlField))
                        [Git.ConfigValue $ encodeBS $ Git.repoLocation r]
                
-               addproxied = addremoteannexfield ProxiedField True
+               addproxiedby = case remoteAnnexUUID gc of
+                       Just u -> addremoteannexfield ProxiedByField
+                               [Git.ConfigValue $ fromUUID u]
+                       Nothing -> id
                
                -- A node of a cluster that is being proxied along with
                -- that cluster does not need to be synced with
@@ -854,14 +858,14 @@ listProxied proxies rs = concat <$> mapM go rs
                        case M.lookup (ClusterNodeUUID (proxyRemoteUUID p)) (clusterNodeUUIDs clusters) of
                                Just cs
                                        | any (\c -> S.member (fromClusterUUID c) proxieduuids) (S.toList cs) ->
-                                               addremoteannexfield SyncField False
+                                               addremoteannexfield SyncField
+                                                       [Git.ConfigValue $ Git.Config.boolConfig' False]
                                _ -> id
 
                proxieduuids = S.map proxyRemoteUUID proxied
 
-               addremoteannexfield f b = M.insert
+               addremoteannexfield f = M.insert
                        (remoteAnnexConfig renamedr (remoteGitConfigKey f))
-                       [Git.ConfigValue $ Git.Config.boolConfig' b]
 
                inheritconfigs c = foldl' inheritconfig c proxyInheritedFields
                

diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs
index b240ee0a2f6d52c75a45016df6c30e8cb95926a0..c37d286df44c68c2cfcf19a4bda5b486513e7dc4 100644 (file)
--- a/Remote/Helper/Git.hs
+++ b/Remote/Helper/Git.hs
@@ -65,6 +65,6 @@ gitRepoInfo r = do
        return
                [ ("repository location", Git.repoLocation repo)
                , ("proxied", Git.Config.boolConfig 
-                       (remoteAnnexProxied (Remote.gitconfig r)))
+                       (isJust (remoteAnnexProxiedBy (Remote.gitconfig r))))
                , ("last synced", lastsynctime)
                ]

diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 4b1827306c14b2c7bf97901d7abeb807e1056a20..c85acb1929540ee5e434eecaa0d27e605c500496 100644 (file)
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -386,12 +386,14 @@ data RemoteGitConfig = RemoteGitConfig
        , remoteAnnexBwLimitUpload :: Maybe BwRate
        , remoteAnnexBwLimitDownload :: Maybe BwRate
        , remoteAnnexAllowUnverifiedDownloads :: Bool
+       , remoteAnnexUUID :: Maybe UUID
        , remoteAnnexConfigUUID :: Maybe UUID
        , remoteAnnexMaxGitBundles :: Int
        , remoteAnnexAllowEncryptedGitRepo :: Bool
        , remoteAnnexProxy :: Bool
-       , remoteAnnexProxied :: Bool
+       , remoteAnnexProxiedBy :: Maybe UUID
        , remoteAnnexClusterNode :: Maybe [RemoteName]
+       , remoteAnnexClusterGateway :: [ClusterUUID]
        , remoteUrl :: Maybe String
 
        {- These settings are specific to particular types of remotes
@@ -471,16 +473,20 @@ extractRemoteGitConfig r remotename = do
                        readBwRatePerSecond =<< getmaybe BWLimitDownloadField
                , remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $
                        getmaybe SecurityAllowUnverifiedDownloadsField
+               , remoteAnnexUUID = toUUID <$> getmaybe UUIDField
                , remoteAnnexConfigUUID = toUUID <$> getmaybe ConfigUUIDField
                , remoteAnnexMaxGitBundles =
                        fromMaybe 100 (getmayberead MaxGitBundlesField)
                , remoteAnnexAllowEncryptedGitRepo = 
                        getbool AllowEncryptedGitRepoField False
                , remoteAnnexProxy = getbool ProxyField False
-               , remoteAnnexProxied = getbool ProxiedField False
+               , remoteAnnexProxiedBy = toUUID <$> getmaybe ProxiedByField
                , remoteAnnexClusterNode = 
                        (filter isLegalName . words)
                                <$> getmaybe ClusterNodeField
+               , remoteAnnexClusterGateway = fromMaybe [] $
+                       (mapMaybe (mkClusterUUID . toUUID) . words)
+                               <$> getmaybe ClusterGatewayField
                , remoteUrl = 
                        case Git.Config.getMaybe (remoteConfig remotename (remoteGitConfigKey UrlField)) r of
                                Just (ConfigValue b)
@@ -553,13 +559,15 @@ data RemoteGitConfigField
        | BWLimitField
        | BWLimitUploadField
        | BWLimitDownloadField
+       | UUIDField
        | ConfigUUIDField
        | SecurityAllowUnverifiedDownloadsField
        | MaxGitBundlesField
        | AllowEncryptedGitRepoField
        | ProxyField
-       | ProxiedField
+       | ProxiedByField
        | ClusterNodeField
+       | ClusterGatewayField
        | UrlField
        | ShellField
        | SshOptionsField
@@ -618,14 +626,16 @@ remoteGitConfigField = \case
        BWLimitField -> inherited "bwlimit"
        BWLimitUploadField -> inherited "bwlimit-upload"
        BWLimitDownloadField -> inherited "bwlimit-upload"
+       UUIDField -> uninherited "uuid"
        ConfigUUIDField -> uninherited "config-uuid"
        SecurityAllowUnverifiedDownloadsField -> inherited "security-allow-unverified-downloads"
        MaxGitBundlesField -> inherited "max-git-bundles"
        AllowEncryptedGitRepoField -> inherited "allow-encrypted-gitrepo"
        -- Allow proxy chains.
        ProxyField -> inherited "proxy"
-       ProxiedField -> uninherited "proxied"
+       ProxiedByField -> uninherited "proxied-by"
        ClusterNodeField -> uninherited "cluster-node"
+       ClusterGatewayField -> uninherited "cluster-gateway"
        UrlField -> uninherited "url"
        ShellField -> inherited "shell"
        SshOptionsField -> inherited "ssh-options"

diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index de8f45e109701a8b743f8111ab50a479dea426a1..3d95cd5b1aaab6a0f6ce188c62dd8bccdb3e9bcb 100644 (file)
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1398,11 +1398,12 @@ repository, using [[git-annex-config]]. See its man page for a list.)
 
 * `annex.cluster.<name>`
 
-  [[git-annex-updatecluster]] sets this to the UUID of a cluster
-  based on `remote.<name>.annex-cluster-node` configuration.
+  This is set to make the repository be a gateway to a cluster.
+  The value is the cluster UUID. Note that cluster UUIDs are not
+  the same as repository UUIDs, and a repository UUID cannot be used here.
 
-  Note that cluster UUIDs are not the same as repository UUIDs,
-  and a repository UUID cannot be used here.
+  Usually this is set up by running [[git-annex-initcluster]] or
+  [[git-annex-extendcluster]].
 
 # CONFIGURATION OF REMOTES
 
@@ -1681,14 +1682,11 @@ Remotes are configured using these settings in `.git/config`.
   After configuring this, run [[git-annex-updateproxy](1) to store
   the new configuration in the git-annex branch.
 
-* `remote.<name>.annex-proxied`
-
-  Setting this to "true" indicates that a remote is proxied via the
-  git-annex repository that its remote points to. That prevents commands
-  like `git-annex sync` from pulling and pushing the remote. 
+* `remote.<name>.annex-proxied-by`
 
   Usually this is used internally, when git-annex sets up proxied remotes,
-  and will not need to be set.
+  and will not need to be configured. The value is the UUID of the
+  git-annex repository that proxies access to this remote.
 
 * `remote.<name>.annex-cluster-node`
 
@@ -1699,6 +1697,15 @@ Remotes are configured using these settings in `.git/config`.
   After configuring this, run [[git-annex-updatecluster](1) to store
   the new configuration in the git-annex branch.
 
+* `remote.<name>.annex-cluster-gateway`
+
+  Set to the UUID of a cluster that this remote serves as a gateway for.
+  Multiple UUIDs can be listed, separated by whitespace. When the local
+  repository is also a gateway for that cluster, it will proxy for the
+  nodes of the remote gateway.
+  
+  Usually this is set up by running [[git-annex-extendcluster]].
+
 * `remote.<name>.annex-private`
 
   When this is set to true, no information about the remote will be

diff --git a/doc/todo/git-annex_proxies.mdwn b/doc/todo/git-annex_proxies.mdwn
index daf21838b7a7f481b10878e525b4f9df26edaaf8..a3584840cf93c1f20031aa85d0d9cc0a94315b0b 100644 (file)
--- a/doc/todo/git-annex_proxies.mdwn
+++ b/doc/todo/git-annex_proxies.mdwn
@@ -33,8 +33,11 @@ For June's work on [[design/passthrough_proxy]], remaining todos:
   protocol messages on to any remotes that have the same UUID as
   the cluster. Needs VIA extension to P2P protocol to avoid cycles.
 
-* `git-annex updatecluster` needs changes to support a distributed cluster.
-  Currently it will remove nodes that are behind another gateway.
+  Current status: Distributed cluster nodes are visible,
+  and can be accessed directly, but trying to GET from a cluster
+  fails when the content is located behind a remote gateway.
+  And PUT only sends to the immediate nodes
+  of the cluster, not on to other gateways.
 
 * Getting a key from a cluster currently always selects the lowest cost
   remote, and always the same remote if cost is the same. Should
@@ -106,3 +109,8 @@ For June's work on [[design/passthrough_proxy]], remaining todos:
 
 * Support annex.jobs for clusters. (done)
 
+* Add `git-annex extendcluster` command and extend `git-annex updatecluster` 
+  to support clusters with multiple gateways. (done)
+
+* Support proxying for a remote that is proxied by another gateway of
+  a cluster. (done)