started implementing git-annex-shell proxy

So far, it negotiates VERSION with both parties. This is a tricky dance.

Untested.
This commit is contained in:
Joey Hess 2024-06-10 18:01:36 -04:00
parent 7b1548dbfa
commit 501d65eeab
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 146 additions and 14 deletions

View file

@ -1,6 +1,6 @@
{- git-annex command
-
- Copyright 2018 Joey Hess <id@joeyh.name>
- Copyright 2018-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -10,10 +10,12 @@ module Command.P2PStdIO where
import Command
import P2P.IO
import P2P.Annex
import P2P.Proxy
import qualified P2P.Protocol as P2P
import qualified Annex
import Annex.UUID
import qualified CmdLine.GitAnnexShell.Checks as Checks
import Remote.Helper.Ssh (openP2PSshConnection', closeP2PSshConnection)
import System.IO.Error
@ -35,6 +37,12 @@ start theiruuid = startingCustomOutput (ActionItemOther Nothing) $ do
(True, _) -> P2P.ServeReadOnly
(False, True) -> P2P.ServeAppendOnly
(False, False) -> P2P.ServeReadWrite
Annex.getState Annex.proxyremote >>= \case
Nothing -> performLocal theiruuid servermode
Just r -> performProxy theiruuid servermode r
performLocal :: UUID -> P2P.ServerMode -> CommandPerform
performLocal theiruuid servermode = do
myuuid <- getUUID
let conn = stdioP2PConnection Nothing
let server = do
@ -48,3 +56,31 @@ start theiruuid = startingCustomOutput (ActionItemOther Nothing) $ do
Left e -> giveup (describeProtoFailure e)
where
done = next $ return True
performProxy :: UUID -> P2P.ServerMode -> Remote -> CommandPerform
performProxy clientuuid servermode remote = do
clientside <- ClientSide
<$> liftIO (mkRunState $ Serving clientuuid Nothing)
<*> pure (stdioP2PConnection Nothing)
getClientProtocolVersion clienterrhandler remote clientside $ \case
Nothing -> done
Just (clientmaxversion, othermsg) ->
connectremote clientmaxversion $ \remoteside ->
proxy clienterrhandler done servermode
clientside remoteside othermsg
where
-- FIXME: Support special remotes and non-ssh git remotes.
connectremote clientmaxversion cont =
openP2PSshConnection' remote clientmaxversion >>= \case
Just conn@(P2P.IO.OpenConnection (remoterunst, remoteconn, _)) ->
cont (RemoteSide remoterunst remoteconn)
`finally` liftIO (closeP2PSshConnection conn)
_ -> giveup "Unable to connect to remote."
clienterrhandler cont a = a >>= \case
-- Avoid displaying an error when the client hung up on us.
Left (ProtoFailureIOError e) | isEOFError e -> done
Left e -> giveup (describeProtoFailure e)
Right v -> cont v
done = next $ return True