From 49da2d5efdad0038f22bc5e3bc50cf117849d472 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 17 Nov 2016 17:19:04 -0400
Subject: implementation of peer-to-peer protocol

For use with tor hidden services, and perhaps other transports later.

Based on Utility.SimpleProtocol, it's a line-based protocol,
interspersed with transfers of bytestrings of a specified size.

Implementation of the local and remote sides of the protocol is done
using a free monad. This lets monadic code be included here, without
tying it to any particular way to get bytes peer-to-peer.

This adds a dependency on the haskell package "free", although that
was probably pulled in transitively from other dependencies already.

This commit was sponsored by Jeff Goeke-Smith on Patreon.
---
 debian/control | 1 +
 1 file changed, 1 insertion(+)

(limited to 'debian/control')

diff --git a/debian/control b/debian/control
index ec77a2946..07630dfa2 100644
--- a/debian/control
+++ b/debian/control
@@ -64,6 +64,7 @@ Build-Depends:
 	libghc-xml-types-dev,
 	libghc-async-dev,
 	libghc-monad-logger-dev,
+	ligghc-free-dev,
 	libghc-feed-dev (>= 0.3.9.2),
 	libghc-regex-tdfa-dev,
 	libghc-tasty-dev (>= 0.7),
-- 
cgit v1.2.3


From 01bf227ad1d9bd30d6fad2dc104b264a1f55c2c4 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 21 Nov 2016 17:27:38 -0400
Subject: Added git-remote-tor-annex, which allows git pull and push to the tor
 hidden service.

Almost working, but there's a bug in the relaying.

Also, made tor hidden service setup pick a random port, to make it harder
to port scan.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.
---
 Build/Mans.hs                 |  7 +++--
 CHANGELOG                     |  2 ++
 CmdLine/GitRemoteTorAnnex.hs  | 62 +++++++++++++++++++++++++++++++++++++++++
 Command/EnableTor.hs          |  8 +++---
 Makefile                      |  3 ++
 Remote/Helper/P2P.hs          | 11 ++++++--
 Remote/Helper/P2P/IO.hs       | 64 +++++++++++++++++++++++++++----------------
 Remote/Helper/Tor.hs          | 34 +++++++++++++++++++++++
 RemoteDaemon/Transport/Tor.hs |  6 ++--
 Setup.hs                      |  8 ++++--
 Types/Creds.hs                |  2 +-
 Utility/Tor.hs                | 40 ++++++++++++++++++++++-----
 debian/control                |  1 +
 doc/git-annex-enable-tor.mdwn |  2 +-
 doc/git-remote-tor-annex.mdwn | 36 ++++++++++++++++++++++++
 git-annex.cabal               |  7 ++++-
 git-annex.hs                  | 22 ++++++---------
 17 files changed, 254 insertions(+), 61 deletions(-)
 create mode 100644 CmdLine/GitRemoteTorAnnex.hs
 create mode 100644 Remote/Helper/Tor.hs
 create mode 100644 doc/git-remote-tor-annex.mdwn

(limited to 'debian/control')

diff --git a/Build/Mans.hs b/Build/Mans.hs
index cf86d983d..2ea9b4197 100644
--- a/Build/Mans.hs
+++ b/Build/Mans.hs
@@ -50,8 +50,11 @@ buildMans = do
 			else return (Just dest)
 
 isManSrc :: FilePath -> Bool
-isManSrc s = "git-annex" `isPrefixOf` (takeFileName s)
-	&& takeExtension s == ".mdwn"
+isManSrc s
+	| not (takeExtension s == ".mdwn") = False
+	| otherwise = "git-annex" `isPrefixOf` f || "git-remote-" `isPrefixOf` f
+  where
+	f = takeFileName s
 
 srcToDest :: FilePath -> FilePath
 srcToDest s = "man" </> progName s ++ ".1"
diff --git a/CHANGELOG b/CHANGELOG
index 28a30c206..cc20ec751 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -2,6 +2,8 @@ git-annex (6.20161119) UNRELEASED; urgency=medium
 
   * enable-tor: New command, enables tor hidden service for P2P syncing.
   * remotedaemon: Serve tor hidden service.
+  * Added git-remote-tor-annex, which allows git pull and push to the tor
+    hidden service.
   * remotedaemon: Fork to background by default. Added --foreground switch
     to enable old behavior.
 
