summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--avahi.hs4
-rw-r--r--src/Network/Tox.hs22
-rw-r--r--src/Network/Tox/Avahi.hs13
3 files changed, 29 insertions, 10 deletions
diff --git a/avahi.hs b/avahi.hs
index 2db3be71..aeb8138f 100644
--- a/avahi.hs
+++ b/avahi.hs
@@ -9,6 +9,6 @@ exampleNodeId = read $ replicate 43 'a'
9main :: IO () 9main :: IO ()
10main = do 10main = do
11 [hostname, port, nodeId] <- getArgs 11 [hostname, port, nodeId] <- getArgs
12 void $ announceToxService hostname (fromMaybe 54321 $ readMaybe port) (fromMaybe exampleNodeId $ readMaybe nodeId) 12 void $ forkIO $ announceToxServiceWithHostname hostname (fromMaybe 54321 $ readMaybe port) (fromMaybe exampleNodeId $ readMaybe nodeId)
13 void $ queryToxService print 13 void $ forkIO $ queryToxService print
14 void $ getLine 14 void $ getLine
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 3c3bce49..170a07e8 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -1,3 +1,4 @@
1{-# LANGUAGE ViewPatterns #-}
1{-# LANGUAGE CPP #-} 2{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-} 3{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveFoldable #-} 4{-# LANGUAGE DeriveFoldable #-}
@@ -19,7 +20,11 @@ import Debug.Trace
19import Control.Exception hiding (Handler) 20import Control.Exception hiding (Handler)
20import Control.Applicative 21import Control.Applicative
21import Control.Arrow 22import Control.Arrow
22import Control.Concurrent (MVar,killThread) 23#ifdef THREAD_DEBUG
24import Control.Concurrent.Lifted.Instrument
25#else
26import Control.Concurrent.Lifted
27#endif
23import Control.Concurrent.STM 28import Control.Concurrent.STM
24import Control.Monad 29import Control.Monad
25import Control.Monad.Fix 30import Control.Monad.Fix
@@ -113,7 +118,7 @@ import Data.HashMap.Strict (HashMap)
113import qualified Data.Map.Strict as Map 118import qualified Data.Map.Strict as Map
114import Control.Concurrent (threadDelay) 119import Control.Concurrent (threadDelay)
115import DPut 120import DPut
116 121import Network.Tox.Avahi
117 122
118newCrypto :: IO TransportCrypto 123newCrypto :: IO TransportCrypto
119newCrypto = do 124newCrypto = do
@@ -476,6 +481,17 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
476onionTimeout :: Tox -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int) 481onionTimeout :: Tox -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int)
477onionTimeout Tox { toxOnionRoutes = or } (DHT.TransactionId n8 _) od = lookupTimeout or n8 od 482onionTimeout Tox { toxOnionRoutes = or } (DHT.TransactionId n8 _) od = lookupTimeout or n8 od
478 483
484routing4nodeInfo :: DHT.Routing -> IO NodeInfo
485routing4nodeInfo (DHT.routing4 -> tv) = R.thisNode <$> readTVarIO tv
486
487dnssdAnnounce :: Tox -> IO ()
488dnssdAnnounce (toxRouting -> r) = do
489 ni <- routing4nodeInfo r
490 announceToxService (nodePort ni) (nodeId ni)
491
492dnssdDiscover :: Tox -> NodeInfo -> IO ()
493dnssdDiscover (toxDHT -> client) ni = void $ DHT.ping client ni
494
479forkTox :: Tox -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ()) 495forkTox :: Tox -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ())
480forkTox tox = do 496forkTox tox = do
481 _ <- forkListener "toxHandshakes" (toxHandshakes tox) 497 _ <- forkListener "toxHandshakes" (toxHandshakes tox)
@@ -485,6 +501,8 @@ forkTox tox = do
485 quit <- forkListener "toxCrypto" (toxCrypto tox) 501 quit <- forkListener "toxCrypto" (toxCrypto tox)
486 forkPollForRefresh (DHT.refresher4 $ toxRouting tox) 502 forkPollForRefresh (DHT.refresher4 $ toxRouting tox)
487 forkPollForRefresh (DHT.refresher6 $ toxRouting tox) 503 forkPollForRefresh (DHT.refresher6 $ toxRouting tox)
504 dnssdIn <- forkIO $ queryToxService (dnssdDiscover tox)
505 dnssdOut <- forkIO $ dnssdAnnounce tox
488 keygc <- Onion.forkAnnouncedKeysGC (toxAnnouncedKeys tox) 506 keygc <- Onion.forkAnnouncedKeysGC (toxAnnouncedKeys tox)
489 return ( killThread keygc >> quit 507 return ( killThread keygc >> quit
490 , bootstrap (DHT.refresher4 $ toxRouting tox) 508 , bootstrap (DHT.refresher4 $ toxRouting tox)
diff --git a/src/Network/Tox/Avahi.hs b/src/Network/Tox/Avahi.hs
index ba5138bc..ed52de74 100644
--- a/src/Network/Tox/Avahi.hs
+++ b/src/Network/Tox/Avahi.hs
@@ -5,12 +5,11 @@ module Network.Tox.Avahi
5 , NodeInfo(..) 5 , NodeInfo(..)
6 , NodeId(..) 6 , NodeId(..)
7 ) where 7 ) where
8
8import Data.Foldable 9import Data.Foldable
9import GHC.Conc.Sync
10import GHC.Word (Word16) 10import GHC.Word (Word16)
11import Network.Address 11import Network.Address
12import Network.Avahi 12import Network.Avahi
13import Network.Avahi
14import Network.Socket 13import Network.Socket
15import Network.Tox.NodeId 14import Network.Tox.NodeId
16import Text.Read 15import Text.Read
@@ -37,12 +36,14 @@ toxService hostname (fromIntegral -> port) (show -> extra) =
37 serviceText = extra 36 serviceText = extra
38 } 37 }
39 38
40announceToxService :: String -> PortNumber -> NodeId -> IO ThreadId 39announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> IO ()
41announceToxService = ((.).(.).(.)) (forkIO . announce) toxService 40announceToxServiceWithHostname = ((.).(.).(.)) announce toxService
41
42announceToxService :: PortNumber -> NodeId -> IO ()
43announceToxService = announceToxServiceWithHostname ""
42 44
43queryToxService :: (NodeInfo -> IO ()) -> IO ThreadId 45queryToxService :: (NodeInfo -> IO ()) -> IO ()
44queryToxService cb = 46queryToxService cb =
45 forkIO $
46 browse $ 47 browse $
47 BrowseQuery 48 BrowseQuery
48 { lookupProtocol = PROTO_UNSPEC 49 { lookupProtocol = PROTO_UNSPEC