Share toxid over avahi

This isn't really completely correct; there should be some possibility for
denial of service. The call to setContactAddr is destructive of whatever
information was there previously, but we haven't verified that we're talking to
the real contact at the time it is called.

This problem exists even in the ordinary path where the nodeinfocallback isn't
really requiring proof of anything before throwing out data.

1 files changed, 22 insertions, 17 deletions

diff --git a/src/Network/Tox/Avahi.hs b/src/Network/Tox/Avahi.hs
index 7fe87db2..559e5fd7 100644
--- a/src/Network/Tox/Avahi.hs
+++ b/src/Network/Tox/Avahi.hs
@@ -1,16 +1,18 @@
+{-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns    #-}
 module Network.Tox.Avahi
   ( module Network.Tox.Avahi
   , NodeInfo(..)
-  , NodeId(..)
+  , NodeId
   ) where
 
-import           Data.Foldable
-import           Network.Address
-import           Network.Avahi
-import           Network.Tox.NodeId
-import           Text.Read
+import Control.Applicative
+import Data.Foldable
+import Network.Address
+import Network.Avahi
+import Network.Tox.NodeId
+import Text.Read
 
 toxServiceName :: String
 toxServiceName = "_tox_dht._udp"
@@ -21,8 +23,8 @@ toxServiceDomain = "local"
 (<.>) :: String -> String -> String
 a <.> b = a ++ "." ++ b
 
-toxService :: String -> PortNumber -> NodeId -> Service
-toxService hostname (fromIntegral -> port) (show -> extra) =
+toxService :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> Service
+toxService hostname (fromIntegral -> port) dhtkey toxid =
   Service {
     serviceProtocol = PROTO_UNSPEC,
     serviceName     = "Tox DHT @ " ++ hostname,
@@ -31,16 +33,17 @@ toxService hostname (fromIntegral -> port) (show -> extra) =
     serviceHost     = if null hostname then "" else hostname <.> toxServiceDomain,
     serviceAddress  = Nothing,
     servicePort     = port,
-    serviceText     = extra
+    serviceText     = maybe (show dhtkey) (show . ((,) dhtkey)) toxid
   }
 
-announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> IO ()
-announceToxServiceWithHostname  = ((.).(.).(.)) announce toxService
+announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
+announceToxServiceWithHostname  = (boobs.boobs) announce toxService
+  where boobs = ((.).(.))
 
-announceToxService :: PortNumber -> NodeId -> IO ()
+announceToxService :: PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
 announceToxService = announceToxServiceWithHostname ""
 
-queryToxService :: (NodeInfo -> IO ()) -> IO ()
+queryToxService :: (NodeInfo -> Maybe NodeId -> IO ()) -> IO ()
 queryToxService cb =
   browse $
   BrowseQuery
@@ -50,8 +53,10 @@ queryToxService cb =
   , lookupCallback    = runCallback
   }
   where
-    runCallback x@Service {..} = do
-      let nid = readMaybe serviceText
+    runCallback Service {..} = do
+      let both :: Maybe (NodeId, NodeId)
+          both = readMaybe serviceText
+          nid  = (fst <$> both) <|> readMaybe serviceText
           addr = readMaybe =<< serviceAddress
-          p = fromIntegral servicePort
-      forM_ nid $ \n -> forM_ addr $ \a -> cb (NodeInfo n a p)
+          p    = fromIntegral servicePort
+      forM_ nid $ \n -> forM_ addr $ \a -> cb (NodeInfo n a p) (snd <$> both)