remotedaemon: notice on RELOAD when tor hidden service has been enabled

and start serving it. This makes the webapp wormhole tor pairing work 100%!

This commit was sponsored by Andrea Rota.
This commit is contained in:
Joey Hess 2016-12-28 12:21:52 -04:00
parent 4d690dc680
commit 309742805f
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
4 changed files with 62 additions and 31 deletions

View file

@ -74,12 +74,13 @@ runController :: TChan Consumed -> TChan Emitted -> IO ()
runController ichan ochan = do runController ichan ochan = do
h <- genTransportHandle h <- genTransportHandle
m <- genRemoteMap h ochan m <- genRemoteMap h ochan
startrunning m starttransports m
mapM_ (\s -> async (s h)) remoteServers serverchans <- mapM (startserver h) remoteServers
go h False m go h False m serverchans
where where
go h paused m = do go h paused m serverchans = do
cmd <- atomically $ readTChan ichan cmd <- atomically $ readTChan ichan
broadcast cmd serverchans
case cmd of case cmd of
RELOAD -> do RELOAD -> do
h' <- updateTransportHandle h h' <- updateTransportHandle h
@ -87,36 +88,42 @@ runController ichan ochan = do
let common = M.intersection m m' let common = M.intersection m m'
let new = M.difference m' m let new = M.difference m' m
let old = M.difference m m' let old = M.difference m m'
broadcast STOP old broadcast STOP (mchans old)
unless paused $ unless paused $
startrunning new starttransports new
go h' paused (M.union common new) go h' paused (M.union common new) serverchans
LOSTNET -> do LOSTNET -> do
-- force close all cached ssh connections -- force close all cached ssh connections
-- (done here so that if there are multiple -- (done here so that if there are multiple
-- ssh remotes, it's only done once) -- ssh remotes, it's only done once)
liftAnnex h forceSshCleanup liftAnnex h forceSshCleanup
broadcast LOSTNET m broadcast LOSTNET transportchans
go h True m go h True m serverchans
PAUSE -> do PAUSE -> do
broadcast STOP m broadcast STOP transportchans
go h True m go h True m serverchans
RESUME -> do RESUME -> do
when paused $ when paused $
startrunning m starttransports m
go h False m go h False m serverchans
STOP -> exitSuccess STOP -> exitSuccess
-- All remaining messages are sent to -- All remaining messages are sent to
-- all Transports. -- all Transports.
msg -> do msg -> do
unless paused $ atomically $ unless paused $
forM_ chans (`writeTChan` msg) broadcast msg transportchans
go h paused m go h paused m serverchans
where where
chans = map snd (M.elems m) transportchans = mchans m
mchans = map snd . M.elems
startserver h server = do
c <- newTChanIO
void $ async $ server c h
return c
startrunning m = forM_ (M.elems m) startrunning' starttransports m = forM_ (M.elems m) starttransports'
startrunning' (transport, c) = do starttransports' (transport, c) = do
-- drain any old control messages from the channel -- drain any old control messages from the channel
-- to avoid confusing the transport with them -- to avoid confusing the transport with them
atomically $ drain c atomically $ drain c
@ -124,9 +131,7 @@ runController ichan ochan = do
drain c = maybe noop (const $ drain c) =<< tryReadTChan c drain c = maybe noop (const $ drain c) =<< tryReadTChan c
broadcast msg m = atomically $ forM_ (M.elems m) send broadcast msg cs = atomically $ forM_ cs $ \c -> writeTChan c msg
where
send (_, c) = writeTChan c msg
-- Generates a map with a transport for each supported remote in the git repo, -- Generates a map with a transport for each supported remote in the git repo,
-- except those that have annex.sync = false -- except those that have annex.sync = false

View file

@ -26,5 +26,5 @@ remoteTransports = M.fromList
, (torAnnexScheme, RemoteDaemon.Transport.Tor.transport) , (torAnnexScheme, RemoteDaemon.Transport.Tor.transport)
] ]
remoteServers :: [TransportHandle -> IO ()] remoteServers :: [Server]
remoteServers = [RemoteDaemon.Transport.Tor.server] remoteServers = [RemoteDaemon.Transport.Tor.server]

View file

@ -34,14 +34,25 @@ import Control.Concurrent.STM.TBMQueue
import Control.Concurrent.Async import Control.Concurrent.Async
-- Run tor hidden service. -- Run tor hidden service.
server :: TransportHandle -> IO () server :: Server
server th@(TransportHandle (LocalRepo r) _) = do server ichan th@(TransportHandle (LocalRepo r) _) = go
u <- liftAnnex th getUUID
uid <- getRealUserID
let ident = fromUUID u
go u =<< getHiddenServiceSocketFile torAppName uid ident
where where
go u (Just sock) = do go = checkstartservice >>= handlecontrol
checkstartservice = do
u <- liftAnnex th getUUID
uid <- getRealUserID
let ident = fromUUID u
msock <- getHiddenServiceSocketFile torAppName uid ident
case msock of
Nothing -> do
debugM "remotedaemon" "Tor hidden service not enabled"
return False
Just sock -> do
void $ async $ startservice sock u
return True
startservice sock u = do
q <- newTBMQueueIO maxConnections q <- newTBMQueueIO maxConnections
replicateM_ maxConnections $ replicateM_ maxConnections $
forkIO $ forever $ serveClient th u r q forkIO $ forever $ serveClient th u r q
@ -57,7 +68,18 @@ server th@(TransportHandle (LocalRepo r) _) = do
unless ok $ do unless ok $ do
hClose conn hClose conn
warningIO "dropped Tor connection, too busy" warningIO "dropped Tor connection, too busy"
go _ Nothing = debugM "remotedaemon" "Tor hidden service not enabled"
handlecontrol servicerunning = do
msg <- atomically $ readTChan ichan
case msg of
-- On reload, the configuration may have changed to
-- enable the tor hidden service. If it was not
-- enabled before, start it,
RELOAD | not servicerunning -> go
-- We can ignore all other messages; no need
-- to restart the hidden service when the network
-- changes as tor takes care of all that.
_ -> handlecontrol servicerunning
-- How many clients to serve at a time, maximum. This is to avoid DOS attacks. -- How many clients to serve at a time, maximum. This is to avoid DOS attacks.
maxConnections :: Int maxConnections :: Int

View file

@ -28,6 +28,10 @@ newtype RemoteURI = RemoteURI URI
-- from a Chan, and emits others to another Chan. -- from a Chan, and emits others to another Chan.
type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO () type Transport = RemoteRepo -> RemoteURI -> TransportHandle -> TChan Consumed -> TChan Emitted -> IO ()
-- A server for a Transport consumes some messages from a Chan in
-- order to learn about network changes, reloads, etc.
type Server = TChan Consumed -> TransportHandle -> IO ()
data RemoteRepo = RemoteRepo Git.Repo RemoteGitConfig data RemoteRepo = RemoteRepo Git.Repo RemoteGitConfig
newtype LocalRepo = LocalRepo Git.Repo newtype LocalRepo = LocalRepo Git.Repo