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 @@
 module Data.Tox.Onion where
 
 
-import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
+import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort,localhost4,localhost6)
 import Network.QueryResponse
 import Crypto.Tox hiding (encrypt,decrypt)
 import Network.Tox.NodeId
@@ -57,6 +57,7 @@ import DebugTag
 import Data.Word64Map (fitsInInt)
 import Data.Bits (shiftR,shiftL)
 import qualified Rank2
+import Util (sameAddress)
 
 type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
 
@@ -239,11 +240,30 @@ routeId :: NodeId -> RouteId
 routeId nid = RouteId $ mod (hash nid) 12
 
 
+substituteLoopback :: SockAddr -- ^ UDP bind address
+                      -> SockAddr -- ^ Logical destination address.
+                      -> SockAddr -- ^ Destination address unless localhost, then bind address.
+substituteLoopback (SockAddrInet 0 _             ) saddr = saddr
+substituteLoopback (SockAddrInet6 _ _ (0,0,0,0) _) saddr = saddr
+substituteLoopback baddr saddr =
+    case either4or6 saddr of
+        Left s -> if sameAddress s localhost4 then baddr else saddr
+        Right s -> if sameAddress s localhost6 then baddr else saddr
 
-forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport
-forwardOnions crypto udp sendTCP = udp { awaitMessage = forwardAwait crypto udp sendTCP }
+handleLoopback :: SockAddr -> UDPTransport -> UDPTransport
+handleLoopback baddr udp = udp
+    { sendMessage = \a x -> sendMessage udp (substituteLoopback baddr a) x
+    }
+
+forwardOnions :: TransportCrypto
+                -> SockAddr -- UDP bind address
+                -> UDPTransport
+                -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport
+forwardOnions crypto baddr udp sendTCP = udp { awaitMessage = forwardAwait crypto (handleLoopback baddr udp) sendTCP }
 
-forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a
+forwardAwait :: TransportCrypto
+                -> UDPTransport
+                -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a
 forwardAwait crypto udp sendTCP kont = do
     fix $ \another -> do
       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
 import System.IO.Error
 
 import Data.TableMethods
+import Data.Tox.Onion                        (substituteLoopback)
 import qualified Data.Word64Map
 import Network.BitTorrent.DHT.Token           as Token
 import qualified Data.Wrapper.PSQ             as PSQ
@@ -78,6 +79,7 @@ import Network.Tox.Relay
 import Network.SessionTransports
 import Network.Kademlia.Search
 import HandshakeCache
+import Data.ByteString.Base16 as Base16
 
 updateIP :: TVar (R.BucketList NodeInfo) -> SockAddr -> STM ()
 updateIP tblvar a = do
@@ -291,7 +293,12 @@ newTox keydb bindspecs onsess crypto tcp = do
             throwIO $ userError "Tox UDP listen port?"
     (udp,sock) <- foldr tryBind failedBind addrs Nothing
     addr <- getSocketName sock
-    (relay,sendTCP) <- tcpRelay (fst crypto) addr (\a x -> sendMessage udp a $ S.runPut $ Onion.putRequest x)
+    dput XOnion $ "UDP bind address: " ++ show addr
+    (relay,sendTCP) <- tcpRelay (fst crypto) addr $ \a x -> do
+        let bs = S.runPut $ Onion.putRequest x
+        dput XOnion $ "Sending onion(0x" ++ (C8.unpack . Base16.encode) (B.take 1 bs) ++ ") from tcp-client to " ++ show a
+        -- mapM_ (dput XOnion) (xxd2 0 bs)
+        sendMessage udp (substituteLoopback addr a) bs
     tox <- newToxOverTransport keydb addr onsess crypto udp sendTCP
     return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox)
                , toxRelayServer   = Just relay
@@ -330,7 +337,7 @@ newToxOverTransport keydb addr onNewSession (crypto,roster) udp tcp = do
     mkrouting <- DHT.newRouting addr crypto updateIP updateIP
     (orouter,otbl) <- newOnionRouter crypto (dput XRoutes)
     (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes)
-        <- toxTransport crypto orouter lookupClose udp
+        <- toxTransport crypto orouter lookupClose addr udp
                 (\dst x -> sendMessage (clientNet $ tcpClient $ tcpKademliaClient orouter) dst (True,x))
                 tcp
     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
                     , method = OnionPacketID -- meth
                     , wrapQuery = \n8 src gateway x -> (,) True $
                         OnionPacket n24 $ Addressed (UDP.nodeAddr dst)
-                            $ wrapOnionPure b (wrap2 n24) (nodeAddr gateway')
+                            $ wrapOnionPure b (wrap2 n24) (UDP.nodeAddr $ udpNodeInfo gateway')
                                 $ wrapOnionPure c (wrap1 n24) (UDP.nodeAddr dst)
                                     $ NotForwarded $ encryptPayload (wrap0 n24)
                                        $ 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 ::
       TransportCrypto
           -> OnionRouter
           -> (PublicKey -> IO (Maybe UDP.NodeInfo))
+          -> SockAddr -- ^ UDP bind-address
           -> UDPTransport
           -> (TCP.NodeInfo -> RelayPacket -> IO ())   -- ^ TCP server-bound callback.
           -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP client-bound callback.
@@ -30,10 +31,10 @@ toxTransport ::
                 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
                 , Transport String AnnouncedRendezvous (PublicKey,OnionData)
                 , Transport String SockAddr (Handshake Encrypted))
-toxTransport crypto orouter closeLookup udp tcp2server tcp2client = do
+toxTransport crypto orouter closeLookup addr udp tcp2server tcp2client = do
     (netcrypto, udp0) <- partitionTransport parseCrypto encodeCrypto udp
     (dht,udp1) <- partitionTransportM (parseDHTAddr crypto) (fmap Just . encodeDHTAddr)
-                                    $ forwardOnions crypto udp0 tcp2client
+                                    $ forwardOnions crypto addr udp0 tcp2client
     (onion1,udp2) <- partitionAndForkTransport tcp2server
                              (parseOnionAddr $ lookupSender orouter)
                              (encodeOnionAddr crypto $ lookupRoute orouter)