enable-tor: When run as a regular user, test a connection back to the hidden service over tor.

This way we know that after enable-tor, the tor hidden service is fully
published and working, and so there should be no problems with it at
pairing time.

It has to start up its own temporary listener on the hidden service. It
would be nice to have it start the remotedaemon running, so that extra
step is not needed afterwards. But, there may already be a remotedaemon
running, in communication with the assistant and we don't want to start
another one. I thought about trying to HUP any running remotedaemon, but
Windows does not make it easy to do that. In any case, having the user
start the remotedaemon themselves lets them know it needs to be running
to serve the hidden service.

This commit was sponsored by Boyd Stephen Smith Jr. on Patreon.

CHANGELOG

@@ -22,6 +22,8 @@ git-annex (6.20161211) UNRELEASED; urgency=medium
   * enable-tor: Put tor sockets in /var/lib/tor-annex/, rather
     than in /etc/tor/hidden_service/.
   * enable-tor: No longer needs to be run as root.
+  * enable-tor: When run as a regular user, test a connection back to 
+    the hidden service over tor.
   * Fix build with directory-1.3.
   * Debian: Suggest tor and magic-wormhole.
   * Debian: Build webapp on armel.

Command/EnableTor.hs

@@ -10,18 +10,22 @@
 module Command.EnableTor where
 
 import Command
+import qualified Annex
 import P2P.Address
 import Utility.Tor
 import Annex.UUID
 import Config.Files
+import P2P.IO
+import qualified P2P.Protocol as P2P
+import Utility.ThreadScheduler
 
+import Control.Concurrent.Async
+import qualified Network.Socket as S
 #ifndef mingw32_HOST_OS
 import Utility.Su
 import System.Posix.User
 #endif
 
--- This runs as root, so avoid making any commits or initializing
--- git-annex, or doing other things that create root-owned files.
 cmd :: Command
 cmd = noCommit $ dontCheck repoExists $
 	command "enable-tor" SectionSetup "enable tor hidden service"
@@ -30,6 +34,8 @@ cmd = noCommit $ dontCheck repoExists $
 seek :: CmdParams -> CommandSeek
 seek = withWords start
 
+-- This runs as root, so avoid making any commits or initializing
+-- git-annex, or doing other things that create root-owned files.
 start :: [String] -> CommandStart
 start os = do
 	uuid <- getUUID
@@ -42,11 +48,12 @@ start os = do
 			Nothing -> giveup "Need user-id parameter."
 			Just userid -> go uuid userid
 		else do
-			liftIO $ putStrLn "Need root access to enable tor..."
+			showStart "enable-tor" ""
+			showLongNote "Need root access to enable tor..."
 			gitannex <- liftIO readProgramFile
 			let ps = [Param (cmdname cmd), Param (show curruserid)]
 			ifM (liftIO $ runAsRoot gitannex ps)
-				( stop
+				( next $ next checkHiddenService
 				, giveup $ unwords $
 					[ "Failed to run as root:" , gitannex ] ++ toCommand ps
 				)
@@ -59,3 +66,65 @@ start os = do
 			addHiddenService torAppName userid (fromUUID uuid)
 		storeP2PAddress $ TorAnnex onionaddr onionport
 		stop
+
+checkHiddenService :: CommandCleanup
+checkHiddenService = bracket setup cleanup go
+  where
+	setup = do
+		showLongNote "Tor hidden service is configured. Checking connection to it. This may take a few minutes."
+		startlistener
+	
+	cleanup = liftIO . cancel
+	
+	go _ = check (150 :: Int) =<< filter istoraddr <$> loadP2PAddresses
+	
+	istoraddr (TorAnnex _ _) = True
+
+	check 0 _ = giveup "Still unable to connect to hidden service. It might not yet be usable by others. Please check Tor's logs for details."
+	check _ [] = giveup "Somehow didn't get an onion address."
+	check n addrs@(addr:_) = do
+		g <- Annex.gitRepo
+		-- Connect but don't bother trying to auth,
+		-- we just want to know if the tor circuit works.
+		cv <- liftIO $ tryNonAsync $ connectPeer g addr
+		case cv of
+			Left e -> do
+				warning $ "Unable to connect to hidden service. It may not yet have propigated to the Tor network. (" ++ show e ++ ") Will retry.."
+				liftIO $ threadDelaySeconds (Seconds 2)
+				check (n-1) addrs
+			Right conn -> do
+				liftIO $ closeConnection conn
+				showLongNote "Tor hidden service is working."
+				return True
+	
+	-- Unless the remotedaemon is already listening on the hidden
+	-- service's socket, start a listener. This is only run during the
+	-- check, and it refuses all auth attempts.
+	startlistener = do
+		r <- Annex.gitRepo
+		u <- getUUID
+		uid <- liftIO getRealUserID
+		let ident = fromUUID u
+		v <- liftIO $ getHiddenServiceSocketFile torAppName uid ident
+		case v of
+			Just sockfile -> ifM (liftIO $ haslistener sockfile)
+				( liftIO $ async $ return ()
+				, liftIO $ async $ runlistener sockfile u r
+				)
+			Nothing -> giveup "Could not find socket file in Tor configuration!"
+	
+	runlistener sockfile u r = serveUnixSocket sockfile $ \h -> do
+		let conn = P2PConnection
+			{ connRepo = r
+			, connCheckAuth = const False
+			, connIhdl = h
+			, connOhdl = h
+			}
+		void $ runNetProto conn $ P2P.serveAuth u
+		hClose h
+
+	haslistener sockfile = catchBoolIO $ do
+		soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
+		S.connect soc (S.SockAddrUnix sockfile)
+		S.close soc
+		return True

P2P/IO.hs

@@ -72,7 +72,7 @@ closeConnection conn = do
 -- closing the Handle when done.
 --
 -- Note that while the callback is running, other connections won't be
--- processes, so longterm work should be run in a separate thread by
+-- processed, so longterm work should be run in a separate thread by
 -- the callback.
 serveUnixSocket :: FilePath -> (Handle -> IO ()) -> IO ()
 serveUnixSocket unixsocket serveconn = do

doc/tips/peer_to_peer_network_with_tor.mdwn

@@ -26,7 +26,8 @@ In each git-annex repository, run these commands:
 	git annex enable-tor
 	git annex remotedaemon
 
-Now git-annex is running as a Tor hidden service, but 
+The enable-tor command may prompt for the root password, since it
+configures Tor. 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:

doc/todo/tor.mdwn

@@ -4,7 +4,6 @@ Mostly working!
 
 Current todo list:
 
-* Make enable-tor check connection back to itself to verify tor is working.
 * When a transfer can't be done because another transfer of the same 
   object is already in progress, the message about this is output by the
   remotedaemon --debug, but not forwarded to the peer, which shows