1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
{- 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 qualified Annex
import Annex.Concurrent
import RemoteDaemon.Types
import RemoteDaemon.Common
import Utility.Tor
import Utility.FileMode
import Utility.AuthToken
import P2P.Protocol
import P2P.IO
import P2P.Annex
import P2P.Auth
import Annex.UUID
import Types.UUID
import Messages
import Git
import System.PosixCompat.User
import Network.Socket
import Control.Concurrent
import System.Log.Logger (debugM)
import Control.Concurrent.STM
-- Run tor hidden service.
server :: TransportHandle -> IO ()
server th@(TransportHandle (LocalRepo r) _) = do
u <- liftAnnex th getUUID
q <- newTBQueueIO maxConnections
replicateM_ maxConnections $
forkIO $ forever $ serveClient th u r q
uid <- getRealUserID
let ident = fromUUID u
let sock = hiddenServiceSocketFile 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
h <- setupHandle conn
ok <- atomically $ ifM (isFullTBQueue q)
( return False
, do
writeTBQueue q h
return True
)
unless ok $ do
hClose h
warningIO "dropped Tor connection, too busy"
-- How many clients to serve at a time, maximum. This is to avoid DOS
-- attacks.
maxConnections :: Int
maxConnections = 10
serveClient :: TransportHandle -> UUID -> Repo -> TBQueue Handle -> IO ()
serveClient th u r q = bracket setup cleanup go
where
setup = atomically $ readTBQueue q
cleanup = hClose
go h = do
debugM "remotedaemon" "serving a Tor connection"
-- Avoid doing any work in the liftAnnex, since only one
-- can run at a time.
st <- liftAnnex th dupState
((), st') <- Annex.run st $ do
-- Load auth tokens for every connection, to notice
-- when the allowed set is changed.
allowed <- loadP2PAuthTokens
let conn = P2PConnection
{ connRepo = r
, connCheckAuth = (`isAllowedAuthToken` allowed)
, connIhdl = h
, connOhdl = h
}
v <- liftIO $ runNetProto conn $ serveAuth u
case v of
Right (Just theiruuid) -> void $ do
v' <- runFullProto (Serving theiruuid) conn $
serveAuthed u
case v' of
Right () -> return ()
Left e -> liftIO $ debugM "remotedaemon" ("Tor connection error: " ++ e)
Right Nothing -> liftIO $
debugM "remotedaemon" "Tor connection failed to authenticate"
Left e -> liftIO $
debugM "remotedaemon" ("Tor connection error before authentication: " ++ e)
-- Merge the duplicated state back in.
liftAnnex th $ mergeState st'
debugM "remotedaemon" "done with Tor connection"
|
