summaryrefslogtreecommitdiff
path: root/dht
diff options
context:
space:
mode:
Diffstat (limited to 'dht')
-rw-r--r--dht/src/Data/Tox/Onion.hs28
-rw-r--r--dht/src/Network/Tox.hs11
-rw-r--r--dht/src/Network/Tox/TCP.hs2
-rw-r--r--dht/src/Network/Tox/Transport.hs5
4 files changed, 37 insertions, 9 deletions
diff --git a/dht/src/Data/Tox/Onion.hs b/dht/src/Data/Tox/Onion.hs
index 0338111b..258a9f73 100644
--- a/dht/src/Data/Tox/Onion.hs
+++ b/dht/src/Data/Tox/Onion.hs
@@ -19,7 +19,7 @@
19module Data.Tox.Onion where 19module Data.Tox.Onion where
20 20
21 21
22import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) 22import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort,localhost4,localhost6)
23import Network.QueryResponse 23import Network.QueryResponse
24import Crypto.Tox hiding (encrypt,decrypt) 24import Crypto.Tox hiding (encrypt,decrypt)
25import Network.Tox.NodeId 25import Network.Tox.NodeId
@@ -57,6 +57,7 @@ import DebugTag
57import Data.Word64Map (fitsInInt) 57import Data.Word64Map (fitsInInt)
58import Data.Bits (shiftR,shiftL) 58import Data.Bits (shiftR,shiftL)
59import qualified Rank2 59import qualified Rank2
60import Util (sameAddress)
60 61
61type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a 62type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
62 63
@@ -239,11 +240,30 @@ routeId :: NodeId -> RouteId
239routeId nid = RouteId $ mod (hash nid) 12 240routeId nid = RouteId $ mod (hash nid) 12
240 241
241 242
243substituteLoopback :: SockAddr -- ^ UDP bind address
244 -> SockAddr -- ^ Logical destination address.
245 -> SockAddr -- ^ Destination address unless localhost, then bind address.
246substituteLoopback (SockAddrInet 0 _ ) saddr = saddr
247substituteLoopback (SockAddrInet6 _ _ (0,0,0,0) _) saddr = saddr
248substituteLoopback baddr saddr =
249 case either4or6 saddr of
250 Left s -> if sameAddress s localhost4 then baddr else saddr
251 Right s -> if sameAddress s localhost6 then baddr else saddr
242 252
243forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport 253handleLoopback :: SockAddr -> UDPTransport -> UDPTransport
244forwardOnions crypto udp sendTCP = udp { awaitMessage = forwardAwait crypto udp sendTCP } 254handleLoopback baddr udp = udp
255 { sendMessage = \a x -> sendMessage udp (substituteLoopback baddr a) x
256 }
257
258forwardOnions :: TransportCrypto
259 -> SockAddr -- UDP bind address
260 -> UDPTransport
261 -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport
262forwardOnions crypto baddr udp sendTCP = udp { awaitMessage = forwardAwait crypto (handleLoopback baddr udp) sendTCP }
245 263
246forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a 264forwardAwait :: TransportCrypto
265 -> UDPTransport
266 -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a
247forwardAwait crypto udp sendTCP kont = do 267forwardAwait crypto udp sendTCP kont = do
248 fix $ \another -> do 268 fix $ \another -> do
249 awaitMessage udp $ \case 269 awaitMessage udp $ \case
diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs
index 69c56e24..8a952aa4 100644
--- a/dht/src/Network/Tox.hs
+++ b/dht/src/Network/Tox.hs
@@ -45,6 +45,7 @@ import System.Endian
45import System.IO.Error 45import System.IO.Error
46 46
47import Data.TableMethods 47import Data.TableMethods
48import Data.Tox.Onion (substituteLoopback)
48import qualified Data.Word64Map 49import qualified Data.Word64Map
49import Network.BitTorrent.DHT.Token as Token 50import Network.BitTorrent.DHT.Token as Token
50import qualified Data.Wrapper.PSQ as PSQ 51import qualified Data.Wrapper.PSQ as PSQ
@@ -78,6 +79,7 @@ import Network.Tox.Relay
78import Network.SessionTransports 79import Network.SessionTransports
79import Network.Kademlia.Search 80import Network.Kademlia.Search
80import HandshakeCache 81import HandshakeCache
82import Data.ByteString.Base16 as Base16
81 83
82updateIP :: TVar (R.BucketList NodeInfo) -> SockAddr -> STM () 84updateIP :: TVar (R.BucketList NodeInfo) -> SockAddr -> STM ()
83updateIP tblvar a = do 85updateIP tblvar a = do
@@ -291,7 +293,12 @@ newTox keydb bindspecs onsess crypto tcp = do
291 throwIO $ userError "Tox UDP listen port?" 293 throwIO $ userError "Tox UDP listen port?"
292 (udp,sock) <- foldr tryBind failedBind addrs Nothing 294 (udp,sock) <- foldr tryBind failedBind addrs Nothing
293 addr <- getSocketName sock 295 addr <- getSocketName sock
294 (relay,sendTCP) <- tcpRelay (fst crypto) addr (\a x -> sendMessage udp a $ S.runPut $ Onion.putRequest x) 296 dput XOnion $ "UDP bind address: " ++ show addr
297 (relay,sendTCP) <- tcpRelay (fst crypto) addr $ \a x -> do
298 let bs = S.runPut $ Onion.putRequest x
299 dput XOnion $ "Sending onion(0x" ++ (C8.unpack . Base16.encode) (B.take 1 bs) ++ ") from tcp-client to " ++ show a
300 -- mapM_ (dput XOnion) (xxd2 0 bs)
301 sendMessage udp (substituteLoopback addr a) bs
295 tox <- newToxOverTransport keydb addr onsess crypto udp sendTCP 302 tox <- newToxOverTransport keydb addr onsess crypto udp sendTCP
296 return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox) 303 return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox)
297 , toxRelayServer = Just relay 304 , toxRelayServer = Just relay
@@ -330,7 +337,7 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do
330 mkrouting <- DHT.newRouting addr crypto updateIP updateIP 337 mkrouting <- DHT.newRouting addr crypto updateIP updateIP
331 (orouter,otbl) <- newOnionRouter crypto (dput XRoutes) 338 (orouter,otbl) <- newOnionRouter crypto (dput XRoutes)
332 (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) 339 (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes)
333 <- toxTransport crypto orouter lookupClose udp 340 <- toxTransport crypto orouter lookupClose addr udp
334 (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x)) 341 (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x))
335 tcp 342 tcp
336 sessions <- initSessions (sendMessage cryptonet) 343 sessions <- initSessions (sendMessage cryptonet)
diff --git a/dht/src/Network/Tox/TCP.hs b/dht/src/Network/Tox/TCP.hs
index ca4ca817..5dfb8382 100644
--- a/dht/src/Network/Tox/TCP.hs
+++ b/dht/src/Network/Tox/TCP.hs
@@ -233,7 +233,7 @@ getUDPNodes' tcp seeking dst0 = do
233 , method = OnionPacketID -- meth 233 , method = OnionPacketID -- meth
234 , wrapQuery = \n8 src gateway x -> (,) True $ 234 , wrapQuery = \n8 src gateway x -> (,) True $
235 OnionPacket n24 $ Addressed (UDP.nodeAddr dst) 235 OnionPacket n24 $ Addressed (UDP.nodeAddr dst)
236 $ wrapOnionPure b (wrap2 n24) (nodeAddr gateway') 236 $ wrapOnionPure b (wrap2 n24) (UDP.nodeAddr $ udpNodeInfo gateway')
237 $ wrapOnionPure c (wrap1 n24) (UDP.nodeAddr dst) 237 $ wrapOnionPure c (wrap1 n24) (UDP.nodeAddr dst)
238 $ NotForwarded $ encryptPayload (wrap0 n24) 238 $ NotForwarded $ encryptPayload (wrap0 n24)
239 $ OnionAnnounce Asymm 239 $ OnionAnnounce Asymm
diff --git a/dht/src/Network/Tox/Transport.hs b/dht/src/Network/Tox/Transport.hs
index 217d5b1d..4f97bfbf 100644
--- a/dht/src/Network/Tox/Transport.hs
+++ b/dht/src/Network/Tox/Transport.hs
@@ -22,6 +22,7 @@ toxTransport ::
22 TransportCrypto 22 TransportCrypto
23 -> OnionRouter 23 -> OnionRouter
24 -> (PublicKey -> IO (Maybe UDP.NodeInfo)) 24 -> (PublicKey -> IO (Maybe UDP.NodeInfo))
25 -> SockAddr -- ^ UDP bind-address
25 -> UDPTransport 26 -> UDPTransport
26 -> (TCP.NodeInfo -> RelayPacket -> IO ()) -- ^ TCP server-bound callback. 27 -> (TCP.NodeInfo -> RelayPacket -> IO ()) -- ^ TCP server-bound callback.
27 -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP client-bound callback. 28 -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP client-bound callback.
@@ -30,10 +31,10 @@ toxTransport ::
30 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) 31 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
31 , Transport String AnnouncedRendezvous (PublicKey,OnionData) 32 , Transport String AnnouncedRendezvous (PublicKey,OnionData)
32 , Transport String SockAddr (Handshake Encrypted)) 33 , Transport String SockAddr (Handshake Encrypted))
33toxTransport crypto orouter closeLookup udp tcp2server tcp2client = do 34toxTransport crypto orouter closeLookup addr udp tcp2server tcp2client = do
34 (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp 35 (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp
35 (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr) 36 (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr)
36 $ forwardOnions crypto udp0 tcp2client 37 $ forwardOnions crypto addr udp0 tcp2client
37 (onion1,udp2) <- partitionAndForkTransport tcp2server 38 (onion1,udp2) <- partitionAndForkTransport tcp2server
38 (parseOnionAddr $ lookupSender orouter) 39 (parseOnionAddr $ lookupSender orouter)
39 (encodeOnionAddr crypto $ lookupRoute orouter) 40 (encodeOnionAddr crypto $ lookupRoute orouter)