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:
parent
7b1548dbfa
commit
501d65eeab
5 changed files with 146 additions and 14 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue