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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
{- P2P protocol, generic transports.
-
- See doc/design/generic_p2p_transport.mdwn
-
- Copyright 2025 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module P2P.Generic where
import Common
import P2P.Address
import Annex.ExternalAddonProcess
genericP2PCommand :: P2PNetName -> String
genericP2PCommand (P2PNetName netname) = "git-annex-p2p-" ++ netname
connectGenericP2P :: P2PNetName -> UnderlyingP2PAddress -> IO (Handle, Handle, ProcessHandle)
connectGenericP2P netname (UnderlyingP2PAddress address) =
startExternalAddonProcess
(\p -> p
{ std_in = CreatePipe
, std_out = CreatePipe
})
(genericP2PCommand netname) [Param address]
>>= \case
Right (_, (Just hin, Just hout, Nothing, pid)) ->
return (hin, hout, pid)
Right _ -> giveup "internal"
Left (ProgramNotInstalled msg) -> giveup msg
Left (ProgramFailure msg) -> giveup msg
socketGenericP2P :: P2PNetName -> UnderlyingP2PAddress -> OsPath -> IO ProcessHandle
socketGenericP2P netname (UnderlyingP2PAddress address) socketfile = do
startExternalAddonProcess id
(genericP2PCommand netname) [Param address, File (fromOsPath socketfile)]
>>= \case
Right (_, (Nothing, Nothing, Nothing, pid)) ->
return pid
Right _ -> giveup "internal"
Left (ProgramNotInstalled msg) -> giveup msg
Left (ProgramFailure msg) -> giveup msg
getAddressGenericP2P :: P2PNetName -> IO [P2PAddress]
getAddressGenericP2P netname =
startExternalAddonProcess
(\p -> p { std_out = CreatePipe })
(genericP2PCommand netname) [Param "address"]
>>= \case
Right (_, (Nothing, Just hin, Nothing, pid)) ->
go [] hin pid
Right _ -> giveup "internal"
Left (ProgramNotInstalled msg) -> giveup msg
Left (ProgramFailure msg) -> giveup msg
where
go addrs hin pid = hGetLineUntilExitOrEOF pid hin >>= \case
Just l
| not (null l) ->
let addr = P2PAnnex netname (UnderlyingP2PAddress l)
in go (addr:addrs) hin pid
| otherwise -> go addrs hin pid
Nothing -> do
waitForProcess pid >>= \case
ExitSuccess -> return addrs
ExitFailure _ -> giveup $ genericP2PCommand netname ++ " failed"
|
