7 files changed, 117 insertions, 49 deletions

diff --git a/OnionRouter.hs b/OnionRouter.hs
index 289dc7f4..26bc6525 100644
--- a/OnionRouter.hs
+++ b/OnionRouter.hs
@@ -31,9 +31,6 @@ import Network.Socket
 import System.Endian
 import System.IO
 
-newtype RouteId = RouteId Int
- deriving Show
-
 -- Toxcore saves a maximum of 12 paths: 6 paths are reserved for announcing
 -- ourselves and 6 others are used to search for friends.
 --
@@ -210,8 +207,8 @@ randomIvalInteger (l,h) rng
 selectTrampolines :: OnionRouter -> STM [NodeInfo]
 selectTrampolines or = do
     cnt <- readTVar (trampolineCount or)
-    drg0 <- readTVar (onionDRG or)
     ts <- readTVar (trampolineNodes or)
+    drg0 <- readTVar (onionDRG or)
     let (a, drg1) = randomR (0,cnt - 1) drg0
         (b0, drg2) = randomR (0,cnt - 2) drg1
         (c0, drg ) = randomR (0,cnt - 3) drg2
@@ -289,29 +286,6 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
         Just _  -> hPutStrLn stderr $ "ONION Finished RouteId " ++ show rid
         Nothing -> hPutStrLn stderr $ "ONION Failed RouteId " ++ show rid
 
--- We used to derive the RouteId from the Nonce8 associated with the query.
--- This is problematic because a nonce generated by toxcore will not validate
--- if it is received via a different route than it was issued.  This is
--- described by the Tox spec:
---
---   Toxcore generates `ping_id`s by taking a 32 byte sha hash of the current
---   time, some secret bytes generated when the instance is created, the
---   current time divided by a 20 second timeout, the public key of the
---   requester and the source ip/port that the packet was received from. Since
---   the ip/port that the packet was received from is in the `ping_id`, the
---   announce packets being sent with a ping id must be sent using the same
---   path as the packet that we received the `ping_id` from or announcing will
---   fail.
---
--- The original idea was:
---
--- > routeId :: Nonce8 -> RouteId
--- > routeId (Nonce8 w8) = RouteId $ mod (fromIntegral w8) 12
---
--- Instead, we'll just hash the destination node id.
-routeId :: NodeId -> RouteId
-routeId nid = RouteId $ mod (hash nid) 12
-
 lookupSender :: OnionRouter -> SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId))
 lookupSender or saddr (Nonce8 w8) = do
     result <- atomically $ do
diff --git a/Roster.hs b/Roster.hs
index 94ab462d..ab2f9911 100644
--- a/Roster.hs
+++ b/Roster.hs
@@ -1,13 +1,15 @@
 {-# LANGUAGE NamedFieldPuns #-}
 module Roster where
 
-import Crypto.PubKey.Curve25519
-import Network.Tox.Onion.Transport as Onion
-import Network.Tox.DHT.Transport as DHT
-import Network.Tox.NodeId
+import System.IO
+import Control.Monad
 import Control.Concurrent.STM
+import Crypto.PubKey.Curve25519
 import qualified Data.HashMap.Strict as HashMap
-import Data.HashMap.Strict (HashMap)
+         ;import Data.HashMap.Strict (HashMap)
+import Network.Tox.DHT.Transport     as DHT
+import Network.Tox.NodeId
+import Network.Tox.Onion.Transport   as Onion
 
 newtype Roster = Roster { accounts :: TVar (HashMap NodeId Account) }
 
@@ -32,6 +34,7 @@ delRoster (Roster as) pk = modifyTVar' as $ HashMap.delete (key2id pk)
 
 updateRoster :: Roster -> Onion.AnnouncedRendezvous -> (PublicKey,Onion.OnionData) -> IO ()
 updateRoster roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg) = do
+    hPutStrLn stderr "updateRoster!!!"
     atomically $ do
         as <- readTVar (accounts roster)
         maybe (return ())
@@ -53,3 +56,19 @@ updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do
 updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
     -- TODO
     return ()
