diff options
-rw-r--r-- | examples/dhtd.hs | 7 | ||||
-rw-r--r-- | src/Network/QueryResponse.hs | 12 | ||||
-rw-r--r-- | src/Network/Tox.hs | 15 | ||||
-rw-r--r-- | src/Network/Tox/DHT/Transport.hs | 1 |
4 files changed, 30 insertions, 5 deletions
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 57ee8deb..bb491bfc 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -395,6 +395,7 @@ data Session = Session | |||
395 | , toxkeys :: TVar Tox.AnnouncedKeys | 395 | , toxkeys :: TVar Tox.AnnouncedKeys |
396 | , userkeys :: TVar [(SecretKey,PublicKey)] | 396 | , userkeys :: TVar [(SecretKey,PublicKey)] |
397 | , roster :: Tox.ContactInfo | 397 | , roster :: Tox.ContactInfo |
398 | , announceToLan :: IO () | ||
398 | , sessions :: TVar [PerSession] | 399 | , sessions :: TVar [PerSession] |
399 | , connectionManager :: Maybe ConnectionManager | 400 | , connectionManager :: Maybe ConnectionManager |
400 | , onionRouter :: OnionRouter | 401 | , onionRouter :: OnionRouter |
@@ -469,6 +470,7 @@ clientSession s@Session{..} sock cnum h = do | |||
469 | , ["threads"] | 470 | , ["threads"] |
470 | , ["mem"] | 471 | , ["mem"] |
471 | , ["nid"] | 472 | , ["nid"] |
473 | , ["lan"] | ||
472 | , ["ls"] | 474 | , ["ls"] |
473 | , ["k"] | 475 | , ["k"] |
474 | , ["roster"] | 476 | , ["roster"] |
@@ -574,6 +576,10 @@ clientSession s@Session{..} sock cnum h = do | |||
574 | Right nid -> show nid ++ " nospam:" ++ drop 64 s | 576 | Right nid -> show nid ++ " nospam:" ++ drop 64 s |
575 | Right nid -> show nid | 577 | Right nid -> show nid |
576 | 578 | ||
579 | ("lan", _) -> cmd0 $ do | ||
580 | announceToLan | ||
581 | hPutClient h "ok" | ||
582 | |||
577 | ("ls", _) | Just DHT{dhtBuckets} <- Map.lookup netname dhts | 583 | ("ls", _) | Just DHT{dhtBuckets} <- Map.lookup netname dhts |
578 | -> cmd0 $ do | 584 | -> cmd0 $ do |
579 | bkts <- atomically $ readTVar dhtBuckets | 585 | bkts <- atomically $ readTVar dhtBuckets |
@@ -1640,6 +1646,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do | |||
1640 | , toxkeys = keysdb | 1646 | , toxkeys = keysdb |
1641 | , userkeys = toxids | 1647 | , userkeys = toxids |
1642 | , roster = rstr | 1648 | , roster = rstr |
1649 | , announceToLan = fromMaybe (return ()) $ Tox.toxAnnounceToLan <$> mbtox | ||
1643 | , sessions = sessions | 1650 | , sessions = sessions |
1644 | , connectionManager = ConnectionManager <$> mconns | 1651 | , connectionManager = ConnectionManager <$> mconns |
1645 | , onionRouter = orouter | 1652 | , onionRouter = orouter |
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs index 0345dd88..4f65b886 100644 --- a/src/Network/QueryResponse.hs +++ b/src/Network/QueryResponse.hs | |||
@@ -519,14 +519,19 @@ saferSendTo sock bs saddr = void (B.sendTo sock bs saddr) | |||
519 | -- low-level 'Transport' that can be transformed for higher-level protocols | 519 | -- low-level 'Transport' that can be transformed for higher-level protocols |
520 | -- using 'layerTransport'. | 520 | -- using 'layerTransport'. |
521 | udpTransport :: SockAddr -> IO (Transport err SockAddr ByteString) | 521 | udpTransport :: SockAddr -> IO (Transport err SockAddr ByteString) |
522 | udpTransport bind_address = do | 522 | udpTransport bind_address = fst <$> udpTransport' bind_address |
523 | |||
524 | -- | Like 'udpTransport' except also returns the raw socket (for broadcast use). | ||
525 | udpTransport' :: SockAddr -> IO (Transport err SockAddr ByteString, Socket) | ||
526 | udpTransport' bind_address = do | ||
523 | let family = sockAddrFamily bind_address | 527 | let family = sockAddrFamily bind_address |
524 | sock <- socket family Datagram defaultProtocol | 528 | sock <- socket family Datagram defaultProtocol |
525 | when (family == AF_INET6) $ do | 529 | when (family == AF_INET6) $ do |
526 | setSocketOption sock IPv6Only 0 | 530 | setSocketOption sock IPv6Only 0 |
531 | setSocketOption sock Broadcast 1 | ||
527 | bind sock bind_address | 532 | bind sock bind_address |
528 | return Transport | 533 | let tr = Transport { |
529 | { awaitMessage = \kont -> do | 534 | awaitMessage = \kont -> do |
530 | r <- handle (ignoreEOF $ Just $ Right (B.empty, SockAddrInet 0 0)) $ do | 535 | r <- handle (ignoreEOF $ Just $ Right (B.empty, SockAddrInet 0 0)) $ do |
531 | Just . Right <$!> B.recvFrom sock udpBufferSize | 536 | Just . Right <$!> B.recvFrom sock udpBufferSize |
532 | kont $! r | 537 | kont $! r |
@@ -547,3 +552,4 @@ udpTransport bind_address = do | |||
547 | _ -> \addr bs -> saferSendTo sock bs addr | 552 | _ -> \addr bs -> saferSendTo sock bs addr |
548 | , closeTransport = close sock | 553 | , closeTransport = close sock |
549 | } | 554 | } |
555 | return (tr, sock) | ||
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index b3c4cedc..5d791a8a 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs | |||
@@ -240,7 +240,8 @@ data Tox = Tox | |||
240 | , toxTokens :: TVar SessionTokens | 240 | , toxTokens :: TVar SessionTokens |
241 | , toxAnnouncedKeys :: TVar Onion.AnnouncedKeys | 241 | , toxAnnouncedKeys :: TVar Onion.AnnouncedKeys |
242 | , toxOnionRoutes :: OnionRouter | 242 | , toxOnionRoutes :: OnionRouter |
243 | , toxContactInfo :: ContactInfo | 243 | , toxContactInfo :: ContactInfo |
244 | , toxAnnounceToLan :: IO () | ||
244 | } | 245 | } |
245 | 246 | ||
246 | -- | initiate a netcrypto session, blocking | 247 | -- | initiate a netcrypto session, blocking |
@@ -315,7 +316,7 @@ newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rende | |||
315 | -> Maybe SecretKey -- ^ Optional DHT secret key to use. | 316 | -> Maybe SecretKey -- ^ Optional DHT secret key to use. |
316 | -> IO Tox | 317 | -> IO Tox |
317 | newTox keydb addr mbSessionsState suppliedDHTKey = do | 318 | newTox keydb addr mbSessionsState suppliedDHTKey = do |
318 | udp <- {- addVerbosity <$> -} udpTransport addr | 319 | (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr |
319 | (crypto0,sessionsState0) <- case mbSessionsState of | 320 | (crypto0,sessionsState0) <- case mbSessionsState of |
320 | Nothing -> do | 321 | Nothing -> do |
321 | crypto <- newCrypto | 322 | crypto <- newCrypto |
@@ -374,6 +375,7 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do | |||
374 | , toxAnnouncedKeys = keydb | 375 | , toxAnnouncedKeys = keydb |
375 | , toxOnionRoutes = orouter | 376 | , toxOnionRoutes = orouter |
376 | , toxContactInfo = roster | 377 | , toxContactInfo = roster |
378 | , toxAnnounceToLan = announceToLan sock (key2id $ transportPublic crypto) | ||
377 | } | 379 | } |
378 | 380 | ||
379 | onionTimeout :: Tox -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int) | 381 | onionTimeout :: Tox -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int) |
@@ -392,3 +394,12 @@ forkTox tox = do | |||
392 | , bootstrap (DHT.refresher6 $ toxRouting tox) | 394 | , bootstrap (DHT.refresher6 $ toxRouting tox) |
393 | ) | 395 | ) |
394 | 396 | ||
397 | -- TODO: Don't export this. | ||
398 | announceToLan :: Socket -> NodeId -> IO () | ||
399 | announceToLan sock nid = do | ||
400 | (broadcast_info:_) <- getAddrInfo (Just defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }) | ||
401 | (Just "192.168.1.255") -- TODO: Detect broadcast address. | ||
402 | (Just "33445") | ||
403 | let broadcast = addrAddress broadcast_info | ||
404 | bs = S.runPut $ DHT.putMessage (DHT.DHTLanDiscovery nid) | ||
405 | saferSendTo sock bs broadcast | ||
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index 51ec2e80..7af8d408 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs | |||
@@ -30,6 +30,7 @@ module Network.Tox.DHT.Transport | |||
30 | , decrypt | 30 | , decrypt |
31 | , dhtMessageType | 31 | , dhtMessageType |
32 | , asymNodeInfo | 32 | , asymNodeInfo |
33 | , putMessage -- Convenient for serializing DHTLanDiscovery | ||
33 | ) where | 34 | ) where |
34 | 35 | ||
35 | import Network.Tox.NodeId | 36 | import Network.Tox.NodeId |