p2p --pair with magic wormhole (untested)

It builds. I have not tried to run it yet. :)

This commit was sponsored by Jake Vosloo on Patreon.

8 files changed, 288 insertions, 79 deletions

diff --git a/CHANGELOG b/CHANGELOG
index b4659fa02..95d135507 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,6 +1,8 @@
 git-annex (6.20161211) UNRELEASED; urgency=medium
 
-  * Debian: Build webapp on armel.
+  * p2p --pair makes it easy to pair repositories over P2P, using
+    Magic Wormhole codes to find the other repository.
+  * Debian: Recommend magic-wormhole.
   * metadata --batch: Fix bug when conflicting metadata changes were
     made in the same batch run.
   * Pass annex.web-options to wget and curl after other options, so that
@@ -14,6 +16,7 @@ git-annex (6.20161211) UNRELEASED; urgency=medium
     be processed without requiring it to be in the current encoding.
   * p2p: --link no longer takes a remote name, instead the --name
     option can be used.
+  * Debian: Build webapp on armel.
 
  -- Joey Hess <id@joeyh.name>  Sun, 11 Dec 2016 21:29:51 -0400
 
diff --git a/Command/P2P.hs b/Command/P2P.hs
index d59d774c4..ddc6c29df 100644
--- a/Command/P2P.hs
+++ b/Command/P2P.hs
@@ -12,13 +12,20 @@ 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
+import Utility.AuthToken
+import Utility.Tmp
+import Utility.FileMode
+import Utility.ThreadScheduler
+import qualified Utility.MagicWormhole as Wormhole
+
+import Control.Concurrent.Async
+import qualified Data.Text as T
 
 cmd :: Command
 cmd = command "p2p" SectionSetup
@@ -28,10 +35,11 @@ cmd = command "p2p" SectionSetup
 data P2POpts
 	= GenAddresses
 	| LinkRemote
+	| Pair
 
 optParser :: CmdParamsDesc -> Parser (P2POpts, Maybe RemoteName)
 optParser _ = (,)
-	<$> (genaddresses <|> linkremote)
+	<$> (pair <|> linkremote <|> genaddresses)
 	<*> optional name
   where
 	genaddresses = flag' GenAddresses
@@ -42,7 +50,11 @@ optParser _ = (,)
 		( long "link"
 		<> help "set up a P2P link to a git remote"
 		)