+
+dnsPresentation :: Roster -> STM String
+dnsPresentation (Roster accsvar) = do
+    accs <- readTVar accsvar
+    ms <- forM accs $ \Account { userSecret = sec, contacts = cvar } -> do
+        cs <- readTVar cvar
+        return $
+            "; local key = " ++ show (key2id $ toPublic sec) ++ "\n"
+             ++ concatMap dnsPresentation1 (HashMap.toList cs)
+    return $ concat ms
+
+dnsPresentation1 :: (NodeId,DHTPublicKey) -> String
+dnsPresentation1 (nid,dk) = unlines
+    [ concat [ show nid, ".tox. IN CNAME ", show (key2id $ dhtpk dk), ".dht." ]
+    ]
+
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index cf0328e8..4dad2fe7 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -430,6 +430,7 @@ clientSession s@Session{..} sock cnum h = do
                             forM pairs $ \(_,pk) -> delRoster roster pk
                             readTVar userkeys
                         hPutClient h . showReport $ map mkrow ks
+        ("roster", s) -> cmd0 $ atomically (dnsPresentation roster) >>= hPutClient h
         ("g", s) | Just DHT{..} <- Map.lookup netname dhts
                     -> cmd0 $ do
                         -- arguments: method
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 93e3c663..29591a23 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -247,12 +247,12 @@ addVerbosity :: Transport err SockAddr ByteString -> Transport err SockAddr Byte
 addVerbosity tr =
     tr { awaitMessage = \kont -> awaitMessage tr $ \m -> do
             forM_ m $ mapM_ $ \(msg,addr) -> do
-                when (isLocalHost addr || not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x82,0x8c,0x8d])) $ do
+                when (not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x82,0x8c,0x8d])) $ do
                     mapM_ (\x -> hPutStrLn stderr ( (show addr) ++ " --> " ++ x))
                           $ xxd 0 msg
             kont m
        , sendMessage = \addr msg -> do
-            when (isLocalHost addr || not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x82,0x8c,0x8d])) $ do
+            when (not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x8c,0x8d])) $ do
                 mapM_ (\x -> hPutStrLn stderr ( (show addr) ++ " <-- " ++ x))
                       $ xxd 0 msg
             sendMessage tr addr msg
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs
index 0787c2c1..47505a21 100644
--- a/src/Network/Tox/DHT/Transport.hs
+++ b/src/Network/Tox/DHT/Transport.hs
@@ -210,6 +210,8 @@ data DHTPublicKey = DHTPublicKey
     , dhtpk      :: PublicKey -- dht public key
     , dhtpkNodes :: SendNodes -- other reachable nodes
     }
+ deriving (Eq, Show)
+
 
 -- int8_t (0x20 sent over onion, 0x12 for sent over net_crypto)
 -- [uint32_t nospam][Message (UTF8) 1 to ONION_CLIENT_MAX_DATA_SIZE bytes]
@@ -217,6 +219,7 @@ data FriendRequest = FriendRequest
     { friendNoSpam      :: Word32
     , friendRequestText :: ByteString -- UTF8
     }
+ deriving (Eq, Show)
 
 -- When sent as a DHT request packet (this is the data sent in the DHT request
 -- packet):
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 3eec0390..76908df8 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -117,13 +117,16 @@ dataToRouteH ::
           -> IO ()
 dataToRouteH keydb udp _ (OnionToRoute pub asymm) = do
     let k = key2id pub
