implemented git-annex-shell p2pstdio

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.
This commit is contained in:
Joey Hess 2018-03-07 15:15:23 -04:00
parent fa5b19f0ff
commit 6ddfa9807b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
10 changed files with 110 additions and 11 deletions

44
Command/P2PStdIO.hs Normal file
View file

@ -0,0 +1,44 @@
{- git-annex command
-
- Copyright 2018 Joey Hess <id@joeyh.name>
-
- 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