2 files changed, 26 insertions, 11 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 6756b14b..04b8c064 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1055,7 +1055,7 @@ readExternals nodeAddr vars = do
 
 data Options = Options
     { portbt    :: String
-    , porttox   :: String
+    , porttox   :: [String]
     , portxmpp  :: String -- client-to-server
     , portxmppS :: String -- server-to-server
     , ip6bt     :: Bool
@@ -1076,7 +1076,7 @@ data Options = Options
 sensibleDefaults :: Options
 sensibleDefaults = Options
     { portbt      = "6881"
-    , porttox     = "33445"
+    , porttox     = ["33445"]
     , portxmpp    = "5222"
     , portxmppS   = "5269"
     , ip6bt       = True
@@ -1107,10 +1107,13 @@ parseArgs ("-v":tags:args) opts     = parseArgs args opts
     }
 parseArgs (arg:args) opts          = parseArgs args opts
     { portbt    = fromMaybe (portbt opts)  $ Prelude.lookup "bt"  ports
-    , porttox   = fromMaybe (porttox opts) $ Prelude.lookup "tox" ports
+    , porttox   = fromMaybe (porttox opts) $ lookupAll "tox" ports
     , portxmpp  = fromMaybe (portxmpp opts) $ Prelude.lookup "xmpp" ports
     , portxmppS = fromMaybe (portxmppS opts) $ Prelude.lookup "xmpp.s2s" ports }
  where
+    lookupAll seeking kvs = case filter (\(k,v) -> k == seeking) kvs of
+        [] -> Nothing
+        xs -> Just $ map snd xs
     ports = map ( (dropWhile (==',') *** dropWhile (=='='))
                 . break (=='=') )
                 $ groupBy (const (/= ',')) arg
@@ -1298,17 +1301,17 @@ initTox :: Options
                  , IO [SockAddr]
                  , [SockAddr])
 initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
-        "" -> return (Nothing,return (), Map.empty, return [],[])
+        [""] -> return (Nothing,return (), Map.empty, return [],[])
         toxport -> do
-            addrTox <- getBindAddress toxport (ip6tox opts)
             dput XMisc $ "Supplied key: " ++ show (fmap (Tox.key2id . toPublic) (dhtkey opts))
             tox <- Tox.newTox keysdb
-                              addrTox
+                              toxport
                               (case mbxmpp of
                                 Nothing   -> \_ _ _ -> return ()
                                 Just xmpp -> onNewToxSession xmpp ssvar invc)
                               (dhtkey opts)
                               (\_ _ -> return ()) -- TODO: TCP relay send
+            -- addrTox <- getBindAddress toxport (ip6tox opts)
             (quitTox, toxStrap4, toxStrap6) <- Tox.forkTox tox True
 
             toxSearches <- atomically $ newTVar Map.empty
@@ -1491,7 +1494,7 @@ initTox opts ssvar keysdb mbxmpp invc = case porttox opts of
                 ips :: IO [SockAddr]
                 ips = readExternals Tox.nodeAddr [ Tox.routing4 $ Tox.toxRouting tox
                                                  , Tox.routing6 $ Tox.toxRouting tox ]
-            return (Just tox, quitTox, dhts, ips, [addrTox])
+            return (Just tox, quitTox, dhts, ips, [Tox.toxBindAddress tox])
 
 initJabber :: Options
               -> TVar (Map.Map Uniq24 AggregateSession)
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index b22cfdf3..30efefa8 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -23,6 +23,7 @@ import Control.Concurrent.Lifted.Instrument
 import Control.Concurrent.Lifted
 #endif
 import Control.Concurrent.STM
+import Control.Exception                      (throwIO)
 import Control.Monad
 import Crypto.PubKey.Curve25519
 import Crypto.Random
@@ -39,11 +40,12 @@ import Data.Time.Clock.POSIX                  (getPOSIXTime)
 import Data.Word
 import Network.Socket
 import System.Endian
+import System.IO.Error
 
 import Network.BitTorrent.DHT.Token           as Token
 import qualified Data.Wrapper.PSQ             as PSQ
 import System.Global6
-import Network.Address                        (WantIP (..),IP)
+import Network.Address                        (WantIP (..),IP,getBindAddress)
 import qualified Network.Kademlia.Routing          as R
 import Network.QueryResponse
 import Crypto.Tox
@@ -209,6 +211,7 @@ data Tox extra  = Tox
     , toxOnionRoutes    :: OnionRouter
     , toxContactInfo    :: ContactInfo extra
     , toxAnnounceToLan  :: IO ()
+    , toxBindAddress    :: SockAddr
     }
 
 
@@ -268,13 +271,21 @@ getOnionAlias crypto dhtself remoteNode = atomically $ do
     return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing
 
 newTox :: TVar Onion.AnnouncedKeys   -- ^ Store of announced keys we are a rendezvous for.
-       -> SockAddr                   -- ^ Bind-address to listen on.
+       -> [String]                   -- ^ Bind-address to listen on. Must provide at least one.
        -> ( ContactInfo extra -> SockAddr -> Session -> IO () )
        -> Maybe SecretKey            -- ^ Optional DHT secret key to use.
         -> ( Int -> Onion.OnionResponse Onion.N1 -> IO () ) -- ^ TCP-bound onion responses.
        -> IO (Tox extra)
-newTox keydb addr onsess suppliedDHTKey tcp = do
-    (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr
+newTox keydb bindspecs onsess suppliedDHTKey tcp = do
+    addrs <- mapM (`getBindAddress` True) bindspecs
+    let tryBind addr next _ = udpTransport' addr `catchIOError` (next . Just)
+        failedBind mbe = do
+            forM_ mbe $ \e -> do
+                dput XDHT $ "tox udp bind error: " ++ show addrs ++ " " ++ show e
+                throwIO e
+            throwIO $ userError "Tox UDP listen port?"
+    (udp,sock) <- foldr tryBind failedBind addrs Nothing
+    addr <- getSocketName sock
     tox <- newToxOverTransport keydb addr onsess suppliedDHTKey udp tcp
     return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox) }
 
@@ -354,6 +365,7 @@ newToxOverTransport keydb addr onNewSession suppliedDHTKey udp tcp = do
         , toxOnionRoutes    = orouter
         , toxContactInfo    = roster
         , toxAnnounceToLan  = return ()
+        , toxBindAddress    = addr
         }
 
 onionTimeout :: Tox extra -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int)