+    hPutStrLn stderr $ "dataToRouteH "++ show k
     mb <- atomically $ do
         ks <- readTVar keydb
         forM (MinMaxPSQ.lookup' k (keyAssoc ks)) $ \(p,(cnt,rpath)) -> do
             writeTVar keydb $ ks { keyAssoc = MinMaxPSQ.insert' k (cnt + 1, rpath) p (keyAssoc ks) }
             return rpath
+    hPutStrLn stderr $ "dataToRouteH "++ show (fmap (const ()) mb)
     forM_ mb $ \rpath -> do
         -- forward
+        hPutStrLn stderr $ "dataToRouteH sendMessage"
         sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse asymm
         hPutStrLn stderr $ "Forwarding data-to-route -->"++show k
 
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 6635fad1..85cf095d 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -44,6 +44,8 @@ module Network.Tox.Onion.Transport
     , onionKey
     , onionAliasSelector
     , selectAlias
+    , RouteId(..)
+    , routeId
     ) where
 
 import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
@@ -51,7 +53,7 @@ import Network.QueryResponse
 import Crypto.Tox hiding (encrypt,decrypt)
 import Network.Tox.NodeId
 import qualified Crypto.Tox as ToxCrypto
-import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,FriendRequest,asymNodeInfo)
+import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey(..),FriendRequest,asymNodeInfo)
 
 import Control.Applicative
 import Control.Arrow
@@ -76,6 +78,7 @@ import GHC.TypeLits
 import Network.Socket
 import System.IO
 import qualified Text.ParserCombinators.ReadP as RP
+import Data.Hashable
 
 type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
 
