diff options
Diffstat (limited to 'src/Network/Tox.hs')
-rw-r--r-- | src/Network/Tox.hs | 20 |
1 files changed, 16 insertions, 4 deletions
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 | |||
23 | import Control.Concurrent.Lifted | 23 | import Control.Concurrent.Lifted |
24 | #endif | 24 | #endif |
25 | import Control.Concurrent.STM | 25 | import Control.Concurrent.STM |
26 | import Control.Exception (throwIO) | ||
26 | import Control.Monad | 27 | import Control.Monad |
27 | import Crypto.PubKey.Curve25519 | 28 | import Crypto.PubKey.Curve25519 |
28 | import Crypto.Random | 29 | import Crypto.Random |
@@ -39,11 +40,12 @@ import Data.Time.Clock.POSIX (getPOSIXTime) | |||
39 | import Data.Word | 40 | import Data.Word |
40 | import Network.Socket | 41 | import Network.Socket |
41 | import System.Endian | 42 | import System.Endian |
43 | import System.IO.Error | ||
42 | 44 | ||
43 | import Network.BitTorrent.DHT.Token as Token | 45 | import Network.BitTorrent.DHT.Token as Token |
44 | import qualified Data.Wrapper.PSQ as PSQ | 46 | import qualified Data.Wrapper.PSQ as PSQ |
45 | import System.Global6 | 47 | import System.Global6 |
46 | import Network.Address (WantIP (..),IP) | 48 | import Network.Address (WantIP (..),IP,getBindAddress) |
47 | import qualified Network.Kademlia.Routing as R | 49 | import qualified Network.Kademlia.Routing as R |
48 | import Network.QueryResponse | 50 | import Network.QueryResponse |
49 | import Crypto.Tox | 51 | import Crypto.Tox |
@@ -209,6 +211,7 @@ data Tox extra = Tox | |||
209 | , toxOnionRoutes :: OnionRouter | 211 | , toxOnionRoutes :: OnionRouter |
210 | , toxContactInfo :: ContactInfo extra | 212 | , toxContactInfo :: ContactInfo extra |
211 | , toxAnnounceToLan :: IO () | 213 | , toxAnnounceToLan :: IO () |
214 | , toxBindAddress :: SockAddr | ||
212 | } | 215 | } |
213 | 216 | ||
214 | 217 | ||
@@ -268,13 +271,21 @@ getOnionAlias crypto dhtself remoteNode = atomically $ do | |||
268 | return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing | 271 | return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing |
269 | 272 | ||
270 | newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rendezvous for. | 273 | newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rendezvous for. |
271 | -> SockAddr -- ^ Bind-address to listen on. | 274 | -> [String] -- ^ Bind-address to listen on. Must provide at least one. |
272 | -> ( ContactInfo extra -> SockAddr -> Session -> IO () ) | 275 | -> ( ContactInfo extra -> SockAddr -> Session -> IO () ) |
273 | -> Maybe SecretKey -- ^ Optional DHT secret key to use. | 276 | -> Maybe SecretKey -- ^ Optional DHT secret key to use. |
274 | -> ( Int -> Onion.OnionResponse Onion.N1 -> IO () ) -- ^ TCP-bound onion responses. | 277 | -> ( Int -> Onion.OnionResponse Onion.N1 -> IO () ) -- ^ TCP-bound onion responses. |
275 | -> IO (Tox extra) | 278 | -> IO (Tox extra) |
276 | newTox keydb addr onsess suppliedDHTKey tcp = do | 279 | newTox keydb bindspecs onsess suppliedDHTKey tcp = do |
277 | (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr | 280 | addrs <- mapM (`getBindAddress` True) bindspecs |
281 | let tryBind addr next _ = udpTransport' addr `catchIOError` (next . Just) | ||
282 | failedBind mbe = do | ||
283 | forM_ mbe $ \e -> do | ||
284 | dput XDHT $ "tox udp bind error: " ++ show addrs ++ " " ++ show e | ||
285 | throwIO e | ||
286 | throwIO $ userError "Tox UDP listen port?" | ||
287 | (udp,sock) <- foldr tryBind failedBind addrs Nothing | ||
288 | addr <- getSocketName sock | ||
278 | tox <- newToxOverTransport keydb addr onsess suppliedDHTKey udp tcp | 289 | tox <- newToxOverTransport keydb addr onsess suppliedDHTKey udp tcp |
279 | return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox) } | 290 | return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox) } |
280 | 291 | ||
@@ -354,6 +365,7 @@ newToxOverTransport keydb addr onNewSession suppliedDHTKey udp tcp = do | |||
354 | , toxOnionRoutes = orouter | 365 | , toxOnionRoutes = orouter |
355 | , toxContactInfo = roster | 366 | , toxContactInfo = roster |
356 | , toxAnnounceToLan = return () | 367 | , toxAnnounceToLan = return () |
368 | , toxBindAddress = addr | ||
357 | } | 369 | } |
358 | 370 | ||
359 | onionTimeout :: Tox extra -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int) | 371 | onionTimeout :: Tox extra -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int) |