1{- git-annex command
2 -
3 - Copyright 2018 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Command.P2PStdIO where
9
10import Command
11import P2P.IO
12import P2P.Annex
13import qualified P2P.Protocol as P2P
14import qualified Annex
15import Annex.UUID
16import qualified CmdLine.GitAnnexShell.Checks as Checks
17
18import System.IO.Error
19
20cmd :: Command
21cmd = noMessages $ command "p2pstdio" SectionPlumbing
22	"communicate in P2P protocol over stdio"
23	paramUUID (withParams seek)
24
25seek :: CmdParams -> CommandSeek
26seek [u] = commandAction $ start $ toUUID u
27seek _ = giveup "missing UUID parameter"
28
29start :: UUID -> CommandStart
30start theiruuid = startingCustomOutput (ActionItemOther Nothing) $ do
31	servermode <- liftIO $ do
32		ro <- Checks.checkEnvSet Checks.readOnlyEnv
33		ao <- Checks.checkEnvSet Checks.appendOnlyEnv
34		return $ case (ro, ao) of
35			(True, _) -> P2P.ServeReadOnly
36			(False, True) -> P2P.ServeAppendOnly
37			(False, False) -> P2P.ServeReadWrite
38	myuuid <- getUUID
39	conn <- stdioP2PConnection <$> Annex.gitRepo
40	let server = do
41		P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid)
42		P2P.serveAuthed servermode myuuid
43	runst <- liftIO $ mkRunState $ Serving theiruuid Nothing
44	runFullProto runst conn server >>= \case
45		Right () -> done
46		-- Avoid displaying an error when the client hung up on us.
47		Left (ProtoFailureIOError e) | isEOFError e -> done
48		Left e -> giveup (describeProtoFailure e)
49  where
50	done = next $ return True
51