{- git-annex command - - Copyright 2018-2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} 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 cmd :: Command cmd = noMessages $ command "p2pstdio" SectionPlumbing "communicate in P2P protocol over stdio" paramUUID (withParams seek) seek :: CmdParams -> CommandSeek seek [u] = commandAction $ start $ toUUID u seek _ = giveup "missing UUID parameter" start :: UUID -> CommandStart start theiruuid = startingCustomOutput (ActionItemOther Nothing) $ do servermode <- liftIO $ do ro <- Checks.checkEnvSet Checks.readOnlyEnv ao <- Checks.checkEnvSet Checks.appendOnlyEnv return $ case (ro, ao) of (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 P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid) P2P.serveAuthed servermode myuuid runst <- liftIO $ mkRunState $ Serving theiruuid Nothing runFullProto runst conn server >>= \case Right () -> done -- Avoid displaying an error when the client hung up on us. Left (ProtoFailureIOError e) | isEOFError e -> done 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 remote clientside (withclientversion clientside) protoerrhandler where withclientversion clientside (Just (clientmaxversion, othermsg)) = connectremote clientmaxversion $ \remoteside -> proxy done servermode clientside remoteside othermsg protoerrhandler withclientversion _ Nothing = done -- 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." protoerrhandler 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