5 files changed, 46 insertions, 20 deletions

diff --git a/OnionRouter.hs b/OnionRouter.hs
index 7a48aaab..40112e6a 100644
--- a/OnionRouter.hs
+++ b/OnionRouter.hs
@@ -33,21 +33,21 @@ newtype RouteId = RouteId Int
  deriving Show
 
 data OnionRouter = OnionRouter
-    { pendingQueries :: TVar (Word64Map NodeId)
-    , routeMap :: TVar (IntMap RouteRecord)
+    { pendingQueries  :: TVar (Word64Map NodeId) -- TODO: routeNonce belongs here instead of in routeMap, or just remove routeNonce and use transaction nonce.
+    , routeMap        :: TVar (IntMap RouteRecord)
     , trampolineNodes :: TVar (IntMap NodeInfo)
-    , trampolineIds :: TVar (HashMap NodeId Int)
+    , trampolineIds   :: TVar (HashMap NodeId Int)
     , trampolineCount :: TVar Int
-    , onionDRG :: TVar ChaChaDRG
-    , routeThread :: ThreadId
-    , pendingRoutes :: IntMap (TVar Bool)
-    , routeLog :: TChan String
+    , onionDRG        :: TVar ChaChaDRG
+    , routeThread     :: ThreadId
+    , pendingRoutes   :: IntMap (TVar Bool)
+    , routeLog        :: TChan String
     }
 
 data RouteRecord = RouteRecord
     { storedRoute :: OnionRoute
-    , responseCount :: Int
-    , timeoutCount :: Int
+    , responseCount :: !Int
+    , timeoutCount :: !Int
     }
 
 -- Onion paths have different timeouts depending on whether the path is
@@ -230,7 +230,8 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                         [ "ONION trampolines:   " ++ show ts
                         , "ONION query results: " ++ show nodes ]
                     case nodes of
-                        [a,b,c] -> do -- | distinct3by nodeClass a b c -> do
+                        [a,b,c] | distinct3by nodeClass a b c -> do
+                            atomically $ writeTChan (routeLog or) $ unwords [ "ONION using route:", show $ nodeAddr a, show $ nodeAddr b, show $ nodeAddr c]
                             return $ Just OnionRoute
                                 { routeNonce = n24
                                 , routeAliasA = asec
@@ -240,6 +241,9 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                                 , routeNodeB = b
                                 , routeNodeC = c
                                 }
+                        [a,b,c] -> do
+                            atomically $ writeTChan (routeLog or) $ unwords [ "ONION Discarding insecure route:", show $ nodeAddr a, show $ nodeAddr b, show $ nodeAddr c]
+                            return Nothing
                         _ -> return Nothing
         writeTVar (onionDRG or) drg'
         return $ getr
diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index 0df06054..6660fc13 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -93,7 +93,7 @@ instance Data Auth where
     -- Well, this is a little wonky... XXX
     gunfold k z c = k (z (Auth . Poly1305.Auth . (BA.convert :: ByteString -> Bytes)))
     toConstr _ = con_Auth
-    dataTypeOf _ = mkDataType "ToxCrypto" [con_Auth]
+    dataTypeOf _ = mkDataType "Crypto.Tox" [con_Auth]
 con_Auth :: Constr
 con_Auth = mkConstr (dataTypeOf (Auth (error "con_Auth"))) "Auth" [] Prefix
 instance Serialize Auth where
@@ -340,6 +340,8 @@ newtype SymmetricKey = SymmetricKey ByteString
 data TransportCrypto = TransportCrypto
     { transportSecret :: SecretKey
     , transportPublic :: PublicKey
+    , onionAliasSecret :: SecretKey
+    , onionAliasPublic :: PublicKey
     , transportSymmetric :: STM SymmetricKey
     , transportNewNonce :: STM Nonce24
     }
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 70d981e2..27c89674 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -187,6 +187,9 @@ data Client err meth tid addr x = forall tbl. Client
       -- | An action yielding this client\'s own address.  It is invoked once
       -- on each outbound and inbound packet.  It is valid for this to always
       -- return the same value.
+      --
+      -- The argument, if supplied, is the remote address for the transaction.
+      -- This can be used to maintain consistent aliases for specific peers.
     , clientAddress :: Maybe addr -> IO addr
       -- | Transform a query /tid/ value to an appropriate response /tid/
       -- value.  Normally, this would be the identity transformation, but if
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 3860d309..51ee0a4d 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -100,7 +100,9 @@ import Data.Word64Map (fitsInInt)
 newCrypto :: IO TransportCrypto
 newCrypto = do
     secret <- generateSecretKey
+    alias <- generateSecretKey
     let pubkey = toPublic secret
+        aliaspub = toPublic alias
     (symkey, drg) <- do
         drg0 <- getSystemDRG
         return $ randomBytesGenerate 32 drg0 :: IO (ByteString, SystemDRG)
@@ -111,6 +113,8 @@ newCrypto = do
     return TransportCrypto
         { transportSecret = secret
         , transportPublic = pubkey
+        , onionAliasSecret = alias
+        , onionAliasPublic = aliaspub
         , transportSymmetric = return $ SymmetricKey symkey
         , transportNewNonce = do
             drg1 <- readTVar noncevar
@@ -205,6 +209,7 @@ data Tox = Tox
     , toxOnionRoutes :: OnionRouter
     }
 
+isLocalHost :: SockAddr -> Bool
 isLocalHost (SockAddrInet _ host32) = (fromBE32 host32 == 0x7f000001)
 isLocalHost _                       = False
 
@@ -227,6 +232,14 @@ newKeysDatabase :: IO (TVar Onion.AnnouncedKeys)
 newKeysDatabase =
     atomically $ newTVar $ Onion.AnnouncedKeys PSQ.empty MinMaxPSQ.empty
 
+
+getOnionAlias :: TransportCrypto -> STM NodeInfo -> Maybe (Onion.OnionDestination r) -> IO (Onion.OnionDestination r)
+getOnionAlias crypto dhtself remoteNode = atomically $ do
+    ni <- dhtself
+    let alias = ni { nodeId = key2id (onionAliasPublic crypto) }
+    return $ Onion.OnionDestination alias Nothing
+
+
 newTox :: TVar Onion.AnnouncedKeys -> SockAddr -> IO Tox
 newTox keydb addr = do
     udp <- addVerbosity <$> udpTransport addr
@@ -249,10 +262,7 @@ newTox keydb addr = do
     oniondrg <- drgNew
     let onionnet = layerTransport (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt
     onionclient <- newClient oniondrg onionnet Onion.classify
-                    (const $ atomically
-                           $ flip Onion.OnionDestination Nothing
-                           . R.thisNode
-                           <$> readTVar (DHT.routing4 routing))
+                    (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 routing))
                     (Onion.handlers onionnet routing toks keydb)
                     (hookQueries orouter DHT.transactionKey)
                     (const id)
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index b5ac748a..eabd9473 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -457,7 +457,7 @@ peelOnion :: Serialize (Addressed (Forwarding n t))
               -> Forwarding (S n) t
               -> Either String (Addressed (Forwarding n t))
 peelOnion crypto nonce (Forwarding k fwd) =
-    fmap runIdentity $ uncomposed $ decryptMessage crypto nonce (Right $ Assym k nonce fwd)
+    fmap runIdentity $ uncomposed $ decryptMessage (dhtKey crypto) nonce (Right $ Assym k nonce fwd)
 
 handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (ReturnPath n)) => proxy (S n) -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionResponse (S n) -> IO a
 handleOnionResponse proxy crypto saddr udp kont (OnionResponse path msg) = do
