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

Both the local and remote git repositories get remotes added
pointing at one-another.

Makes pairing twice as easy!

Security: The new LINK command in the protocol can be sent repeatedly,
but only by a peer who has authenticated with us. So, it's entirely safe to
add a link back to that peer, or to some other peer it knows about.
Anything we receive over such a link, the peer could send us over the
current connection.

There is some risk of being flooded with LINKs, and adding too many
remotes. To guard against that, there's a hard cap on the number of remotes
that can be set up this way. This will only be a problem if setting up
large p2p networks that have exceptional interconnectedness.

A new, dedicated authtoken is created when sending LINK.

This also allows, in theory, using a p2p network like tor, to learn about
links on other networks, like telehash.

This commit was sponsored by Bruno BEAUFILS on Patreon.

1 files changed, 63 insertions, 0 deletions

diff --git a/P2P/Annex.hs b/P2P/Annex.hs
index 9971762f5..56f94d2bb 100644
--- a/P2P/Annex.hs
+++ b/P2P/Annex.hs
@@ -11,6 +11,8 @@ module P2P.Annex
 	( RunMode(..)
 	, P2PConnection(..)
 	, runFullProto
+	, unusedPeerRemoteName
+	, linkAddress
 	) where
 
 import Annex.Common
@@ -19,9 +21,16 @@ import Annex.Transfer
 import Annex.ChangedRefs
 import P2P.Protocol
 import P2P.IO
+import P2P.Address
+import P2P.Auth
 import Logs.Location
 import Types.NumCopies
 import Utility.Metered
+import qualified Git.Command
+import qualified Annex
+import Annex.UUID
+import Git.Types (RemoteName, remoteName, remotes)
+import Config
 
 import Control.Monad.Free
 
@@ -120,6 +129,17 @@ runLocal runmode runner a = case a of
 				Left e -> return (Left (show e))
 				Right changedrefs -> runner (next changedrefs)
 		_ -> return $ Left "change notification not available"
+	AddLinkToPeer addr next -> do
+		v <- tryNonAsync $ do
+			-- Flood protection; don't let a huge number
+			-- of peer remotes be created.
+			ns <- usedPeerRemoteNames
+			if length ns > 100
+				then return $ Right False
+				else linkAddress addr [] =<< unusedPeerRemoteName
+		case v of
+			Right (Right r) -> runner (next r)
+			_ -> runner (next False)
   where
 	transfer mk k af ta = case runmode of
 		-- Update transfer logs when serving.
@@ -152,3 +172,46 @@ runLocal runmode runner a = case a of
 				liftIO $ hSeek h AbsoluteSeek o
 			b <- liftIO $ hGetContentsMetered h p'
 			runner (sender b)
+
+unusedPeerRemoteName :: Annex RemoteName
+unusedPeerRemoteName = go (1 :: Integer) =<< usedPeerRemoteNames
+  where
+	go n names = do
+		let name = "peer" ++ show n
+		if name `elem` names
+			then go (n+1) names
+			else return name
+
+usedPeerRemoteNames :: Annex [RemoteName]
+usedPeerRemoteNames = filter ("peer" `isPrefixOf`) 
+	. mapMaybe remoteName . remotes <$> Annex.gitRepo
+
+linkAddress :: P2PAddressAuth -> [P2PAddressAuth] -> RemoteName -> Annex (Either String Bool)
+linkAddress (P2PAddressAuth addr authtoken) linkbackto remotename = do
+	g <- Annex.gitRepo
+	cv <- liftIO $ tryNonAsync $ connectPeer g addr
+	case cv of
+		Left e -> return $ Left $ "Unable to connect with peer. Please check that the peer is connected to the network, and try again. ("  ++ show e ++ ")"
+		Right conn -> do
+			u <- getUUID
+			v <- liftIO $ runNetProto conn $ do
+				authresp <- P2P.Protocol.auth u authtoken
+				lbok <- forM linkbackto $ P2P.Protocol.link
+				return (authresp, lbok)
+			case v of
+				Right (Just theiruuid, lbok) -> 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
+					if not ok
+						then return $ Right False
+						else if or lbok || null linkbackto
+							then return $ Right True
+							else return $ Left "Linked with peer. However, the peer was unable to link back to us, so the link is one-way."
+				Right (Nothing, _) -> return $ Left "Unable to authenticate with peer. Please check the address and try again."
+				Left e -> return $ Left $ "Unable to authenticate with peer: " ++ e