WIP: "lan" command to announce this Tox node on the lan.

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
     , toxkeys           :: TVar Tox.AnnouncedKeys
     , userkeys          :: TVar [(SecretKey,PublicKey)]
     , roster            :: Tox.ContactInfo
+    , announceToLan     :: IO ()
     , sessions          :: TVar [PerSession]
     , connectionManager :: Maybe ConnectionManager
     , onionRouter       :: OnionRouter
@@ -469,6 +470,7 @@ clientSession s@Session{..} sock cnum h = do
             , ["threads"]
             , ["mem"]
             , ["nid"]
+            , ["lan"]
             , ["ls"]
             , ["k"]
             , ["roster"]
@@ -574,6 +576,10 @@ clientSession s@Session{..} sock cnum h = do
                                     Right nid -> show nid ++ " nospam:" ++ drop 64 s
                             Right nid -> show nid
 
+        ("lan", _)  -> cmd0 $ do
+                        announceToLan
+                        hPutClient h "ok"
+
         ("ls", _) | Just DHT{dhtBuckets} <- Map.lookup netname dhts
                     -> cmd0 $ do
                         bkts <- atomically $ readTVar dhtBuckets
@@ -1640,6 +1646,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                 , toxkeys           = keysdb
                 , userkeys          = toxids
                 , roster            = rstr
+                , announceToLan     = fromMaybe (return ()) $ Tox.toxAnnounceToLan <$> mbtox
                 , sessions          = sessions
                 , connectionManager = ConnectionManager <$> mconns
                 , 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)
 -- low-level 'Transport' that can be transformed for higher-level protocols
 -- using 'layerTransport'.
 udpTransport :: SockAddr -> IO (Transport err SockAddr ByteString)
-udpTransport bind_address = do
+udpTransport bind_address = fst <$> udpTransport' bind_address
+
+-- | Like 'udpTransport' except also returns the raw socket (for broadcast use).
+udpTransport' :: SockAddr -> IO (Transport err SockAddr ByteString, Socket)
+udpTransport' bind_address = do
   let family = sockAddrFamily bind_address
   sock <- socket family Datagram defaultProtocol
   when (family == AF_INET6) $ do
     setSocketOption sock IPv6Only 0
+  setSocketOption sock Broadcast 1
   bind sock bind_address
-  return Transport
-    { awaitMessage = \kont -> do
+  let tr = Transport {
+      awaitMessage = \kont -> do
         r <- handle (ignoreEOF $ Just $ Right (B.empty, SockAddrInet 0 0)) $ do
                 Just . Right <$!> B.recvFrom sock udpBufferSize
         kont $! r
@@ -547,3 +552,4 @@ udpTransport bind_address = do
         _ -> \addr bs -> saferSendTo sock bs addr
     , closeTransport = close sock
     }
+  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
     , toxTokens         :: TVar SessionTokens
     , toxAnnouncedKeys  :: TVar Onion.AnnouncedKeys
     , toxOnionRoutes    :: OnionRouter
-    , toxContactInfo         :: ContactInfo
+    , toxContactInfo    :: ContactInfo
+    , toxAnnounceToLan  :: IO ()
     }
 
 -- | initiate a netcrypto session, blocking
@@ -315,7 +316,7 @@ newTox :: TVar Onion.AnnouncedKeys   -- ^ Store of announced keys we are a rende
        -> Maybe SecretKey            -- ^ Optional DHT secret key to use.
        -> IO Tox
 newTox keydb addr mbSessionsState suppliedDHTKey = do
-    udp <- {- addVerbosity <$> -} udpTransport addr
+    (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr
     (crypto0,sessionsState0) <- case mbSessionsState of
                                  Nothing -> do
                                     crypto <- newCrypto
@@ -374,6 +375,7 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
         , toxAnnouncedKeys  = keydb
         , toxOnionRoutes    = orouter
         , toxContactInfo    = roster
+        , toxAnnounceToLan  = announceToLan sock (key2id $ transportPublic crypto)
         }
 
 onionTimeout :: Tox -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int)
@@ -392,3 +394,12 @@ forkTox tox = do
            , bootstrap (DHT.refresher6 $ toxRouting tox)
            )
 
+-- TODO: Don't export this.
+announceToLan :: Socket -> NodeId -> IO ()
+announceToLan sock nid = do
+    (broadcast_info:_) <- getAddrInfo (Just defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram })
+                                      (Just "192.168.1.255") -- TODO: Detect broadcast address.
+                                      (Just "33445")
+    let broadcast = addrAddress broadcast_info
+        bs = S.runPut $ DHT.putMessage (DHT.DHTLanDiscovery nid)
+    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
     , decrypt
     , dhtMessageType
     , asymNodeInfo
+    , putMessage -- Convenient for serializing DHTLanDiscovery
     ) where
 
 import Network.Tox.NodeId