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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
{- git-remote-daemon, tor hidden service server and transport
-
- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module RemoteDaemon.Transport.Tor (server, transport, torSocketFile) where
import Common
import qualified Annex
import Annex.Concurrent
import Annex.ChangedRefs
import RemoteDaemon.Types
import RemoteDaemon.Common
import Utility.AuthToken
import Utility.Tor
import P2P.Protocol as P2P
import P2P.IO
import P2P.Annex
import P2P.Auth
import P2P.Address
import Annex.UUID
import Types.UUID
import Messages
import Git
import Git.Command
import Control.Concurrent
import System.Log.Logger (debugM)
import Control.Concurrent.STM
import Control.Concurrent.STM.TBMQueue
import Control.Concurrent.Async
#ifndef mingw32_HOST_OS
import System.Posix.User
#endif
-- Run tor hidden service.
server :: Server
server ichan th@(TransportHandle (LocalRepo r) _) = go
where
go = checkstartservice >>= handlecontrol
checkstartservice = do
u <- liftAnnex th getUUID
msock <- liftAnnex th torSocketFile
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
replicateM_ maxConnections $
forkIO $ forever $ serveClient th u r q
debugM "remotedaemon" "Tor hidden service running"
serveUnixSocket sock $ \conn -> do
ok <- atomically $ ifM (isFullTBMQueue q)
( return False
, do
writeTBMQueue q conn
return True
)
unless ok $ do
hClose conn
warningIO "dropped Tor connection, too busy"
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.
maxConnections :: Int
maxConnections = 100
serveClient :: TransportHandle -> UUID -> Repo -> TBMQueue Handle -> IO ()
serveClient th u r q = bracket setup cleanup start
where
setup = do
h <- atomically $ readTBMQueue q
debugM "remotedaemon" "serving a Tor connection"
return h
cleanup Nothing = return ()
cleanup (Just h) = do
debugM "remotedaemon" "done with Tor connection"
hClose h
start Nothing = return ()
start (Just h) = do
-- 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 $ P2P.serveAuth u
case v of
Right (Just theiruuid) -> authed conn theiruuid
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'
authed conn theiruuid =
bracket watchChangedRefs (liftIO . maybe noop stopWatchingChangedRefs) $ \crh -> do
v' <- runFullProto (Serving theiruuid crh) conn $
P2P.serveAuthed u
case v' of
Right () -> return ()
Left e -> liftIO $ debugM "remotedaemon" ("Tor connection error: " ++ e)
-- Connect to peer's tor hidden service.
transport :: Transport
transport (RemoteRepo r gc) url@(RemoteURI uri) th ichan ochan =
case unformatP2PAddress (show uri) of
Nothing -> return ()
Just addr -> robustConnection 1 $ do
g <- liftAnnex th Annex.gitRepo
bracket (connectPeer g addr) closeConnection (go addr)
where
go addr conn = do
myuuid <- liftAnnex th getUUID
authtoken <- fromMaybe nullAuthToken
<$> liftAnnex th (loadP2PRemoteAuthToken addr)
res <- runNetProto conn $
P2P.auth myuuid authtoken
case res of
Right (Just theiruuid) -> do
expecteduuid <- liftAnnex th $ getRepoUUID r
if expecteduuid == theiruuid
then do
send (CONNECTED url)
status <- handlecontrol
`race` handlepeer conn
send (DISCONNECTED url)
return $ either id id status
else return ConnectionStopping
_ -> return ConnectionClosed
send msg = atomically $ writeTChan ochan msg
handlecontrol = do
msg <- atomically $ readTChan ichan
case msg of
STOP -> return ConnectionStopping
LOSTNET -> return ConnectionStopping
_ -> handlecontrol
handlepeer conn = do
v <- runNetProto conn P2P.notifyChange
case v of
Right (Just (ChangedRefs shas)) -> do
whenM (checkShouldFetch gc th shas) $
fetch
handlepeer conn
_ -> return ConnectionClosed
fetch = do
send (SYNCING url)
ok <- inLocalRepo th $
runBool [Param "fetch", Param $ Git.repoDescribe r]
send (DONESYNCING url ok)
torSocketFile :: Annex.Annex (Maybe FilePath)
torSocketFile = do
u <- getUUID
let ident = fromUUID u
#ifndef mingw32_HOST_OS
uid <- liftIO getRealUserID
#else
let uid = 0
#endif
liftIO $ getHiddenServiceSocketFile torAppName uid ident
|
