blob: ea4dd7c65658a96124a9517c62d5b5fa222afecb (
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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
{- git-annex command
-
- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.P2P where
import Command
import P2P.Address
import P2P.Auth
import P2P.IO
import qualified P2P.Protocol as P2P
import Utility.AuthToken
import Git.Types
import qualified Git.Remote
import qualified Git.Command
import qualified Annex
import Annex.UUID
import Config
cmd :: Command
cmd = command "p2p" SectionSetup
"configure peer-2-peer links between repositories"
paramNothing (seek <$$> optParser)
data P2POpts
= GenAddresses
| LinkRemote RemoteName
optParser :: CmdParamsDesc -> Parser P2POpts
optParser _ = genaddresses <|> linkremote
where
genaddresses = flag' GenAddresses
( long "gen-addresses"
<> help "generate addresses that allow accessing this repository over P2P networks"
)
linkremote = LinkRemote <$> strOption
( long "link"
<> metavar paramRemote
<> help "specify name to use for git remote"
)
seek :: P2POpts -> CommandSeek
seek GenAddresses = genAddresses =<< loadP2PAddresses
seek (LinkRemote name) = commandAction $
linkRemote (Git.Remote.makeLegalName name)
-- Only addresses are output to stdout, to allow scripting.
genAddresses :: [P2PAddress] -> Annex ()
genAddresses [] = giveup "No P2P networks are currrently available."
genAddresses addrs = do
authtoken <- liftIO $ genAuthToken 128
storeP2PAuthToken authtoken
earlyWarning "These addresses allow access to this git-annex repository. Only share them with people you trust with that access, using trusted communication channels!"
liftIO $ putStr $ unlines $
map formatP2PAddress $
map (`P2PAddressAuth` authtoken) addrs
-- Address is read from stdin, to avoid leaking it in shell history.
linkRemote :: RemoteName -> CommandStart
linkRemote remotename = do
showStart "p2p link" remotename
next $ next prompt
where
prompt = do
liftIO $ putStrLn ""
liftIO $ putStr "Enter peer address: "
liftIO $ hFlush stdout
s <- liftIO getLine
if null s
then do
liftIO $ hPutStrLn stderr "Nothing entered, giving up."
return False
else case unformatP2PAddress s of
Nothing -> do
liftIO $ hPutStrLn stderr "Unable to parse that address, please check its format and try again."
prompt
Just addr -> setup addr
setup (P2PAddressAuth addr authtoken) = do
g <- Annex.gitRepo
conn <- liftIO $ connectPeer g addr
`catchNonAsync` connerror
u <- getUUID
v <- liftIO $ runNetProto conn $ P2P.auth u authtoken
case v of
Right (Just theiruuid) -> do
ok <- inRepo $ Git.Command.runBool
[ Param "remote", Param "add"
, Param remotename
, Param (formatP2PAddress addr)
]
when ok $ do
storeUUIDIn (remoteConfig remotename "uuid") theiruuid
storeP2PRemoteAuthToken addr authtoken
return ok
Right Nothing -> giveup "Unable to authenticate with peer. Please check the address and try again."
Left e -> giveup $ "Unable to authenticate with peer: " ++ e
connerror e = giveup $ "Unable to connect with peer. Please check that the peer is connected to the network, and try again. (" ++ show e ++ ")"
|
