6a59bc4845
Not yet used for everything else, but this is enough to verify that it works, and do some benchmarking. Some bugfixes included, which got it working. Also fallback to old actions has been verified to work correctly. Benchmarked dropping one thousand files from a ssh remote on localhost. Using the old git-annex 40.867 seconds. With the P2P protocol 9.905 seconds! This commit was sponsored by Jochen Bartl on Patreon.
40 lines
1.1 KiB
Haskell
40 lines
1.1 KiB
Haskell
{- 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 qualified Annex
|
|
import Annex.UUID
|
|
import qualified CmdLine.GitAnnexShell.Checks as Checks
|
|
|
|
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 = do
|
|
servermode <- liftIO $
|
|
Checks.checkEnvSet Checks.readOnlyEnv >>= return . \case
|
|
True -> P2P.ServeReadOnly
|
|
False -> P2P.ServeReadWrite
|
|
myuuid <- getUUID
|
|
conn <- stdioP2PConnection <$> Annex.gitRepo
|
|
let server = do
|
|
P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid)
|
|
P2P.serveAuthed servermode myuuid
|
|
runFullProto (Serving theiruuid Nothing) conn server >>= \case
|
|
Right () -> next $ next $ return True
|
|
Left e -> giveup e
|