Stagger tcp-probe of port 3389.

1 files changed, 18 insertions, 9 deletions

diff --git a/dht/TCPProber.hs b/dht/TCPProber.hs
index ff68ba07..d58b8b60 100644
--- a/dht/TCPProber.hs
+++ b/dht/TCPProber.hs
@@ -27,6 +27,8 @@ import Network.Kademlia.Search
 import Network.Tox.NodeId
 import qualified Network.Tox.TCP as TCP
 
+-- Probe TCP ports in a staggered fashion to up the odds of discovering
+-- a higher priority port like 443.
 resolvePort :: TCP.RelayClient -> NodeInfo -> IO (Maybe PortNumber)
 resolvePort tcp ni = do
     got <- newTVarIO Nothing
@@ -51,21 +53,28 @@ resolvePort tcp ni = do
                 Nothing -> readTVar cnt >>= check . (== 0) >> return Nothing
     t443 <- forkPort 443
     t80 <- forkPort 80
-    p <- timeout 1000000 readResult >>= \case
+    p <- timeout 500000 readResult >>= \case
             Just (Just p) -> do
                 killThread t443
                 killThread t80
                 return $ Just p
             _ -> do
-                let uport = nodePort ni
-                tudp <- forM (guard $ uport `notElem` [443,80,3389,33445])
-                            $ \() -> forkPort uport
                 t3389 <- forkPort 3389
-                t33445 <- forkPort 33445
-                p <- readResult
-                mapM_ killThread [t443,t80,t3389,t33445]
-                mapM_ killThread (tudp :: Maybe ThreadId)
-                return p
+                timeout 500000 readResult >>= \case
+                    Just (Just p) -> do
+                        killThread t3389
+                        killThread t443
+                        killThread t80
+                        return $ Just p
+                    _ -> do
+                        let uport = nodePort ni
+                        tudp <- forM (guard $ uport `notElem` [443,80,3389,33445])
+                                    $ \() -> forkPort uport
+                        t33445 <- forkPort 33445
+                        p <- readResult
+                        mapM_ killThread [t443,t80,t3389,t33445]
+                        mapM_ killThread (tudp :: Maybe ThreadId)
+                        return p
     return p
 
 data TCPProber = TCPProber