UPNP port requests (requires miniupnpc).

1 files changed, 9 insertions, 6 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 6c655458..32fb8060 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -45,6 +45,7 @@ import Control.Concurrent.Lifted
 import GHC.Conc                  (labelThread)
 #endif
 
+import Network.UPNP as UPNP
 import Network.Address hiding (NodeId, NodeInfo(..))
 import Network.Kademlia.Search
 import Network.QueryResponse
@@ -524,8 +525,8 @@ main = do
            (atomically . writeTVar (Mainline.contactInfo swarms))
            (peerdb >>= S.decodeLazy)
 
-    (quitBt,btdhts,btips) <- case portbt opts of
-        "" -> return (return (), Map.empty,return [])
+    (quitBt,btdhts,btips,baddrs) <- case portbt opts of
+        "" -> return (return (), Map.empty,return [],[])
         p  -> do
             addr <- getBindAddress p (ip6bt opts)
             (bt,btR) <- Mainline.newClient swarms addr
@@ -563,12 +564,12 @@ main = do
                                         [ Mainline.routing4 btR
                                         , Mainline.routing6 btR
                                         ]
-            return (quitBt,dhts,ips)
+            return (quitBt,dhts,ips, [addr])
 
     keysdb <- Tox.newKeysDatabase
 
-    (quitTox,toxdhts,toxips) <- case porttox opts of
-        "" -> return (return (), Map.empty, return [])
+    (quitTox,toxdhts,toxips,taddrs) <- case porttox opts of
+        "" -> return (return (), Map.empty, return [],[])
         toxport -> do
             addrTox <- getBindAddress toxport (ip6tox opts)
             tox <- Tox.newTox keysdb addrTox
@@ -599,7 +600,9 @@ main = do
                 ips :: IO [SockAddr]
                 ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox
                                                  , Tox.routing6 $ Tox.toxRouting tox ]
-            return (quitTox, dhts, ips)
+            return (quitTox, dhts, ips, [addrTox])
+
+    _ <- UPNP.requestPorts "dht-client" $ map (Datagram,) $ baddrs ++ taddrs
 
     let dhts = Map.union btdhts toxdhts