git-annex-shell: accept uuid of remote that proxying is enabled for

For NotifyChanges and also for the fallthrough case where
git-annex-shell passes a command off to git-shell, proxying is currently
ignored. So every remote that is accessed via a proxy will be treated as
the same git repository.

Every other command listed in cmdsMap will need to check if
Annex.proxyremote is set, and if so handle the proxying appropriately.
Probably only P2PStdio will need to support proxying. For now,
everything else refuses to work when proxying.

The part of that I don't like is that there's the possibility a command
later gets added to the list that doesn't check proxying.

When proxying is not enabled, it's important that git-annex-shell not
leak information that it would not have exposed before. Such as the
names or uuids of remotes.

I decided that, in the case where a repository used to have proxying
enabled, but no longer supports any proxies, it's ok to give the user a
clear error message indicating that proxying is not configured, rather
than a confusing uuid mismatch message.

Similarly, if a repository has proxying enabled, but not for the
requested repository, give a clear error message.

A tricky thing here is how to handle the case where there is more than
one remote, with proxying enabled, with the specified uuid. One way to
handle that would be to plumb the proxyRemoteName all the way through
from the remote git-annex to git-annex-shell, eg as a field, and use
only a remote with the same name. That would be very intrusive though.

Instead, I decided to let the proxy pick which remote it uses to access
a given Remote. And so it picks the least expensive one.
The client after all doesn't necessarily know any details about the
proxy's configuration. This does mean though, that if the least
expensive remote is not accessible, but another remote would have
worked, an access via the proxy will fail.

Annex.hs

@@ -213,6 +213,7 @@ data AnnexState = AnnexState
 	, urloptions :: Maybe UrlOptions
 	, insmudgecleanfilter :: Bool
 	, getvectorclock :: IO CandidateVectorClock
+	, proxyremote :: Maybe (Types.Remote.RemoteA Annex)
 	}
 
 newAnnexState :: GitConfig -> Git.Repo -> IO AnnexState
@@ -266,6 +267,7 @@ newAnnexState c r = do
 		, urloptions = Nothing
 		, insmudgecleanfilter = False
 		, getvectorclock = vc