@@ -576,7 +576,7 @@ encrypt crypto msg rpath = ( transcode ( (. (runIdentity . either id assymData))
                                        msg
                            , rpath)
     where
-        skey = transportSecret crypto
+        skey = fst $ aliasKey crypto rpath
 
         -- The OnionToMe case shouldn't happen, but we'll use our own public
         -- key in this situation.
@@ -592,14 +592,21 @@ encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain
 
 decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination r -> Either String (OnionMessage Identity, OnionDestination r)
 decrypt crypto msg addr = do
-    msg <- sequenceMessage $ transcode (\n -> decryptMessage crypto n . left (senderkey addr)) msg
+    msg <- sequenceMessage $ transcode (\n -> decryptMessage (aliasKey crypto addr) n . left (senderkey addr)) msg
     Right (msg, addr)
 
 senderkey :: OnionDestination r -> t -> (Maybe PublicKey, t)
 senderkey addr e = (onionKey addr, e)
 
+aliasKey :: TransportCrypto -> OnionDestination r -> (SecretKey,PublicKey)
+aliasKey crypto (OnionToOwner {})     = (transportSecret &&& transportPublic) crypto
+aliasKey crypto (OnionDestination {}) = (onionAliasSecret &&& onionAliasPublic) crypto
+
+dhtKey :: TransportCrypto -> (SecretKey,PublicKey)
+dhtKey crypto = (transportSecret &&& transportPublic) crypto
+
 decryptMessage :: Serialize x =>
-                  TransportCrypto
+                  (SecretKey,PublicKey)
                   -> Nonce24
                   -> Either (Maybe PublicKey, Encrypted x)
                             (Assym (Encrypted x))
@@ -609,7 +616,7 @@ decryptMessage crypto n arg
     | otherwise              = Composed $ Left "decryptMessage: Unknown sender"
  where
     msecret  = do sender <- mkey
-                  Just $ computeSharedSecret (transportSecret crypto) sender n
+                  Just $ computeSharedSecret (fst crypto) sender n
     (mkey,e) = either id (Just . senderKey &&& assymData) arg
     plain    = Composed . fmap Identity . (>>= decodePlain)