diff --git a/CmdLine/GitRemoteTorAnnex.hs b/CmdLine/GitRemoteTorAnnex.hs
new file mode 100644
index 000000000..bc001f42f
--- /dev/null
+++ b/CmdLine/GitRemoteTorAnnex.hs
@@ -0,0 +1,62 @@
+{- git-remote-tor-annex program
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module CmdLine.GitRemoteTorAnnex where
+
+import Common
+import qualified Annex
+import qualified Git.CurrentRepo
+import Remote.Helper.P2P
+import Remote.Helper.P2P.IO
+import Remote.Helper.Tor
+import Utility.Tor
+import Annex.UUID
+
+run :: [String] -> IO ()
+run (_remotename:address:[]) = forever $ do
+	-- gitremote-helpers protocol
+	l <- getLine
+	case l of
+		"capabilities" -> do
+			putStrLn "connect"
+			putStrLn ""
+		"connect git-upload-pack" -> go UploadPack
+		"connect git-receive-pack" -> go ReceivePack
+		_ -> error $ "git-remote-helpers protocol error at " ++ show l
+  where
+	(onionaddress, onionport)
+		| '/' `elem` address = parseAddressPort $
+			reverse $ takeWhile (/= '/') $ reverse address
+		| otherwise = parseAddressPort address
+	go service = do
+		putStrLn ""
+		hFlush stdout
+		connectService onionaddress onionport service >>= exitWith
+run (_remotename:[]) = giveup "remote address not configured"
+run _ = giveup "expected remote name and address parameters"
+
+parseAddressPort :: String -> (OnionAddress, OnionPort)
+parseAddressPort s = 
+	let (a, sp) = separate (== ':') s
+	in case readish sp of
+		Nothing -> giveup "onion address must include port number"
+		Just p -> (OnionAddress a, p)
+
+connectService :: OnionAddress -> OnionPort -> Service -> IO ExitCode
+connectService address port service = do
+	state <- Annex.new =<< Git.CurrentRepo.get
+	Annex.eval state $ do
+		authtoken <- fromMaybe nullAuthToken
+			<$> getTorAuthToken address
+		myuuid <- getUUID
+		g <- Annex.gitRepo
+		h <- liftIO $ torHandle =<< connectHiddenService address port
+		runNetProtoHandle h h g $ do
+			v <- auth myuuid authtoken
+			case v of
+				Just _theiruuid -> connect service stdin stdout
+				Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ torAuthTokenEnv
diff --git a/Command/EnableTor.hs b/Command/EnableTor.hs
index 369ea7509..c581fa1d4 100644
--- a/Command/EnableTor.hs
+++ b/Command/EnableTor.hs
@@ -24,11 +24,11 @@ start :: CmdParams -> CommandStart
 start (suserid:uuid:[]) = case readish suserid of
 	Nothing -> error "Bad userid"
 	Just userid -> do
-		(onionaddr, onionport, onionsocket) <- liftIO $
+		(OnionAddress onionaddr, onionport) <- liftIO $
 			addHiddenService userid uuid
-		liftIO $ putStrLn $
+		liftIO $ putStrLn $ 
+			"tor-annex::" ++
 			onionaddr ++ ":" ++ 
-			show onionport ++ " " ++
-			show onionsocket
+			show onionport ++ " "
 		stop
 start _ = error "Bad params"
diff --git a/Makefile b/Makefile
index e05546c52..56e725db2 100644
--- a/Makefile
+++ b/Makefile
@@ -55,6 +55,7 @@ install-bins: build
 	install -d $(DESTDIR)$(PREFIX)/bin
 	install git-annex $(DESTDIR)$(PREFIX)/bin
 	ln -sf git-annex $(DESTDIR)$(PREFIX)/bin/git-annex-shell
+	ln -sf git-annex $(DESTDIR)$(PREFIX)/bin/git-remote-tor-annex
 
 install-misc: Build/InstallDesktopFile
 	./Build/InstallDesktopFile $(PREFIX)/bin/git-annex || true
@@ -133,6 +134,7 @@ linuxstandalone-nobuild: Build/Standalone Build/LinuxMkLibs
 	cp git-annex "$(LINUXSTANDALONE_DEST)/bin/"
 	strip "$(LINUXSTANDALONE_DEST)/bin/git-annex"
 	ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-annex-shell"
+	ln -sf git-annex "$(LINUXSTANDALONE_DEST)/bin/git-remote-tor-annex"
 	zcat standalone/licences.gz > $(LINUXSTANDALONE_DEST)/LICENSE
 	cp doc/logo_16x16.png doc/logo.svg $(LINUXSTANDALONE_DEST)
 	cp standalone/trustedkeys.gpg $(LINUXSTANDALONE_DEST)
@@ -194,6 +196,7 @@ osxapp: Build/Standalone Build/OSXMkLibs
 	cp git-annex "$(OSXAPP_BASE)"
 	strip "$(OSXAPP_BASE)/git-annex"
 	ln -sf git-annex "$(OSXAPP_BASE)/git-annex-shell"
+	ln -sf git-annex "$(OSXAPP_BASE)/git-remote-tor-annex"
 	gzcat standalone/licences.gz > $(OSXAPP_BASE)/LICENSE
 	cp $(OSXAPP_BASE)/LICENSE tmp/build-dmg/LICENSE.txt
 	cp standalone/trustedkeys.gpg $(OSXAPP_DEST)/Contents/MacOS
diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index 1e1519560..7e49968ee 100644
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -26,6 +26,12 @@ import qualified Data.ByteString.Lazy as L
 newtype AuthToken = AuthToken String
 	deriving (Show)
 
+mkAuthToken :: String -> Maybe AuthToken
+mkAuthToken = fmap AuthToken . headMaybe . lines
+
+nullAuthToken :: AuthToken
+nullAuthToken = AuthToken ""
+
 newtype Offset = Offset Integer
 	deriving (Show)
 
@@ -157,6 +163,7 @@ type Net = Free NetF
 data RelayData
 	= RelayData L.ByteString
 	| RelayMessage Message
+	deriving (Show)
 
 newtype RelayHandle = RelayHandle Handle
 
@@ -400,8 +407,8 @@ relayCallback hout (RelayMessage (DATA len)) = do
 	return Nothing
 relayCallback _ (RelayMessage (CONNECTDONE exitcode)) =
 	return (Just exitcode)
-relayCallback _ (RelayMessage _) = do
-	sendMessage (ERROR "expected DATA or CONNECTDONE")
+relayCallback _ (RelayMessage m) = do
+	sendMessage $ ERROR $ "expected DATA or CONNECTDONE not " ++ unwords (Proto.formatMessage m)
 	return (Just (ExitFailure 1))
 relayCallback _ (RelayData b) = do
 	let len = Len $ fromIntegral $ L.length b
diff --git a/Remote/Helper/P2P/IO.hs b/Remote/Helper/P2P/IO.hs
index 6908fd68c..c6a80cdbf 100644
--- a/Remote/Helper/P2P/IO.hs
+++ b/Remote/Helper/P2P/IO.hs
@@ -19,6 +19,7 @@ import Git
 import Git.Command
 import Utility.SafeCommand
 import Utility.SimpleProtocol
+import Utility.Exception
 
 import Control.Monad
 import Control.Monad.Free
@@ -30,7 +31,7 @@ import Control.Concurrent
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 
-type RunProto = forall a m. MonadIO m => Proto a -> m a
+type RunProto = forall a m. (MonadIO m, MonadMask m) => Proto a -> m a
 
 data S = S
 	{ repo :: Repo
@@ -40,7 +41,7 @@ data S = S
 
 -- Implementation of the protocol, communicating with a peer
 -- over a Handle. No Local actions will be run.
-runNetProtoHandle :: MonadIO m => Handle -> Handle -> Repo -> Proto a -> m a
+runNetProtoHandle :: (MonadIO m, MonadMask m) => Handle -> Handle -> Repo -> Proto a -> m a
 runNetProtoHandle i o r = go
   where
 	go :: RunProto
@@ -48,7 +49,7 @@ runNetProtoHandle i o r = go
 	go (Free (Net n)) = runNetHandle (S r i o) go n
 	go (Free (Local _)) = error "local actions not allowed"
 
-runNetHandle :: MonadIO m => S -> RunProto -> NetF (Proto a) -> m a
+runNetHandle :: (MonadIO m, MonadMask m) => S -> RunProto -> NetF (Proto a) -> m a
 runNetHandle s runner f = case f of
 	SendMessage m next -> do
 		liftIO $ do
@@ -57,10 +58,11 @@ runNetHandle s runner f = case f of
 		runner next
 	ReceiveMessage next -> do
 		l <- liftIO $ hGetLine (ihdl s)
+		-- liftIO $ hPutStrLn stderr ("< " ++ show l)
 		case parseMessage l of
 			Just m -> runner (next m)
 			Nothing -> runner $ do
-				let e = ERROR "protocol parse error"
+				let e = ERROR $ "protocol parse error: " ++ show l
 				net $ sendMessage e
 				next e
 	SendBytes _len b next -> do
@@ -70,6 +72,7 @@ runNetHandle s runner f = case f of
 		runner next
 	ReceiveBytes (Len n) next -> do
 		b <- liftIO $ L.hGet (ihdl s) (fromIntegral n)
+		--liftIO $ hPutStrLn stderr $ "!!!" ++ show (L.length b)
 		runner (next b)
 	CheckAuthToken u t next -> do
 		authed <- return True -- TODO XXX FIXME really check
@@ -80,7 +83,8 @@ runNetHandle s runner f = case f of
 		runRelayService s runner service callback >>= runner . next
 	WriteRelay (RelayHandle h) b next -> do
 		liftIO $ do
-			L.hPut h b
+			-- L.hPut h b
+			hPutStrLn h (show ("relay got:", b, L.length b))
 			hFlush h
 		runner next
 
@@ -112,43 +116,57 @@ runRelay runner (RelayHandle hout) callback = do
 
 	drain v = do
 		d <- takeMVar v
+		liftIO $ hPutStrLn stderr (show d)
 		r <- runner $ net $ callback d
 		case r of
 			Nothing -> drain v
 			Just exitcode -> return exitcode
 
 runRelayService
-	:: MonadIO m
+	:: (MonadIO m, MonadMask m)
 	=> S
 	-> RunProto
 	-> Service
 	-> (RelayHandle -> RelayData -> Net (Maybe ExitCode))
 	-> m ExitCode
-runRelayService s runner service callback = do
-	v <- liftIO newEmptyMVar
-	(Just hin, Just hout, _, pid) <- liftIO $ createProcess serviceproc
-		{ std_out = CreatePipe
-		, std_in = CreatePipe
-		}
-	_ <- liftIO $ forkIO $ readout v hout
-	feeder <- liftIO $ forkIO $ feedin v
-	_ <- liftIO $ forkIO $ putMVar v . Left =<< waitForProcess pid
-	exitcode <- liftIO $ drain v hin
-	liftIO $ killThread feeder
-	return exitcode
+runRelayService s runner service callback = bracket setup cleanup go
   where
 	cmd = case service of
 		UploadPack -> "upload-pack"
 		ReceivePack -> "receive-pack"
-	serviceproc = gitCreateProcess [Param cmd, File (repoPath (repo s))] (repo s)
+	
+	serviceproc = gitCreateProcess
+		[ Param cmd
+		, File (repoPath (repo s))
+		] (repo s)
+
+	setup = do
+		v <- liftIO newEmptyMVar
+		(Just hin, Just hout, _, pid) <- liftIO $ 
+			createProcess serviceproc
+				{ std_out = CreatePipe
+				, std_in = CreatePipe
+				}
+		feeder <- liftIO $ forkIO $ feedin v
+		return (v, feeder, hin, hout, pid)
+
+	cleanup (_, feeder, hin, hout, pid) = liftIO $ do
+		hClose hin
+		hClose hout
+		liftIO $ killThread feeder
+		void $ waitForProcess pid
+
+	go (v, _, hin, hout, pid) = do
+		_ <- liftIO $ forkIO $ readout v hout
+		_ <- liftIO $ forkIO $ putMVar v . Left =<< waitForProcess pid
+		liftIO $ drain v hin
 
 	drain v hin = do
 		d <- takeMVar v
 		case d of
-			Left exitcode -> do
-				hClose hin
-				return exitcode
+			Left exitcode -> return exitcode
 			Right relaydata -> do
+				liftIO $ hPutStrLn stderr ("> " ++ show relaydata)
 				_ <- runner $ net $
 					callback (RelayHandle hin) relaydata
 				drain v hin
@@ -156,7 +174,7 @@ runRelayService s runner service callback = do
 	readout v hout = do
 		b <- B.hGetSome hout 65536
 		if B.null b
-			then hClose hout
+			then return ()
 			else do
 				putMVar v $ Right $ 
 					RelayData (L.fromChunks [b])
diff --git a/Remote/Helper/Tor.hs b/Remote/Helper/Tor.hs
new file mode 100644
index 000000000..e91083362
--- /dev/null
+++ b/Remote/Helper/Tor.hs
@@ -0,0 +1,34 @@
+{- Helpers for tor remotes.
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Helper.Tor where
+
+import Annex.Common
+import Remote.Helper.P2P (mkAuthToken, AuthToken)
+import Creds
+import Utility.Tor
+import Utility.Env
+
+import Network.Socket
+
+getTorAuthToken :: OnionAddress -> Annex (Maybe AuthToken)
+getTorAuthToken (OnionAddress onionaddress) =
+	maybe Nothing mkAuthToken <$> getM id 
+		[ liftIO $ getEnv torAuthTokenEnv
+		, readCacheCreds onionaddress
+		]
+
+torAuthTokenEnv :: String
+torAuthTokenEnv = "GIT_ANNEX_TOR_AUTHTOKEN"
+
+torHandle :: Socket -> IO Handle
+torHandle s = do
+	h <- socketToHandle s ReadWriteMode
+	hSetBuffering h LineBuffering
+	hSetBinaryMode h False
+	fileEncoding h
+	return h
diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs
index da30bf944..e0922a766 100644
--- a/RemoteDaemon/Transport/Tor.hs
+++ b/RemoteDaemon/Transport/Tor.hs
@@ -12,6 +12,7 @@ import RemoteDaemon.Types
 import RemoteDaemon.Common
 import Utility.Tor
 import Utility.FileMode
+import Remote.Helper.Tor
 import Remote.Helper.P2P
 import Remote.Helper.P2P.IO
 import Annex.UUID
@@ -43,9 +44,6 @@ server th@(TransportHandle (LocalRepo r) _) = do
 		(conn, _) <- accept soc
 		forkIO $ do
 			debugM "remotedaemon" "handling a connection"
-			h <- socketToHandle conn ReadWriteMode
-			hSetBuffering h LineBuffering
-			hSetBinaryMode h False
+			h <- torHandle conn
 			runNetProtoHandle h h r (serve u)
 			hClose h
-
diff --git a/Setup.hs b/Setup.hs
index fe06a08b1..57efd86e0 100644
--- a/Setup.hs
+++ b/Setup.hs
@@ -33,17 +33,19 @@ main = defaultMainWithHooks simpleUserHooks
 
 myPostCopy :: Args -> CopyFlags -> PackageDescription -> LocalBuildInfo -> IO ()
 myPostCopy _ flags pkg lbi = when (System.Info.os /= "mingw32") $ do
-	installGitAnnexShell dest verbosity pkg lbi
+	installGitAnnexLinks dest verbosity pkg lbi
 	installManpages      dest verbosity pkg lbi
 	installDesktopFile   dest verbosity pkg lbi
   where
 	dest      = fromFlag $ copyDest flags
 	verbosity = fromFlag $ copyVerbosity flags
 
-installGitAnnexShell :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-installGitAnnexShell copyDest verbosity pkg lbi =
+installGitAnnexLinks :: CopyDest -> Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
+installGitAnnexLinks copyDest verbosity pkg lbi = do
 	rawSystemExit verbosity "ln"
 		["-sf", "git-annex", dstBinDir </> "git-annex-shell"]
+	rawSystemExit verbosity "ln"
+		["-sf", "git-annex", dstBinDir </> "git-remote-tor-annex"]
   where
 	dstBinDir = bindir $ absoluteInstallDirs pkg lbi copyDest
 
diff --git a/Types/Creds.hs b/Types/Creds.hs
index ad1827bc9..6a9e1287f 100644
--- a/Types/Creds.hs
+++ b/Types/Creds.hs
@@ -11,4 +11,4 @@ type Creds = String -- can be any data that contains credentials
 
 type CredPair = (Login, Password)
 type Login = String
-type Password = String -- todo: use securemem
+type Password = String
diff --git a/Utility/Tor.hs b/Utility/Tor.hs
index b673c7105..eedee8c6b 100644
--- a/Utility/Tor.hs
+++ b/Utility/Tor.hs
@@ -11,32 +11,53 @@ import Common
 import Utility.ThreadScheduler
 import System.PosixCompat.Types
 import Data.Char
+import Network.Socket
+import Network.Socks5
+import qualified Data.ByteString.UTF8 as BU8
+import qualified System.Random as R
 
 type OnionPort = Int
-type OnionAddress = String
+newtype OnionAddress = OnionAddress String
 type OnionSocket = FilePath
 type UniqueIdent = String
 
+connectHiddenService :: OnionAddress -> OnionPort -> IO Socket
+connectHiddenService (OnionAddress address) port = do
+        soc <- socket AF_UNIX Stream defaultProtocol
+	connect soc (SockAddrUnix "/run/user/1000/1ecd1f64-3234-47ec-876c-47c4bd7f7407.sock")
+	return soc
+
+connectHiddenService' :: OnionAddress -> OnionPort -> IO Socket
+connectHiddenService' (OnionAddress address) port = do
+	(s, _) <- socksConnect torsockconf socksaddr
+	return s
+  where
+	torsocksport = 9050
+	torsockconf = defaultSocksConf "127.0.0.1" torsocksport
+	socksdomain = SocksAddrDomainName (BU8.fromString address)
+	socksaddr = SocksAddress socksdomain (fromIntegral port)
+
 -- | Adds a hidden service connecting to localhost, using some kind
 -- of unique identifier.
 --
 -- This will only work if run as root, and tor has to already be running.
 --
--- Picks a port number for the hidden service that is not used by any
--- other hidden service (and is >= 1024). Returns the hidden service's
+-- Picks a random high port number for the hidden service that is not
+-- used by any other hidden service. Returns the hidden service's
 -- onion address, port, and the unix socket file to use.
 -- 
 -- If there is already a hidden service for the specified unique
 -- identifier, returns its information without making any changes.
-addHiddenService :: UserID -> UniqueIdent -> IO (OnionAddress, OnionPort, OnionSocket)
+addHiddenService :: UserID -> UniqueIdent -> IO (OnionAddress, OnionPort)
 addHiddenService uid ident = do
 	ls <- lines <$> readFile torrc
 	let portssocks = mapMaybe (parseportsock . separate isSpace) ls
 	case filter (\(_, s) -> s == sockfile) portssocks of
 		((p, _s):_) -> waithiddenservice 1 p
 		_ -> do
+			highports <- R.getStdRandom highports
 			let newport = Prelude.head $
-				filter (`notElem` map fst portssocks) [1024..]
+				filter (`notElem` map fst portssocks) highports
 			writeFile torrc $ unlines $
 				ls ++
 				[ ""
@@ -61,13 +82,18 @@ addHiddenService uid ident = do
 	
 	sockfile = socketFile uid ident
 
-	waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort, OnionSocket)
+	-- An infinite random list of high ports.
+	highports g = 
+		let (g1, g2) = R.split g
+		in (R.randomRs (1025, 65534) g1, g2)
+
+	waithiddenservice :: Int -> OnionPort -> IO (OnionAddress, OnionPort)
 	waithiddenservice 0 _ = error "tor failed to create hidden service, perhaps the tor service is not running"
 	waithiddenservice n p = do
 		v <- tryIO $ readFile $ hiddenServiceHostnameFile uid ident
 		case v of
 			Right s | ".onion\n" `isSuffixOf` s -> 
-				return (takeWhile (/= '\n') s, p, sockfile)
+				return (OnionAddress (takeWhile (/= '\n') s), p)
 			_ -> do
 				threadDelaySeconds (Seconds 1)
 				waithiddenservice (n-1) p
diff --git a/debian/control b/debian/control
index 07630dfa2..3196d8fcd 100644
--- a/debian/control
+++ b/debian/control
@@ -77,6 +77,7 @@ Build-Depends:
 	libghc-disk-free-space-dev,
 	libghc-mountpoints-dev,
 	libghc-magic-dev,
+	libghc-socks-dev,
 	lsof [linux-any],
 	ikiwiki,
 	libimage-magick-perl,
diff --git a/doc/git-annex-enable-tor.mdwn b/doc/git-annex-enable-tor.mdwn
index 5355eef8b..ceaa4b121 100644
--- a/doc/git-annex-enable-tor.mdwn
+++ b/doc/git-annex-enable-tor.mdwn
@@ -10,7 +10,7 @@ git annex enable-tor userid uuid
 
 This plumbing-level command enables a tor hidden service for git-annex,
 using the specified repository uuid and userid. 
-It outputs to stdout a line of the form "address.onion:onionport socketfile"
+It outputs the address of the hidden service to stdout.
 
 This command has to be run by root, since it modifies `/etc/tor/torrc`.
 
diff --git a/doc/git-remote-tor-annex.mdwn b/doc/git-remote-tor-annex.mdwn
new file mode 100644
index 000000000..63b459ed8
--- /dev/null
+++ b/doc/git-remote-tor-annex.mdwn
@@ -0,0 +1,36 @@
+# NAME
+
+git-remote-tor-annex - remote helper program to talk to git-annex over tor
+
+# SYNOPSIS
+
+git fetch tor-annex::address.onion:port
+
+git remote add tor tor-annex::address.onion:port
+
+# DESCRIPTION
+
+This is a git remote helper program that allows git to pull and push
+over tor(1), communicating with a tor hidden service.
+
+The tor hidden service probably requires an authtoken to use it.
+The authtoken can be provided in the environment variable
+`GIT_ANNEX_TOR_AUTHTOKEN`. Or, if there is a file in 
+`.git/annex/creds/` matching the onion address of the hidden
+service, its first line is used as the authtoken.
+
+# SEE ALSO
+
+git-remote-helpers(1)
+
+[[git-annex]](1)
+
+[[git-annex-enable-tor]](1)
+
+[[git-annex-remotedaemon]](1)
+
+# AUTHOR
+
+Joey Hess <id@joeyh.name>
+
+Warning: Automatically converted into a man page by mdwn2man. Edit with care.
diff --git a/git-annex.cabal b/git-annex.cabal
index 7a0e34b3a..751bd4bd4 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -59,6 +59,7 @@ Extra-Source-Files:
   doc/git-annex-dropunused.mdwn
   doc/git-annex-edit.mdwn
   doc/git-annex-enableremote.mdwn
+  doc/git-annex-enable-tor.mdwn
   doc/git-annex-examinekey.mdwn
   doc/git-annex-expire.mdwn
   doc/git-annex-find.mdwn
@@ -136,6 +137,7 @@ Extra-Source-Files:
   doc/git-annex-webapp.mdwn
   doc/git-annex-whereis.mdwn
   doc/git-annex-xmppgit.mdwn
+  doc/git-remote-tor-annex.mdwn
   doc/logo.svg
   doc/logo_16x16.png
   Build/mdwn2man
@@ -365,7 +367,8 @@ Executable git-annex
    aeson,
    unordered-containers,
    feed,
-   regex-tdfa
+   regex-tdfa,
+   socks
   CC-Options: -Wall
   GHC-Options: -Wall -fno-warn-tabs
   Extensions: PackageImports
@@ -700,6 +703,7 @@ Executable git-annex
     CmdLine.GitAnnexShell.Fields
     CmdLine.GlobalSetter
     CmdLine.Option
+    CmdLine.GitRemoteTorAnnex
     CmdLine.Seek
     CmdLine.Usage
     Command
@@ -924,6 +928,7 @@ Executable git-annex
     Remote.Helper.ReadOnly
     Remote.Helper.Special
     Remote.Helper.Ssh
+    Remote.Helper.Tor
     Remote.Hook
     Remote.List
     Remote.Rsync
diff --git a/git-annex.hs b/git-annex.hs
index ca8eecd2a..d5fab7f47 100644
--- a/git-annex.hs
+++ b/git-annex.hs
@@ -1,6 +1,6 @@
 {- git-annex main program dispatch
  -
- - Copyright 2010-2014 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,6 +13,7 @@ import Network.Socket (withSocketsDo)
 
 import qualified CmdLine.GitAnnex
 import qualified CmdLine.GitAnnexShell
+import qualified CmdLine.GitRemoteTorAnnex
 import qualified Test
 
 #ifdef mingw32_HOST_OS
@@ -23,20 +24,15 @@ import Utility.Env
 main :: IO ()
 main = withSocketsDo $ do
 	ps <- getArgs
-	run ps =<< getProgName
-  where
-	run ps n
-		| isshell n = CmdLine.GitAnnexShell.run ps
-		| otherwise =
 #ifdef mingw32_HOST_OS
-			do
-				winEnv
-				gitannex ps
-#else
-			gitannex ps
+	winEnv
 #endif
-	gitannex = CmdLine.GitAnnex.run Test.optParser Test.runner
-	isshell n = takeFileName n == "git-annex-shell"
+	run ps =<< getProgName
+  where
+	run ps n = case takeFileName n of
+		"git-annex-shell" -> CmdLine.GitAnnexShell.run ps
+		"git-remote-tor-annex" -> CmdLine.GitRemoteTorAnnex.run ps
+		_  -> CmdLine.GitAnnex.run Test.optParser Test.runner ps
 
 #ifdef mingw32_HOST_OS
 {- On Windows, if HOME is not set, probe it and set it.
-- 
cgit v1.2.3


From 8cbab786bb7592fda2253b1c0d71c9c025e9984b Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 30 Nov 2016 12:50:49 -0400
Subject: prefer xdot over dot

* map: Run xdot if it's available in PATH. On OSX, the dot command
  does not support graphical display, while xdot does.
* Debian: xdot is a better interactive viewer than dot, so Suggest
  xdot, rather than graphviz.
---
 CHANGELOG              |  4 ++++
 Command/Map.hs         | 24 +++++++++++++++++-------
 debian/control         |  2 +-
 doc/git-annex-map.mdwn |  6 +++---
 4 files changed, 25 insertions(+), 11 deletions(-)

(limited to 'debian/control')

diff --git a/CHANGELOG b/CHANGELOG
index 1e108d4a0..76da79eaa 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -4,6 +4,10 @@ git-annex (6.20161119) UNRELEASED; urgency=medium
     largerthan, mimetype, and smallerthan; the first two always failed
     to match, and the latter always matched.
   * Relicense 5 source files that are not part of the webapp from AGPL to GPL.
+  * map: Run xdot if it's available in PATH. On OSX, the dot command
+    does not support graphical display, while xdot does.
+  * Debian: xdot is a better interactive viewer than dot, so Suggest
+    xdot, rather than graphviz.
 
  -- Joey Hess <id@joeyh.name>  Mon, 21 Nov 2016 11:27:50 -0400
 
diff --git a/Command/Map.hs b/Command/Map.hs
index 2b21c40ba..43c00d257 100644
--- a/Command/Map.hs
+++ b/Command/Map.hs
@@ -47,15 +47,25 @@ start = do
 	liftIO $ writeFile file (drawMap rs trustmap umap)
 	next $ next $
 		ifM (Annex.getState Annex.fast)
-			( do
-				showLongNote $ "left map in " ++ file
-				return True
-			, do
-				showLongNote $ "running: dot -Tx11 " ++ file
-				showOutput
-				liftIO $ boolSystem "dot" [Param "-Tx11", File file]
+			( runViewer file []
+			, runViewer file
+	 			[ ("xdot", [File file])
+				, ("dot", [Param "-Tx11", File file])
+				]	
 			)
 
+runViewer :: FilePath -> [(String, [CommandParam])] -> Annex Bool
+runViewer file [] = do
+	showLongNote $ "left map in " ++ file
+	return True
+runViewer file ((c, ps):rest) = ifM (liftIO $ inPath c)
+	( do
+		showLongNote $ "running: " ++ c ++ unwords (toCommand ps)
+		showOutput
+		liftIO $ boolSystem c ps
+	, runViewer file rest
+	)
+
 {- Generates a graph for dot(1). Each repository, and any other uuids
  - (except for dead ones), are displayed as a node, and each of its
  - remotes is represented as an edge pointing at the node for the remote.
diff --git a/debian/control b/debian/control
index ec77a2946..a07797462 100644
--- a/debian/control
+++ b/debian/control
@@ -110,7 +110,7 @@ Recommends:
 	nocache,
 	aria2,
 Suggests:
-	graphviz,
+	xdot,
 	bup,
 	tahoe-lafs,
 	libnss-mdns,
diff --git a/doc/git-annex-map.mdwn b/doc/git-annex-map.mdwn
index cf28a958e..ece26b367 100644
--- a/doc/git-annex-map.mdwn
+++ b/doc/git-annex-map.mdwn
@@ -10,8 +10,8 @@ git annex map
 
 Helps you keep track of your repositories, and the connections between them,
 by going out and looking at all the ones it can get to, and generating a
-Graphviz file displaying it all. If the `dot` command is available, it is
-used to display the file to your screen (using x11 backend).
+Graphviz file displaying it all. If the `xdot` or `dot` command is available,
+it is used to display the file to your screen.
   
 This command only connects to hosts that the host it's run on can
 directly connect to. It does not try to tunnel through intermediate hosts.
@@ -37,7 +37,7 @@ on that host.
 
 * `--fast`
 
-  Disable using `dot` to display the generated Graphviz file.
+  Don't display the generated Graphviz file, but save it for later use.
 
 # SEE ALSO
 
-- 
cgit v1.2.3


From b3b800bb6140543306ec65751506ae2862ca345f Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 9 Dec 2016 14:52:38 -0400
Subject: refactor ref change watching

Added to change notification to P2P protocol.

Switched to a TBChan so that a single long-running thread can be
started, and serve perhaps intermittent requests for change
notifications, without buffering all changes in memory.

The P2P runner currently starts up a new thread each times it waits
for a change, but that should allow later reusing a thread. Although
each connection from a peer will still need a new watcher thread to run.

The dependency on stm-chans is more or less free; some stuff in yesod
uses it, so it was already indirectly pulled in when building with the
webapp.

This commit was sponsored by Francois Marier on Patreon.
---
 Annex/ChangedRefs.hs                | 105 ++++++++++++++++++++++++++++++++++++
 Command/NotifyChanges.hs            |  48 +++--------------
 P2P/Annex.hs                        |   9 ++++
 P2P/Protocol.hs                     |  13 +++++
 RemoteDaemon/Transport/Ssh.hs       |   3 +-
 RemoteDaemon/Transport/Ssh/Types.hs |   4 +-
 RemoteDaemon/Types.hs               |  10 +---
 debian/control                      |   1 +
 git-annex.cabal                     |   2 +
 9 files changed, 142 insertions(+), 53 deletions(-)
 create mode 100644 Annex/ChangedRefs.hs

(limited to 'debian/control')

diff --git a/Annex/ChangedRefs.hs b/Annex/ChangedRefs.hs
new file mode 100644
index 000000000..0dc82d3b3
--- /dev/null
+++ b/Annex/ChangedRefs.hs
@@ -0,0 +1,105 @@
+{- Waiting for changed git refs
+ -
+ - Copyright 2014-216 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.ChangedRefs
+	( ChangedRefs(..)
+	, ChangedRefsHandle
+	, waitChangedRefs
+	, drainChangedRefs
+	, stopWatchingChangedRefs
+	, watchChangedRefs
+	) where
+
+import Annex.Common
+import Utility.DirWatcher
+import Utility.DirWatcher.Types
+import qualified Git
+import Git.Sha
+import qualified Utility.SimpleProtocol as Proto
+
+import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TBMChan
+
+newtype ChangedRefs = ChangedRefs [Git.Ref]
+	deriving (Show)
+
+instance Proto.Serializable ChangedRefs where
+	serialize (ChangedRefs l) = unwords $ map Git.fromRef l
+	deserialize = Just . ChangedRefs . map Git.Ref . words
+
+data ChangedRefsHandle = ChangedRefsHandle DirWatcherHandle (TBMChan Git.Sha)
+
+-- | Wait for one or more git refs to change.
+--
+-- When possible, coalesce ref writes that occur closely together
+-- in time. Delay up to 0.05 seconds to get more ref writes.
+waitChangedRefs :: ChangedRefsHandle -> IO ChangedRefs
+waitChangedRefs (ChangedRefsHandle _ chan) = do
+	v <- atomically $ readTBMChan chan
+	case v of
+		Nothing -> return $ ChangedRefs []
+		Just r -> do
+			threadDelay 50000
+			rs <- atomically $ loop []
+			return $ ChangedRefs (r:rs)
+  where
+	loop rs = do
+		v <- tryReadTBMChan chan
+		case v of
+			Just (Just r) -> loop (r:rs)
+			_ -> return rs
+
+-- | Remove any changes that might be buffered in the channel,
+-- without waiting for any new changes.
+drainChangedRefs :: ChangedRefsHandle -> IO ()
+drainChangedRefs (ChangedRefsHandle _ chan) = atomically go
+  where
+	go = do
+		v <- tryReadTBMChan chan
+		case v of
+			Just (Just _) -> go
+			_ -> return ()
+
+stopWatchingChangedRefs :: ChangedRefsHandle -> IO ()
+stopWatchingChangedRefs h@(ChangedRefsHandle wh chan) = do
+	stopWatchDir wh
+	atomically $ closeTBMChan chan
+	drainChangedRefs h
+
+watchChangedRefs :: Annex ChangedRefsHandle
+watchChangedRefs = do
+	-- This channel is used to accumulate notifications,
+	-- because the DirWatcher might have multiple threads that find
+	-- changes at the same time. It is bounded to allow a watcher
+	-- to be started once and reused, without too many changes being
+	-- buffered in memory.
+	chan <- liftIO $ newTBMChanIO 100
+	
+	g <- gitRepo
+	let refdir = Git.localGitDir g </> "refs"
+	liftIO $ createDirectoryIfMissing True refdir
+
+	let notifyhook = Just $ notifyHook chan
+	let hooks = mkWatchHooks
+		{ addHook = notifyhook
+		, modifyHook = notifyhook
+		}
+
+	h <- liftIO $ watchDir refdir (const False) True hooks id
+	return $ ChangedRefsHandle h chan
+
+notifyHook :: TBMChan Git.Sha -> FilePath -> Maybe FileStatus -> IO ()
+notifyHook chan reffile _
+	| ".lock" `isSuffixOf` reffile = noop
+	| otherwise = void $ do
+		sha <- catchDefaultIO Nothing $
+			extractSha <$> readFile reffile
+		-- When the channel is full, there is probably no reader
+		-- running, or ref changes have been occuring very fast,
+		-- so it's ok to not write the change to it.
+		maybe noop (void . atomically . tryWriteTBMChan chan) sha
diff --git a/Command/NotifyChanges.hs b/Command/NotifyChanges.hs
index bb9b10eee..83d7bca3f 100644
--- a/Command/NotifyChanges.hs
+++ b/Command/NotifyChanges.hs
@@ -8,6 +8,7 @@
 module Command.NotifyChanges where
 
 import Command
+import Annex.ChangedRefs
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
 import qualified Git
@@ -30,55 +31,18 @@ seek = withNothing start
 
 start :: CommandStart
 start = do
-	-- This channel is used to accumulate notifcations,
-	-- because the DirWatcher might have multiple threads that find
-	-- changes at the same time.
-	chan <- liftIO newTChanIO
-	
-	g <- gitRepo
-	let refdir = Git.localGitDir g </> "refs"
-	liftIO $ createDirectoryIfMissing True refdir
+	h <- watchChangedRefs
 
-	let notifyhook = Just $ notifyHook chan
-	let hooks = mkWatchHooks
-		{ addHook = notifyhook
-		, modifyHook = notifyhook
-		}
-
-	void $ liftIO $ watchDir refdir (const False) True hooks id
-
-	let sender = do
-		send READY
-		forever $ send . CHANGED =<< drain chan
-	
 	-- No messages need to be received from the caller,
 	-- but when it closes the connection, notice and terminate.
 	let receiver = forever $ void $ getProtocolLine stdin
+	let sender = forever $ send . CHANGED =<< waitChangedRefs h
+
+	liftIO $ send READY
 	void $ liftIO $ concurrently sender receiver
+	liftIO $ stopWatchingChangedRefs h
 	stop
 
-notifyHook :: TChan Git.Sha -> FilePath -> Maybe FileStatus -> IO ()
-notifyHook chan reffile _
-	| ".lock" `isSuffixOf` reffile = noop
-	| otherwise = void $ do
-		sha <- catchDefaultIO Nothing $
-			extractSha <$> readFile reffile
-		maybe noop (atomically . writeTChan chan) sha
-
--- When possible, coalesce ref writes that occur closely together
--- in time. Delay up to 0.05 seconds to get more ref writes.
-drain :: TChan Git.Sha -> IO [Git.Sha]
-drain chan = do
-	r <- atomically $ readTChan chan
-	threadDelay 50000
-	rs <- atomically $ drain' chan
-	return (r:rs)
-
-drain' :: TChan Git.Sha -> STM [Git.Sha]
-drain' chan = loop []
-  where
-	loop rs = maybe (return rs) (\r -> loop (r:rs)) =<< tryReadTChan chan
-
 send :: Notification -> IO ()
 send n = do
 	putStrLn $ unwords $ formatMessage n
diff --git a/P2P/Annex.hs b/P2P/Annex.hs
index d24e65b0f..e9b59652c 100644
--- a/P2P/Annex.hs
+++ b/P2P/Annex.hs
@@ -16,6 +16,7 @@ module P2P.Annex
 import Annex.Common
 import Annex.Content
 import Annex.Transfer
+import Annex.ChangedRefs
 import P2P.Protocol
 import P2P.IO
 import Logs.Location
@@ -114,6 +115,14 @@ runLocal runmode runner a = case a of
 				protoaction False
 				next
 			Right _ -> runner next
+	WaitRefChange next -> do
+		v <- tryNonAsync $ bracket
+			watchChangedRefs
+			(liftIO . stopWatchingChangedRefs)
+			(liftIO . waitChangedRefs)
+		case v of
+			Left e -> return (Left (show e))
+			Right changedrefs -> runner (next changedrefs)
   where
 	transfer mk k af ta = case runmode of
 		-- Update transfer logs when serving.
diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs
index 03c7c70cf..d8be3ff42 100644
--- a/P2P/Protocol.hs
+++ b/P2P/Protocol.hs
@@ -19,6 +19,7 @@ import Utility.Applicative
 import Utility.PartialPrelude
 import Utility.Metered
 import Git.FilePath
+import Annex.ChangedRefs (ChangedRefs)
 
 import Control.Monad
 import Control.Monad.Free
@@ -50,6 +51,8 @@ data Message
 	| AUTH_FAILURE
 	| CONNECT Service
 	| CONNECTDONE ExitCode
+	| NOTIFYCHANGE
+	| CHANGED ChangedRefs
 	| CHECKPRESENT Key
 	| LOCKCONTENT Key
 	| UNLOCKCONTENT
@@ -70,6 +73,8 @@ instance Proto.Sendable Message where
 	formatMessage AUTH_FAILURE = ["AUTH-FAILURE"]
 	formatMessage (CONNECT service) = ["CONNECT", Proto.serialize service]
 	formatMessage (CONNECTDONE exitcode) = ["CONNECTDONE", Proto.serialize exitcode]
+	formatMessage NOTIFYCHANGE = ["NOTIFYCHANGE"]
+	formatMessage (CHANGED refs) = ["CHANGED", Proto.serialize refs]
 	formatMessage (CHECKPRESENT key) = ["CHECKPRESENT", Proto.serialize key]
 	formatMessage (LOCKCONTENT key) = ["LOCKCONTENT", Proto.serialize key]
 	formatMessage UNLOCKCONTENT = ["UNLOCKCONTENT"]
@@ -89,6 +94,8 @@ instance Proto.Receivable Message where
 	parseCommand "AUTH-FAILURE" = Proto.parse0 AUTH_FAILURE
 	parseCommand "CONNECT" = Proto.parse1 CONNECT
 	parseCommand "CONNECTDONE" = Proto.parse1 CONNECTDONE
+	parseCommand "NOTIFYCHANGE" = Proto.parse0 NOTIFYCHANGE
+	parseCommand "CHANGED" = Proto.parse1 CHANGED
 	parseCommand "CHECKPRESENT" = Proto.parse1 CHECKPRESENT
 	parseCommand "LOCKCONTENT" = Proto.parse1 LOCKCONTENT
 	parseCommand "UNLOCKCONTENT" = Proto.parse0 UNLOCKCONTENT
@@ -227,6 +234,8 @@ data LocalF c
 	-- from being deleted, while running the provided protocol
 	-- action. If unable to lock the content, runs the protocol action
 	-- with False.
+	| WaitRefChange (ChangedRefs -> c)
+	-- ^ Waits for one or more git refs to change and returns them.
 	deriving (Functor)
 
 type Local = Free LocalF
@@ -379,6 +388,10 @@ serveAuthed myuuid = void $ serverLoop handler
 	handler (CONNECT service) = do
 		net $ relayService service
 		return ServerContinue
+	handler NOTIFYCHANGE = do
+		refs <- local waitRefChange
+		net $ sendMessage (CHANGED refs)
+		return ServerContinue
 	handler _ = return ServerUnexpected
 
 sendContent :: Key -> AssociatedFile -> Offset -> MeterUpdate -> Proto Bool
diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs
index 205165062..59502f8d3 100644
--- a/RemoteDaemon/Transport/Ssh.hs
+++ b/RemoteDaemon/Transport/Ssh.hs
@@ -17,6 +17,7 @@ import Utility.SimpleProtocol
 import qualified Git
 import Git.Command
 import Utility.ThreadScheduler
+import Annex.ChangedRefs
 
 import Control.Concurrent.STM
 import Control.Concurrent.Async
@@ -73,7 +74,7 @@ transportUsingCmd' cmd params (RemoteRepo r _) url transporthandle ichan ochan =
 			Just SshRemote.READY -> do
 				send (CONNECTED url)
 				handlestdout fromh
-			Just (SshRemote.CHANGED shas) -> do
+			Just (SshRemote.CHANGED (ChangedRefs shas)) -> do
 				whenM (checkNewShas transporthandle shas) $
 					fetch
 				handlestdout fromh
diff --git a/RemoteDaemon/Transport/Ssh/Types.hs b/RemoteDaemon/Transport/Ssh/Types.hs
index fa6a55d3d..606e1a563 100644
--- a/RemoteDaemon/Transport/Ssh/Types.hs
+++ b/RemoteDaemon/Transport/Ssh/Types.hs
@@ -16,11 +16,11 @@ module RemoteDaemon.Transport.Ssh.Types (
 ) where
 
 import qualified Utility.SimpleProtocol as Proto
-import RemoteDaemon.Types (RefList)
+import Annex.ChangedRefs (ChangedRefs)
 
 data Notification
 	= READY
-	| CHANGED RefList
+	| CHANGED ChangedRefs
 
 instance Proto.Sendable Notification where
 	formatMessage READY = ["READY"]
diff --git a/RemoteDaemon/Types.hs b/RemoteDaemon/Types.hs
index ba88aa685..c0d74e038 100644
--- a/RemoteDaemon/Types.hs
+++ b/RemoteDaemon/Types.hs
@@ -5,7 +5,6 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module RemoteDaemon.Types where
@@ -15,6 +14,7 @@ import qualified Annex
 import qualified Git.Types as Git
 import qualified Utility.SimpleProtocol as Proto
 import Types.GitConfig
+import Annex.ChangedRefs (ChangedRefs)
 
 import Network.URI
 import Control.Concurrent
@@ -52,13 +52,11 @@ data Consumed
 	= PAUSE
 	| LOSTNET
 	| RESUME
-	| CHANGED RefList
+	| CHANGED ChangedRefs
 	| RELOAD
 	| STOP
 	deriving (Show)
 
-type RefList = [Git.Ref]
-
 instance Proto.Sendable Emitted where
 	formatMessage (CONNECTED remote) =
 		["CONNECTED", Proto.serialize remote]
@@ -100,10 +98,6 @@ instance Proto.Serializable RemoteURI where
 	serialize (RemoteURI u) = show u
 	deserialize = RemoteURI <$$> parseURI
 
-instance Proto.Serializable RefList where
-	serialize = unwords . map Git.fromRef
-	deserialize = Just . map Git.Ref . words
-
 instance Proto.Serializable Bool where
 	serialize False = "0"
 	serialize True = "1"
diff --git a/debian/control b/debian/control
index 1d2313954..f5a9de840 100644
--- a/debian/control
+++ b/debian/control
@@ -50,6 +50,7 @@ Build-Depends:
 	libghc-esqueleto-dev,
 	libghc-securemem-dev,
 	libghc-byteable-dev,
+	libghc-stm-chans-dev,
 	libghc-dns-dev,
 	libghc-case-insensitive-dev,
 	libghc-http-types-dev,
diff --git a/git-annex.cabal b/git-annex.cabal
index 465769ea0..ec54a146d 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -371,6 +371,7 @@ Executable git-annex
    regex-tdfa,
    socks,
    byteable,
+   stm-chans,
    securemem
   CC-Options: -Wall
   GHC-Options: -Wall -fno-warn-tabs
@@ -513,6 +514,7 @@ Executable git-annex
     Annex.Branch.Transitions
     Annex.BranchState
     Annex.CatFile
+    Annex.ChangedRefs
     Annex.CheckAttr
     Annex.CheckIgnore
     Annex.Common
-- 
cgit v1.2.3


From 824be5bfb8870052e5726238169f738441426da1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 10 Dec 2016 11:04:11 -0400
Subject: fix typo

---
 debian/control | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

(limited to 'debian/control')

diff --git a/debian/control b/debian/control
index f5a9de840..58af2306c 100644
--- a/debian/control
+++ b/debian/control
@@ -65,7 +65,7 @@ Build-Depends:
 	libghc-xml-types-dev,
 	libghc-async-dev,
 	libghc-monad-logger-dev,
-	ligghc-free-dev,
+	libghc-free-dev,
 	libghc-feed-dev (>= 0.3.9.2),
 	libghc-regex-tdfa-dev,
 	libghc-tasty-dev (>= 0.7),
-- 
cgit v1.2.3


From 8dc9dd1c4c2f70b6477b945f93ceefee092b5676 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 11 Dec 2016 21:30:07 -0400
Subject: Debian: Build webapp on armel.

---
 CHANGELOG      |  6 ++++++
 debian/control | 22 +++++++++++-----------
 2 files changed, 17 insertions(+), 11 deletions(-)

(limited to 'debian/control')

diff --git a/CHANGELOG b/CHANGELOG
index 21cd780a2..697814280 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,3 +1,9 @@
+git-annex (6.20161211) UNRELEASED; urgency=medium
+
+  * Debian: Build webapp on armel.
+
+ -- Joey Hess <id@joeyh.name>  Sun, 11 Dec 2016 21:29:51 -0400
+
 git-annex (6.20161210) unstable; urgency=medium
 
   * Linux standalone: Updated ghc to fix its "unable to decommit memory"
diff --git a/debian/control b/debian/control
index 58af2306c..8be9fec99 100644
--- a/debian/control
+++ b/debian/control
@@ -32,17 +32,17 @@ Build-Depends:
 	libghc-stm-dev (>= 2.3),
 	libghc-dbus-dev (>= 0.10.7) [linux-any],
 	libghc-fdo-notify-dev (>= 0.3) [linux-any],
-	libghc-yesod-dev (>= 1.2.6.1)       [i386 amd64 arm64 armhf kfreebsd-amd64 kfreebsd-i386 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-yesod-core-dev (>= 1.2.19)   [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-yesod-form-dev (>= 1.3.15)   [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-yesod-static-dev (>= 1.2.4)  [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-yesod-default-dev (>= 1.2.0) [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-shakespeare-dev (>= 2.0.0)   [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-clientsession-dev            [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-warp-dev (>= 3.0.0.5)        [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-warp-tls-dev                 [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-wai-dev                      [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
-	libghc-wai-extra-dev                [i386 amd64 arm64 armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-yesod-dev (>= 1.2.6.1)       [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-yesod-core-dev (>= 1.2.19)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-yesod-form-dev (>= 1.3.15)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-yesod-static-dev (>= 1.2.4)  [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-yesod-default-dev (>= 1.2.0) [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-shakespeare-dev (>= 2.0.0)   [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-clientsession-dev            [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-warp-dev (>= 3.0.0.5)        [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-warp-tls-dev                 [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-wai-dev                      [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
+	libghc-wai-extra-dev                [i386 amd64 arm64 armel armhf kfreebsd-i386 kfreebsd-amd64 mips mips64el mipsel powerpc ppc64el s390x],
 	libghc-dav-dev (>= 1.0),
 	libghc-persistent-dev,
 	libghc-persistent-template-dev,
-- 
cgit v1.2.3


From 09e3fc83f8e9a006cea239fabcff81692e938ddc Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sun, 18 Dec 2016 16:50:58 -0400
Subject: 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.
---
 CHANGELOG                                   |   5 +-
 Command/P2P.hs                              | 221 ++++++++++++++++++++++++----
 Utility/MagicWormhole.hs                    |  13 +-
 debian/control                              |   1 +
 doc/git-annex-p2p.mdwn                      |  26 +++-
 doc/tips/peer_to_peer_network_with_tor.mdwn |  95 ++++++------
 doc/todo/tor.mdwn                           |   4 +-
 git-annex.cabal                             |   2 +-
 8 files changed, 288 insertions(+), 79 deletions(-)

(limited to 'debian/control')

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
-- 
cgit v1.2.3


From 6daf4d9147e197ea13780ad421046d580af22aaf Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Tue, 20 Dec 2016 15:26:14 -0400
Subject: Debian: Suggest tor and magic-wormhole.

Suggests, not recommends, because tor is not for everyone.
---
 CHANGELOG      | 4 ++--
 debian/control | 3 ++-
 2 files changed, 4 insertions(+), 3 deletions(-)

(limited to 'debian/control')

diff --git a/CHANGELOG b/CHANGELOG
index 04b0bd96a..9d9faf1e4 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -2,7 +2,6 @@ git-annex (6.20161211) UNRELEASED; urgency=medium
 
   * 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
@@ -16,12 +15,13 @@ 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.
   * Linux standalone: Improve generation of locale definition files,
     supporting locales such as, en_GB.UTF-8.
   * rekey --force: Incorrectly marked the new key's content as being
     present in the local repo even when it was not.
   * Fix build with directory-1.3.
+  * Debian: Suggest tor and magic-wormhole.
+  * Debian: Build webapp on armel.
 
  -- Joey Hess <id@joeyh.name>  Sun, 11 Dec 2016 21:29:51 -0400
 
diff --git a/debian/control b/debian/control
index 644c22035..b64f3e3be 100644
--- a/debian/control
+++ b/debian/control
@@ -112,10 +112,11 @@ Recommends:
 	git-remote-gcrypt (>= 0.20130908-6),
 	nocache,
 	aria2,
-	magic-wormhole,
 Suggests:
 	xdot,
 	bup,
+	tor,
+	magic-wormhole,
 	tahoe-lafs,
 	libnss-mdns,
 Description: manage files with git, without checking their contents into git
-- 
cgit v1.2.3