+		, proxyremote = Nothing
 		}
 
 {- Makes an Annex state object for the specified git repo.

CmdLine/GitAnnexShell.hs

@@ -1,6 +1,6 @@
 {- git-annex-shell main program
  -
- - Copyright 2010-2023 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -8,6 +8,7 @@
 module CmdLine.GitAnnexShell where
 
 import Annex.Common
+import qualified Annex
 import qualified Git.Construct
 import qualified Git.Config
 import CmdLine
@@ -19,6 +20,9 @@ import CmdLine.GitAnnexShell.Fields
 import Remote.GCrypt (getGCryptUUID)
 import P2P.Protocol (ServerMode(..))
 import Git.Types
+import Logs.Proxy
+import Logs.UUID
+import Remote
 
 import qualified Command.ConfigList
 import qualified Command.NotifyChanges
@@ -30,6 +34,7 @@ import qualified Command.SendKey
 import qualified Command.DropKey
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 cmdsMap :: M.Map ServerMode [Command]
 cmdsMap = M.fromList $ map mk
@@ -39,20 +44,22 @@ cmdsMap = M.fromList $ map mk
 	]
   where
 	readonlycmds = map addAnnexOptions
-		[ Command.ConfigList.cmd
+		[ notProxyable Command.ConfigList.cmd
 		, gitAnnexShellCheck Command.NotifyChanges.cmd
 		-- p2pstdio checks the environment variables to
-		-- determine the security policy to use
+		-- determine the security policy to use, so is safe to
-		, gitAnnexShellCheck Command.P2PStdIO.cmd
+		-- include in the readonly list even though it is not
-		, gitAnnexShellCheck Command.InAnnex.cmd
+		-- always readonly
-		, gitAnnexShellCheck Command.SendKey.cmd
+		, notProxyable (gitAnnexShellCheck Command.P2PStdIO.cmd) -- FIXME support proxy
+		, notProxyable (gitAnnexShellCheck Command.InAnnex.cmd)
+		, notProxyable (gitAnnexShellCheck Command.SendKey.cmd)
 		]
 	appendcmds = readonlycmds ++ map addAnnexOptions
-		[ gitAnnexShellCheck Command.RecvKey.cmd
+		[ notProxyable (gitAnnexShellCheck Command.RecvKey.cmd)
 		]
 	allcmds = appendcmds ++ map addAnnexOptions
-		[ gitAnnexShellCheck Command.DropKey.cmd
+		[ notProxyable (gitAnnexShellCheck Command.DropKey.cmd)
-		, Command.GCryptSetup.cmd
+		, notProxyable Command.GCryptSetup.cmd
 		]
 
 	mk (s, l) = (s, map (adddirparam . noMessages) l)
@@ -77,17 +84,23 @@ commonShellOptions =
   where
 	checkUUID expected = getUUID >>= check
 	  where
-		check u | u == toUUID expected = noop
 		check NoUUID = checkGCryptUUID expected
-		check u = unexpectedUUID expected u
+		check u 
+			| u == toUUID expected = noop
+			| otherwise = 
+				unlessM (checkProxy (toUUID expected) u) $
+					unexpectedUUID expected u
+	
 	checkGCryptUUID expected = check =<< getGCryptUUID True =<< gitRepo
 	  where
 		check (Just u) | u == toUUID expected = noop
 		check Nothing = unexpected expected "uninitialized repository"
 		check (Just u) = unexpectedUUID expected u
+	
 	unexpectedUUID expected u = unexpected expected $ "UUID " ++ fromUUID u
 	unexpected expected s = giveup $
 		"expected repository UUID " ++ expected ++ " but found " ++ s
+				
 
 run :: [String] -> IO ()
 run [] = failure
@@ -104,6 +117,11 @@ run c@(cmd:_)
 	| cmd `elem` builtins = failure
 	| otherwise = external c
 
+failure :: IO ()
+failure = giveup $ "bad parameters\n\n" ++ usage h cmdsList
+  where
+	h = "git-annex-shell [-c] command [parameters ...] [option ...]"
+
 builtins :: [String]
 builtins = map cmdname cmdsList
 
@@ -165,7 +183,31 @@ checkField (field, val)
 	| field == fieldName autoInit = fieldCheck autoInit val
 	| otherwise = False
 
-failure :: IO ()
+{- Check if this repository can proxy for a specified remote uuid,
-failure = giveup $ "bad parameters\n\n" ++ usage h cmdsList
+ - and if so enable proxying for it. -}
+checkProxy :: UUID -> UUID -> Annex Bool
+checkProxy remoteuuid ouruuid = M.lookup ouruuid <$> getProxies >>= \case
+	Nothing -> return False
+	-- This repository has (or had) proxying enabled. So it's
+	-- ok to display error messages that talk about proxies.
+	Just proxies ->
+		case filter (\p -> proxyRemoteUUID p == remoteuuid) (S.toList proxies) of
+			[] -> notconfigured
+			ps -> do
+				-- This repository may have multiple
+				-- remotes that access the same repository.
+				-- Proxy for the lowest cost one that
+				-- is configured to be used as a proxy.
+				rs <- concat . byCost <$> remoteList
+				let sameuuid r = uuid r == remoteuuid
+				let samename r p = name r == proxyRemoteName p
+				case headMaybe (filter (\r -> sameuuid r && any (samename r) ps) rs) of
+					Nothing -> notconfigured
+					Just r -> do
+						Annex.changeState $ \st ->
+							st { Annex.proxyremote = Just r }
+						return True
   where
-	h = "git-annex-shell [-c] command [parameters ...] [option ...]"
+	notconfigured = M.lookup remoteuuid <$> uuidDescMap >>= \case
+		Just desc -> giveup $ "not configured to proxy for repository " ++ (fromUUIDDesc desc)
+		Nothing -> return False

CmdLine/GitAnnexShell/Checks.hs

@@ -1,6 +1,6 @@
 {- git-annex-shell checks
  -
- - Copyright 2012 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -82,3 +82,12 @@ gitAnnexShellCheck = addCheck GitAnnexShellOk okforshell . dontCheck repoExists
   where
 	okforshell = unlessM (isInitialized <||> isJust . gcryptId <$> Annex.getGitConfig) $
 		giveup "Not a git-annex or gcrypt repository."
+
+{- Used for Commands that don't support proxying. -}
+notProxyable :: Command -> Command
+notProxyable c = addCheck GitAnnexShellNotProxyable checkok c
+  where
+	checkok = Annex.getState Annex.proxyremote >>= \case
+		Nothing -> return ()
+		Just _ -> giveup $ "Cannot proxy " ++ cmdname c ++ " command."
+

Types/Command.hs

@@ -142,4 +142,5 @@ data CommandCheckId
 	| RepoExists
 	| NoDaemonRunning
 	| GitAnnexShellOk
+	| GitAnnexShellNotProxyable
 	deriving (Show, Ord, Eq)

doc/git-annex-shell.mdwn

@@ -86,7 +86,9 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
 * --uuid=UUID
 
   git-annex uses this to specify the UUID of the repository it was expecting
-  git-annex-shell to access, as a sanity check.
+  git-annex-shell to access. This is both a sanity check, and allows
+  git-annex shell to proxy access to remotes, when configured
+  by [[git-annex-update-proxy]].
 
 * Also the [[git-annex-common-options]](1) can be used.
 

doc/todo/git-annex_proxies.mdwn

@@ -36,7 +36,7 @@ For June's work on [[design/passthrough_proxy]], implementation plan:
 
 2. Remote instantiation for proxies. (done)
 
-3. Implement proxying in git-annex-shell.
+3. Implement proxying for Command.P2PStdIO.cmd.
 
 4. Either implement proxying for local path remotes, or prevent
    listProxied from operating on them.