blob: f6e4ae0f0e5258681664a8f6fc585695c9de189c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
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
|
