From fab0ea6ff17b2109b20ebffcef9262b1684203ca Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sun, 24 Jun 2018 20:18:43 -0400
Subject:  * Prevent XMPP layer from sending pings to tox peer.

 * Lookup node-id for specifying with "netcrypto" command-line.
---
 examples/dhtd.hs | 17 ++++++++++-------
 1 file changed, 10 insertions(+), 7 deletions(-)

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index efd51e6d..fefec650 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -62,7 +62,6 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import System.Posix.Signals
-import qualified Data.Array
 import qualified Data.Array.Unboxed as U
 import qualified Data.Conduit as Conduit
 
@@ -102,7 +101,6 @@ import qualified Network.Tox.Crypto.Handlers as Tox
 import Data.Typeable
 import Network.Tox.ContactInfo as Tox
 import OnionRouter
-import PingMachine
 import Data.PacketQueue
 import qualified Data.Word64Map as W64
 import System.FilePath
@@ -1376,7 +1374,13 @@ netcrypto (Just (DHT {..})) (Just mypubkey) h roster (Just tox) exes paramStr =
             Nothing -> hPutClient h "Unable to find account for selected key"
             Just account -> do
               now <- getPOSIXTime
-              atomically $ setContactAddr now their_pub (_fixme their_addr) account
+              atomically $ do
+                mcontact <- HashMap.lookup (Tox.nodeId userkey_nodeinfo) <$> readTVar (contacts account)
+                forM_ mcontact $ \contact -> do
+                mnid <- fmap (Tox.key2id . Tox.dhtpk . snd) <$> readTVar (contactKeyPacket contact)
+                forM_ mnid $ \nid -> do
+                forM_ (Tox.nodeInfo nid their_addr) $ \their_ni -> do
+                    setContactAddr now their_pub their_ni account
               sessions <- Tox.netCrypto tox sec their_pub
               exeDir <- takeDirectory <$> getExecutablePath
               forM_ sessions $ \session -> do
@@ -1970,11 +1974,10 @@ main = do
             let sockAddr = Tox.ncSockAddr netcrypto
                 pubKey   = Tox.ncTheirPublicKey netcrypto
             tmchan <- atomically newTMChan
-            mbPingMaching <- atomically $ readTVar (Tox.ncPingMachine netcrypto)
-            let Just pingMachine = mbPingMaching
-                pingflag         = readTVar (pingFlag pingMachine)
+            let pingflag         = return False -- XMPPServer should never send pings.
+                                                -- This is taken care of by the tox layer.
                 receiveCrypto    = atomically $ readTMChan tmchan
-                onEOF            = return () -- TODO: Update toxContactInfo, not connected.
+                onEOF            = return () -- setTerminate is called elsewhere.
                 xmppSrc          = ioToSource receiveCrypto onEOF
                 xmppSink         = newXmmpSink netcrypto
             forM_ msv $ \sv -> do
-- 
cgit v1.2.3