-	name = strOption
+	pair = flag' Pair
+		( long "pair"
+		<> help "pair with another repository"
+		)
+	name = Git.Remote.makeLegalName <$> strOption
 		( long "name"
 		<> metavar paramName
 		<> help "name of remote"
@@ -51,9 +63,14 @@ optParser _ = (,)
 seek :: (P2POpts, Maybe RemoteName) -> CommandSeek
 seek (GenAddresses, _) = genAddresses =<< loadP2PAddresses
 seek (LinkRemote, Just name) = commandAction $
-	linkRemote (Git.Remote.makeLegalName name)
+	linkRemote name
 seek (LinkRemote, Nothing) = commandAction $
 	linkRemote =<< unusedPeerRemoteName
+seek (Pair, Just name) = commandAction $
+	pairing name =<< loadP2PAddresses
+seek (Pair, Nothing) = commandAction $ do
+	name <- unusedPeerRemoteName
+	pairing name =<< loadP2PAddresses
 
 unusedPeerRemoteName :: Annex RemoteName
 unusedPeerRemoteName = go (1 :: Integer) =<< usednames
@@ -95,24 +112,178 @@ linkRemote remotename = do
 				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 ++ ")"
+				Just addr -> do
+					r <- setupLink remotename addr
+					case r of
+						LinkSuccess -> return True
+						ConnectionError e -> giveup e
+						AuthenticationError e -> giveup e
+
+pairing :: RemoteName -> [P2PAddress] -> CommandStart
+pairing _ [] = giveup "No P2P networks are currrently available."
+pairing remotename addrs = do
+	showStart "p2p pair" remotename
+	next $ next $ do
+		r <- wormholePairing remotename addrs ui
+		case r of
+			PairSuccess -> return True
+			SendFailed -> do
+				warning "Failed sending data to pair."
+				return False
+			ReceiveFailed -> do
+				warning "Failed receiving data from pair."
+				return False
+			LinkFailed e -> do
+				warning $ "Failed linking to pair: " ++ e
+				return False
+  where
+	ui observer producer = do
+		ourcode <- Wormhole.waitCode observer
+		putStrLn ""
+		putStrLn $ "This repository's pairing code is: " ++
+			Wormhole.fromCode ourcode
+		putStrLn ""
+		theircode <- getcode ourcode
+		Wormhole.sendCode producer theircode
+	
+	getcode ourcode = do
+		putStr "Enter the other repository's pairing code: "
+		hFlush stdout
+		fileEncoding stdin
+		l <- getLine
+		case Wormhole.toCode l of
+			Just code
+				| code /= ourcode -> return code
+				| otherwise -> do
+					putStrLn "Oops -- You entered this repository's pairing code. We need the pairing code of the *other* repository."
+					getcode ourcode
+			Nothing -> do
+				putStrLn "That does not look like a valid code. Try again..."
+				getcode ourcode
+
+-- We generate half of the authtoken; the pair will provide
+-- the other half.
+newtype HalfAuthToken = HalfAuthToken T.Text
+	deriving (Show)
+
+data PairData = PairData HalfAuthToken [P2PAddress]
+	deriving (Show)
+
+serializePairData :: PairData -> String
+serializePairData (PairData (HalfAuthToken ha) addrs) = unlines $
+	T.unpack ha : map formatP2PAddress addrs
+
+deserializePairData :: String -> Maybe PairData
+deserializePairData s = case lines s of
+	[] -> Nothing
+	(ha:l) -> do
+		addrs <- mapM unformatP2PAddress l
+		return (PairData (HalfAuthToken (T.pack ha)) addrs)
+
+data PairingResult
+	= PairSuccess
+	| SendFailed
+	| ReceiveFailed
+	| LinkFailed String
+
+wormholePairing
+	:: RemoteName
+	-> [P2PAddress]
+	-> (Wormhole.CodeObserver -> Wormhole.CodeProducer -> IO ())
+	-> Annex PairingResult
+wormholePairing remotename ouraddrs ui = do
+	ourhalf <- liftIO $ HalfAuthToken . fromAuthToken
+		<$> genAuthToken 64
+	let ourpairdata = PairData ourhalf ouraddrs
+
+	-- The magic wormhole interface only supports exchanging
+	-- files. Permissions of received files may allow others
+	-- to read them. So, set up a temp directory that only
+	-- we can read.
+	withTmpDir "pair" $ \tmp -> do
+		liftIO $ void $ tryIO $ modifyFileMode tmp $ 
+			removeModes otherGroupModes
+		let sendf = tmp </> "send"
+		let recvf = tmp </> "recv"
+		liftIO $ writeFileProtected sendf $
+			serializePairData ourpairdata
+
+		observer <- liftIO Wormhole.mkCodeObserver
+		producer <- liftIO Wormhole.mkCodeProducer
+		void $ liftIO $ async $ ui observer producer
+		(sendres, recvres) <- liftIO $
+			Wormhole.sendFile sendf observer []
+				`concurrently`
+			Wormhole.receiveFile recvf producer []
+		liftIO $ nukeFile sendf
+		if sendres /= True
+			then return SendFailed
+			else if recvres /= True
+				then return ReceiveFailed
+				else do
+					r <- liftIO $ tryIO $
+						readFileStrictAnyEncoding recvf
+					case r of
+						Left _e -> return ReceiveFailed
+						Right s -> maybe 
+							(return ReceiveFailed)
+							(finishPairing 100 remotename ourhalf)
+							(deserializePairData s)
+
+-- | Allow the peer we're pairing with to authenticate to us,
+-- using an authtoken constructed from the two HalfAuthTokens.
+-- Connect to the peer we're pairing with, and try to link to them.
+--
+-- Multiple addresses may have been received for the peer. This only
+-- makes a link to one address.
+--
+-- Since we're racing the peer as they do the same, the first try is likely
+-- to fail to authenticate. Can retry any number of times, to avoid the
+-- users needing to redo the whole process.
+finishPairing :: Int -> RemoteName -> HalfAuthToken -> PairData -> Annex PairingResult
+finishPairing retries remotename (HalfAuthToken ourhalf) (PairData (HalfAuthToken theirhalf) theiraddrs) = do
+	case (toAuthToken (ourhalf <> theirhalf), toAuthToken (theirhalf <> ourhalf)) of
+		(Just ourauthtoken, Just theirauthtoken) -> do
+			liftIO $ putStrLn $ "Successfully exchanged pairing data. Connecting to " ++ remotename ++  " ..."
+			storeP2PAuthToken ourauthtoken
+			go retries theiraddrs theirauthtoken
+		_ -> return ReceiveFailed
+  where
+	go 0 [] _ = return $ LinkFailed $ "Unable to connect to " ++ remotename ++ "."
+	go n [] theirauthtoken = do
+		liftIO $ threadDelaySeconds (Seconds 2)
+		liftIO $ putStrLn $ "Unable to connect to " ++ remotename ++ ". Retrying..."
+		go (n-1) theiraddrs theirauthtoken
+	go n (addr:rest) theirauthtoken = do
+		r <- setupLink remotename (P2PAddressAuth addr theirauthtoken)
+		case r of
+			LinkSuccess -> return PairSuccess
+			_ -> go n rest theirauthtoken
+
+data LinkResult
+	= LinkSuccess
+	| ConnectionError String
+	| AuthenticationError String
+
+setupLink :: RemoteName -> P2PAddressAuth -> Annex LinkResult
+setupLink remotename (P2PAddressAuth addr authtoken) = do
+	g <- Annex.gitRepo
+	cv <- liftIO $ tryNonAsync $ connectPeer g addr
+	case cv of
+		Left e -> return $ ConnectionError $ "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
+			go =<< liftIO (runNetProto conn $ P2P.auth u authtoken)
+  where
+	go (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 LinkSuccess
+	go (Right Nothing) = return $ AuthenticationError "Unable to authenticate with peer. Please check the address and try again."
+	go (Left e) = return $ AuthenticationError $ "Unable to authenticate with peer: " ++ e
diff --git a/Utility/MagicWormhole.hs b/Utility/MagicWormhole.hs
index a71cc69e0..9ab804800 100644
--- a/Utility/MagicWormhole.hs
+++ b/Utility/MagicWormhole.hs
@@ -5,9 +5,11 @@
  - License: BSD-2-clause
  -}
 
-module Utility.MagicWormHole (
+module Utility.MagicWormhole (
 	Code,
 	mkCode,
+	toCode,
+	fromCode,
 	validCode,
 	CodeObserver,
 	CodeProducer,
@@ -32,9 +34,11 @@ import System.Exit
 import Control.Concurrent
 import Control.Exception
 import Data.Char
+import Data.List
 
 -- | A Magic Wormhole code.
 newtype Code = Code String
+	deriving (Eq, Show)
 
 -- | Smart constructor for Code
 mkCode :: String -> Maybe Code
@@ -42,6 +46,13 @@ mkCode s
 	| validCode s = Just (Code s)
 	| otherwise = Nothing
 
+-- | Tries to fix up some common mistakes in a homan-entered code.
+toCode :: String -> Maybe Code
+toCode s = mkCode $ intercalate "-" $ words s
+
+fromCode :: Code -> String
+fromCode (Code s) = s
+
 -- | Codes have the form number-word-word and may contain 2 or more words.
 validCode :: String -> Bool
 validCode s = 
diff --git a/debian/control b/debian/control
index 8be9fec99..644c22035 100644
--- a/debian/control
+++ b/debian/control
@@ -112,6 +112,7 @@ Recommends:
 	git-remote-gcrypt (>= 0.20130908-6),
 	nocache,
 	aria2,
+	magic-wormhole,
 Suggests:
 	xdot,
 	bup,
diff --git a/doc/git-annex-p2p.mdwn b/doc/git-annex-p2p.mdwn
index 6c50c9dd2..127ed9a5d 100644
--- a/doc/git-annex-p2p.mdwn
+++ b/doc/git-annex-p2p.mdwn
@@ -16,11 +16,30 @@ services.
 
 # OPTIONS
 
+* `--pair`
+
+  Run this in two repositories to pair them together over the P2P network.
+
+  This will print out a code phrase, like "3-mango-elephant", and
+  will prompt for you to enter the code phrase from the other repository.
+
+  Once code phrases have been exchanged, the two repositories will
+  be paired. A git remote will be created for the other repository,
+  with a name like "peer1".
+
+  This uses [Magic Wormhole](https://github.com/warner/magic-wormhole)
+  to verify the code phrases and securely communicate the P2P addresses of
+  the repositories, so you will need it installed on both computers that are
+  being paired.
+
 * `--gen-address`
 
   Generates addresses that can be used to access this git-annex repository
   over the available P2P networks. The address or addresses is output to
-  stdout.
+  stdout. 
+  
+  Note that anyone who knows these addresses can access your
+  repository over the P2P networks.
 
 * `--link`
 
@@ -34,7 +53,8 @@ services.
 
 * `--name`
 
-  Specify a name to use when setting up a git remote.
+  Specify a name to use when setting up a git remote with `--link`
+  or `--pair`.
 
 # SEE ALSO
 
@@ -44,6 +64,8 @@ services.
 
 [[git-annex-remotedaemon]](1)
 
+wormhole(1)
+
 # AUTHOR
 
 Joey Hess <id@joeyh.name>
diff --git a/doc/tips/peer_to_peer_network_with_tor.mdwn b/doc/tips/peer_to_peer_network_with_tor.mdwn
index 9c97735e4..b6aafa534 100644
--- a/doc/tips/peer_to_peer_network_with_tor.mdwn
+++ b/doc/tips/peer_to_peer_network_with_tor.mdwn
@@ -1,69 +1,56 @@
 git-annex has recently gotten support for running as a
 [Tor](https://torproject.org/) hidden service. This is a nice secure
-and easy to use way to connect repositories between peers in different
-locations, without needing any central server.
+and easy to use way to connect repositories in different
+locations. No account on a central server is needed; it's peer-to-peer.
 
-## setting up the first peer
+## dependencies
 
-First, you need to get Tor installed and running. See
+To use this, you need to get Tor installed and running. See
 [their website](https://torproject.org/), or try a command like:
 
 	sudo apt-get install tor
 
-To make git-annex use Tor, run these commands in your git-annex repository:
+You also need to install [Magic Wormhole](https://github.com/warner/magic-wormhole).
 
-	sudo git annex enable-tor $(id -u)
-	git annex remotedaemon
-	git annex p2p --gen-addresses
-
-The p2p command will output a long address, such as:
-
-	tor-annex::eeaytkuhaupbarfi.onion:4412:7f53c5b65b8957ef626fd461ceaae8056e3dbc459ae715e4
+	sudo apt-get install magic-wormhole
 
-At this point, git-annex is running as a tor hidden service, but
-it will only talk to peers who know that address.
+## pairing two repositories
 
-## adding additional peers
-
-To add a peer, get tor installed and running on it.
-
-	sudo apt-get install tor
+You have two git-annex repositories on different computers, and want to
+connect them together over Tor so they share their contents. Or, you and a
+friend want to connect your repositories together. Pairing is an easy way
+to accomplish this.
 
-You need a git-annex repository on the new peer. It's fine to start
-with a new empty repository:
-
-	git init annex
-	cd annex
-	git annex init
-
-And make git-annex use Tor, by running these commands in the git-annex
-repository:
+In each git-annex repository, run these commands:
 
 	sudo git annex enable-tor $(id -u)
 	git annex remotedaemon
 
-Now, tell the new peer about the address of the first peer.
-This will make a git remote named "peer1", which connects,
-through Tor, to the repository on the other peer.
+Now git-annex is running as a Tor hidden service, but 
+it will only talk to peers after pairing with them.
+
+In both repositories, run this command:
 
-	git annex p2p --link --name peer1
+	git annex p2p --pair
 
-That command will prompt for an address; paste in the address that was
-generated on the first peer, and then press Enter.
+This will print out a code phrase, like "11-incredible-tumeric",
+and prompt for you to enter the other repository's code phrase.
 
-Now you can run any commands you normally would to sync with the
-peer1 remote:
+Once the code phrases are exchanged, the two repositories will be securely
+connected to one-another via Tor. Each will have a git remote, with a name
+like "peer1", which connects to the other repository.
 
-	git annex sync --content peer1
+Then, you can run commands like `git annex sync peer1 --content` to sync
+with the paired repository.
 
-You can also generate an address for this new peer, by running `git annex
-p2p --gen-addresses`, and link other peers to that address using `git annex
-p2p --link`. It's often useful to link peers up in both directions,
-so peer1 is a remote of peer2 and peer2 is a remote of peer1.
+The Magic Wormhole code phrases used during pairing will no longer be
+useful for anything afterwards.
 
-Any number of peers can be connected this way, within reason.
+Pairing connects just two repositories, but you can repeat the process to
+pair with as many other repositories as you like, in order to build up
+larger networks of repositories.
 
-## starting git-annex remotedaemon
+## starting git-annex remotedaemon on boot
 
 Notice the `git annex remotedaemon` being run in the above examples.
 That command runs the Tor hidden service so that other peers
@@ -72,7 +59,7 @@ can connect to your repository over Tor.
 So, you may want to arrange for the remotedaemon to be started on boot.
 You can do that with a simple cron job:
 
-	@reboot cd myannexrepo && git annex remotedaemon
+	@reboot cd ~/myannexrepo && git annex remotedaemon
 
 If you use the git-annex assistant, and have it auto-starting on boot, it
 will take care of starting the remotedaemon for you.
@@ -84,9 +71,9 @@ bandwidth to go around. So, distributing large quantities (gigabytes)
 of data over Tor may be slow, and should probably be avoided.
 
 One way to avoid sending much data over tor is to set up an encrypted
-[[special_remote|special_remotes]]. git-annex knows that Tor is rather
-expensive to use, so if a file is available on a special remote as well as
-over Tor, it will download it from the special remote.
+[[special_remote|special_remotes]] someplace. git-annex knows that Tor is
+rather expensive to use, so if a file is available on a special remote as
+well as over Tor, it will download it from the special remote.
 
 You can contribute to the Tor network by
 [running a Tor relay or bridge](https://www.torproject.org/getinvolved/relays.html.en).
@@ -115,6 +102,9 @@ When you run `git annex peer --link`, it sets up a git remote using
 the onion address, and it stashes the authentication data away in a file in
 `.git/annex/creds/`
 
+When you pair repositories, these addresses are exchanged using 
+[Magic Wormhole](https://github.com/warner/magic-wormhole).
+
 ## security
 
 Tor hidden services can be quite secure. But this doesn't mean that using
@@ -144,3 +134,14 @@ to consider:
 
 * An attacker who can connect to the git-annex Tor hidden service, even
   without authenticating, can try to perform denial of service attacks.
+
+* Magic wormhole is pretty secure, but the code phrase could be guessed
+  (unlikely) or intercepted. An attacker gets just one chance to try to enter
+  the correct code phrase, before pairing finishes. If the attacker
+  successfully guesses/intercepts both code phrases, they can MITM the
+  pairing process.
+
+  If you don't want to use magic wormhole, you can instead manually generate
+  addresses with `git annex p2p --gen-addresses` and send them over an
+  authenticated, encrypted channel (such as OTR) to a friend to add with
+  `git annex p2p --link`. This may be more secure, if you get it right.
diff --git a/doc/todo/tor.mdwn b/doc/todo/tor.mdwn
index 262926d0f..cb0bc4d41 100644
--- a/doc/todo/tor.mdwn
+++ b/doc/todo/tor.mdwn
@@ -16,8 +16,8 @@ Eventually:
 * Limiting authtokens to read-only access.
 * Revoking authtokens. (This and read-only need a name associated with an
   authtoken, so the user can adjust its configuration after creating it.)
-* address exchange for peering. See [[design/assistant/telehash]].
-* Webapp UI to set it upt.
+* Pairing via magic wormhole.
+* Webapp UI to set it up.
 * friend-of-a-friend peer discovery to build more interconnected networks
   of nodes
 * Discovery of nodes on same LAN, and direct connection to them.
diff --git a/git-annex.cabal b/git-annex.cabal
index 694ab2481..2f07c8437 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -1044,7 +1044,7 @@ Executable git-annex
     Utility.LockPool.Windows
     Utility.LogFile
     Utility.Lsof
-    Utility.MagicWormHole
+    Utility.MagicWormhole
     Utility.Matcher
     Utility.Metered
     Utility.Misc