@@ -200,15 +203,44 @@ putOnionMsg (OnionToRoute pubkey          a) = putOnionAsymm 0x85 (putPublicKey
 putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x
 putOnionMsg (OnionToRouteResponse         a) = putOnionAsymm 0x86 (return ()) a
 
-encodeOnionAddr :: (NodeInfo -> r -> IO (Maybe OnionRoute))
-                   -> (OnionMessage Encrypted,OnionDestination r)
+newtype RouteId = RouteId Int
+ deriving Show
+
+
+-- We used to derive the RouteId from the Nonce8 associated with the query.
+-- This is problematic because a nonce generated by toxcore will not validate
+-- if it is received via a different route than it was issued.  This is
+-- described by the Tox spec:
+--
+--   Toxcore generates `ping_id`s by taking a 32 byte sha hash of the current
+--   time, some secret bytes generated when the instance is created, the
+--   current time divided by a 20 second timeout, the public key of the
+--   requester and the source ip/port that the packet was received from. Since
+--   the ip/port that the packet was received from is in the `ping_id`, the
+--   announce packets being sent with a ping id must be sent using the same
+--   path as the packet that we received the `ping_id` from or announcing will
+--   fail.
+--
+-- The original idea was:
+--
+-- > routeId :: Nonce8 -> RouteId
+-- > routeId (Nonce8 w8) = RouteId $ mod (fromIntegral w8) 12
+--
+-- Instead, we'll just hash the destination node id.
+routeId :: NodeId -> RouteId
+routeId nid = RouteId $ mod (hash nid) 12
+
+
+encodeOnionAddr :: (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
+                   -> (OnionMessage Encrypted,OnionDestination RouteId)
                    -> IO (Maybe (ByteString, SockAddr))
 encodeOnionAddr _ (msg,OnionToOwner ni p) =
     return $ Just ( runPut $ putResponse (OnionResponse p msg)
                   , nodeAddr ni )
-encodeOnionAddr _ (msg,OnionDestination _ _ Nothing) = do
-    hPutStrLn stderr $ "ONION encode missing routeid"
-    return Nothing
+encodeOnionAddr getRoute (msg,OnionDestination x ni Nothing) = do
+    encodeOnionAddr getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
+    -- hPutStrLn stderr $ "ONION encode missing routeid"
+    -- return Nothing
 encodeOnionAddr getRoute (msg,OnionDestination _ ni (Just rid)) = do
     let go route = do
             return ( runPut $ putRequest $ wrapForRoute msg ni route
@@ -601,6 +633,7 @@ data OnionData
     --
     --
     OnionFriendRequest FriendRequest -- 0x20
+ deriving (Eq,Show)
 
 instance Sized OnionData where
     size = VarSize $ \case
@@ -790,26 +823,46 @@ parseDataToRoute
     :: TransportCrypto
          -> (OnionMessage Encrypted,OnionDestination r)
          -> IO (Either ((PublicKey,OnionData),AnnouncedRendezvous) (OnionMessage Encrypted, OnionDestination r))
-parseDataToRoute crypto (OnionToRouteResponse dta, od) =
-    return $ either (const $ Right (OnionToRouteResponse dta,od)) Left $ do
-        -- XXX: Do something with decryption failure?
-        dtr <- fmap runIdentity
+parseDataToRoute crypto (OnionToRouteResponse dta, od) = do
+  ks <- atomically $ readTVar $ userKeys crypto
+
+  let eOuter = do
+        fmap runIdentity
                  $ uncomposed
                  $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto)
                                   (asymmNonce dta)
-                                  (Right dta)
-        let (sk,pk) = case onionAliasSelector od of
-                SearchingAlias        -> (onionAliasSecret &&& onionAliasPublic) crypto
-                AnnouncingAlias sk pk -> (sk,pk)
+                                  (Right dta) -- using Asymm{senderKey} as remote key
+
+      -- TODO: We don't currently have a way to look up which user key we
+      -- announced using along this onion route.  Therefore, for now, we will
+      -- try all our user keys to see if any can decrypt the packet.
+      eInners = flip map ks $ \(sk,pk) -> do
+        dtr <- eOuter
         omsg <- fmap runIdentity
                 $ uncomposed
                 $ decryptMessage (sk,pk)
                                  (asymmNonce dta)
                                  (Left (dataFromKey dtr, dataToRoute dtr))
+        return (pk,dtr,omsg)
+
+      eInner = foldr1 (<|>) eInners
+
+      e = do
+        (pk,dtr,omsg) <- eInner
         return ( (pk, omsg)
                , AnnouncedRendezvous
                     (dataFromKey dtr)
                     $ Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od )
+      r = either (const $ Right (OnionToRouteResponse dta,od)) Left e
+  -- parseDataToRoute OnionToRouteResponse decipherAndAuth: auth fail
+  hPutStrLn stderr $ unlines
+        [ "parseDataToRoute " ++ either id (const "Right") e
+        , "       crypto inner.me =" ++ either id (\(pk,_,_) -> show $ key2id pk) eInner
+        , "              inner.you=" ++ either id (show . key2id . dataFromKey) eOuter
+        , "              outer.me =" ++ show (key2id $ rendezvousPublic crypto)
+        , "              outer.you=" ++ show (key2id $ senderKey dta)
+        ]
+  return r
 parseDataToRoute _ msg = return $ Right msg
 
 encodeDataToRoute :: TransportCrypto
@@ -825,7 +878,22 @@ encodeDataToRoute crypto ((me,omsg), AnnouncedRendezvous toxid (Rendezvous pub n
                             , dataToRoute = encryptMessage sk toxid nonce omsg
                             }
     let dta = encryptMessage (onionAliasSecret crypto) pub nonce plain
-    return $ Just ( OnionToRoute pub -- Public key of destination node
+    hPutStrLn stderr $ unlines
+        [ "encodeDataToRoute    me=" ++ show (key2id me)
+        , "                  dhtpk=" ++ case omsg of
+                                        OnionDHTPublicKey dmsg -> show (key2id $ dhtpk dmsg)
+                                        OnionFriendRequest fr  -> "friend request"
+        , "                     ns=" ++ case omsg of
+                                        OnionDHTPublicKey dmsg -> show (dhtpkNodes dmsg)
+                                        OnionFriendRequest fr  -> "friend request"
+        , "       crypto inner.me =" ++ show (key2id pk)
+        , "              inner.you=" ++ show (key2id toxid)
+        , "              outer.me =" ++ show (key2id $ onionAliasPublic crypto)
+        , "              outer.you=" ++ show (key2id pub)
+        , "                  " ++ show (AnnouncedRendezvous toxid (Rendezvous pub ni))
+        , "                  " ++ show dta
+        ]
+    return $ Just ( OnionToRoute toxid -- Public key of destination node
                                  Asymm { senderKey  = onionAliasPublic crypto
                                        , asymmNonce = nonce
                                        , asymmData  = dta