From 9f4771eb3c3f29ea38bbfc70eaf78198ca948840 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 7 Mar 2018 15:15:23 -0400 Subject: implemented git-annex-shell p2pstdio MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Not yet used by git-annex, but this will allow faster transfers etc than using individual ssh connections and rsync. Not called git-annex-shell p2p, because git-annex p2p does something else and I don't want two subcommands with the same name between the two for sanity reasons. This commit was sponsored by Øyvind Andersen Holm. --- Command/P2PStdIO.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) create mode 100644 Command/P2PStdIO.hs (limited to 'Command/P2PStdIO.hs') diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs new file mode 100644 index 000000000..f6e4ae0f0 --- /dev/null +++ b/Command/P2PStdIO.hs @@ -0,0 +1,44 @@ +{- git-annex command + - + - Copyright 2018 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.P2PStdIO where + +import Command +import P2P.IO +import P2P.Annex +import qualified P2P.Protocol as P2P +import Git.Types +import qualified Annex +import Annex.UUID +import qualified CmdLine.GitAnnexShell.Checks as Checks +import qualified CmdLine.GitAnnexShell.Fields as Fields +import Utility.AuthToken +import Utility.Tmp.Dir + +cmd :: Command +cmd = noMessages $ command "p2pstdio" SectionPlumbing + "communicate in P2P protocol over stdio" + paramNothing (withParams seek) + +seek :: CmdParams -> CommandSeek +seek = withNothing start + +start :: CommandStart +start = do + servermode <- liftIO $ + Checks.checkEnvSet Checks.readOnlyEnv >>= return . \case + True -> P2P.ServeReadOnly + False -> P2P.ServeReadWrite + theiruuid <- Fields.getField Fields.remoteUUID >>= \case + Nothing -> giveup "missing remoteuuid field" + Just u -> return (toUUID u) + myuuid <- getUUID + conn <- stdioP2PConnection <$> Annex.gitRepo + let server = P2P.serveAuthed servermode myuuid + runFullProto (Serving theiruuid Nothing) conn server >>= \case + Right () -> next $ next $ return True + Left e -> giveup e -- cgit v1.2.3