remotedaemon: serve tor hidden service

RemoteDaemon/Transport/Tor.hs

@@ -0,0 +1,51 @@
+{- git-remote-daemon, tor hidden service transport
+ -
+ - Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module RemoteDaemon.Transport.Tor (server) where
+
+import Common
+import RemoteDaemon.Types
+import RemoteDaemon.Common
+import Utility.Tor
+import Utility.FileMode
+import Remote.Helper.P2P
+import Remote.Helper.P2P.IO
+import Annex.UUID
+import Types.UUID
+
+import System.PosixCompat.User
+import Network.Socket
+import Control.Concurrent
+import System.Log.Logger (debugM)
+
+-- Run tor hidden service.
+server :: TransportHandle -> IO ()
+server th@(TransportHandle (LocalRepo r) _) = do
+	u <- liftAnnex th getUUID
+	uid <- getRealUserID
+	let ident = fromUUID u
+	let sock = socketFile uid ident
+	nukeFile sock
+	soc <- socket AF_UNIX Stream defaultProtocol
+	bind soc (SockAddrUnix sock)
+	-- Allow everyone to read and write to the socket; tor is probably
+	-- running as a different user. Connections have to authenticate
+	-- to do anything, so it's fine that other local users can connect.
+	modifyFileMode sock $ addModes
+		[groupReadMode, groupWriteMode, otherReadMode, otherWriteMode]
+	listen soc 2
+	debugM "remotedaemon" "tor hidden service running"
+	forever $ do
+		(conn, _) <- accept soc
+		forkIO $ do
+			debugM "remotedaemon" "handling a connection"
+			h <- socketToHandle conn ReadWriteMode
+			hSetBuffering h LineBuffering
+			hSetBinaryMode h False
+			runNetProtoHandle h r (serve u)
+			hClose h
+