Revert "p2p --link now defaults to setting up a bi-directional link"

This reverts commit 3037feb1bf.

On second thought, this was an overcomplication of what should be the
lowest-level primitive. Let's build bi-directional links at the pairing
level with eg magic wormhole.
This commit is contained in:
Joey Hess 2016-12-16 18:26:07 -04:00
parent 5779e31cc7
commit 38f9337e16
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
7 changed files with 56 additions and 131 deletions

View file

@ -10,10 +10,15 @@ module Command.P2P where
import Command
import P2P.Address
import P2P.Auth
import P2P.Annex
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
@ -24,13 +29,10 @@ data P2POpts
= GenAddresses
| LinkRemote
data LinkDirection = BiDirectional | OneWay
optParser :: CmdParamsDesc -> Parser (P2POpts, Maybe RemoteName, LinkDirection)
optParser _ = (,,)
optParser :: CmdParamsDesc -> Parser (P2POpts, Maybe RemoteName)
optParser _ = (,)
<$> (genaddresses <|> linkremote)
<*> optional name
<*> direction
where
genaddresses = flag' GenAddresses
( long "gen-addresses"
@ -45,17 +47,23 @@ optParser _ = (,,)
<> metavar paramName
<> help "name of remote"
)
direction = flag BiDirectional OneWay
( long "one-way"
<> help "make one-way link, rather than default bi-directional link"
)
seek :: (P2POpts, Maybe RemoteName, LinkDirection) -> CommandSeek
seek (GenAddresses, _, _) = genAddresses =<< loadP2PAddresses
seek (LinkRemote, Just name, direction) = commandAction $
linkRemote direction (Git.Remote.makeLegalName name)
seek (LinkRemote, Nothing, direction) = commandAction $
linkRemote direction =<< unusedPeerRemoteName
seek :: (P2POpts, Maybe RemoteName) -> CommandSeek
seek (GenAddresses, _) = genAddresses =<< loadP2PAddresses
seek (LinkRemote, Just name) = commandAction $
linkRemote (Git.Remote.makeLegalName name)
seek (LinkRemote, Nothing) = commandAction $
linkRemote =<< unusedPeerRemoteName
unusedPeerRemoteName :: Annex RemoteName
unusedPeerRemoteName = go (1 :: Integer) =<< usednames
where
usednames = mapMaybe remoteName . remotes <$> Annex.gitRepo
go n names = do
let name = "peer" ++ show n
if name `elem` names
then go (n+1) names
else return name
-- Only addresses are output to stdout, to allow scripting.
genAddresses :: [P2PAddress] -> Annex ()
@ -69,8 +77,8 @@ genAddresses addrs = do
map (`P2PAddressAuth` authtoken) addrs
-- Address is read from stdin, to avoid leaking it in shell history.
linkRemote :: LinkDirection -> RemoteName -> CommandStart
linkRemote direction remotename = do
linkRemote :: RemoteName -> CommandStart
linkRemote remotename = do
showStart "p2p link" remotename
next $ next prompt
where
@ -87,13 +95,24 @@ linkRemote direction remotename = do
Nothing -> do
liftIO $ hPutStrLn stderr "Unable to parse that address, please check its format and try again."
prompt
Just addr -> do
linkbackto <- case direction of
OneWay -> return []
BiDirectional -> do
myaddrs <- loadP2PAddresses
authtoken <- liftIO $ genAuthToken 128
storeP2PAuthToken authtoken
return $ map (`P2PAddressAuth` authtoken) myaddrs
linkAddress addr linkbackto remotename
>>= either giveup return
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 ++ ")"