From fad30ffd5cb4ebba085029626f0be255fc8df237 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Tue, 4 Dec 2018 16:16:01 -0500 Subject: Completed TCP getNodes query. --- src/Data/Tox/Relay.hs | 14 +++---- src/Network/Tox.hs | 4 +- src/Network/Tox/Onion/Transport.hs | 73 ++++++++++++++++++++++++++++++++----- src/Network/Tox/Relay.hs | 15 ++++---- src/Network/Tox/TCP.hs | 75 +++++++++++++++++++++++++++++++------- src/Network/Tox/Transport.hs | 2 +- 6 files changed, 143 insertions(+), 40 deletions(-) diff --git a/src/Data/Tox/Relay.hs b/src/Data/Tox/Relay.hs index 1437c9cd..1fe6d256 100644 --- a/src/Data/Tox/Relay.hs +++ b/src/Data/Tox/Relay.hs @@ -45,8 +45,8 @@ data RelayPacket | RelayPong Nonce8 | OOBSend PublicKey ByteString | OOBRecv PublicKey ByteString - | OnionPacket (OnionRequest N0) - | OnionPacketResponse (OnionResponse N1) + | OnionPacket Nonce24 (Addressed (Forwarding N2 (OnionMessage Encrypted))) -- (OnionRequest N0) + | OnionPacketResponse (OnionMessage Encrypted) -- 0x0A through 0x0F reserved for future use. | RelayData ByteString ConId deriving (Eq,Ord,Show,Data) @@ -65,9 +65,9 @@ instance Sized RelayPacket where RelayPong pingid -> 8 OOBSend k bs -> 32 + B.length bs OOBRecv k bs -> 32 + B.length bs - OnionPacket query -> case contramap (`asTypeOf` query) size of - ConstSize n -> n - VarSize f -> f query + OnionPacket n24 query -> 24 + case contramap (`asTypeOf` query) size of + ConstSize n -> n + VarSize f -> f query OnionPacketResponse answer -> case contramap (`asTypeOf` answer) size of ConstSize n -> n VarSize f -> f answer @@ -86,7 +86,7 @@ instance Serialize RelayPacket where 5 -> RelayPong <$> get 6 -> OOBSend <$> getPublicKey <*> (remaining >>= getBytes) 7 -> OOBRecv <$> getPublicKey <*> (remaining >>= getBytes) - 8 -> OnionPacket <$> get + 8 -> OnionPacket <$> get <*> get 9 -> OnionPacketResponse <$> get conid -> (`RelayData` ConId conid) <$> (remaining >>= getBytes) @@ -101,7 +101,7 @@ instance Serialize RelayPacket where RelayPong pingid -> put pingid OOBSend k bs -> putPublicKey k >> putByteString bs OOBRecv k bs -> putPublicKey k >> putByteString bs - OnionPacket query -> put query + OnionPacket n24 query -> put n24 >> put query OnionPacketResponse answer -> put answer RelayData bs _ -> putByteString bs diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index 83a17037..46d87094 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -240,7 +240,7 @@ newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rende -> [String] -- ^ Bind-address to listen on. Must provide at least one. -> ( ContactInfo extra -> SockAddr -> Session -> IO () ) -> Maybe SecretKey -- ^ Optional DHT secret key to use. - -> ( Int -> Onion.OnionResponse Onion.N1 -> IO () ) -- ^ TCP-bound onion responses. + -> ( Int -> Onion.OnionMessage Encrypted -> IO () ) -- ^ TCP-bound onion responses. -> IO (Tox extra) newTox keydb bindspecs onsess suppliedDHTKey tcp = do addrs <- mapM (`getBindAddress` True) bindspecs @@ -262,7 +262,7 @@ newToxOverTransport :: TVar Onion.AnnouncedKeys -> ( ContactInfo extra -> SockAddr -> Session -> IO () ) -> Maybe SecretKey -> Onion.UDPTransport - -> ( Int -> Onion.OnionResponse Onion.N1 -> IO () ) -- ^ TCP-bound onion responses. + -> ( Int -> Onion.OnionMessage Encrypted -> IO () ) -- ^ TCP-bound onion responses. -> IO (Tox extra) newToxOverTransport keydb addr onNewSession suppliedDHTKey udp tcp = do roster <- newContactInfo diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs index 0cb03718..8918f913 100644 --- a/src/Network/Tox/Onion/Transport.hs +++ b/src/Network/Tox/Onion/Transport.hs @@ -44,14 +44,18 @@ module Network.Tox.Onion.Transport , OnionRoute(..) , N0 , N1 + , N2 , N3 , onionKey , onionAliasSelector , selectAlias , RouteId(..) , routeId - , rewrap , putRequest + , wrapForRoute + , wrapSymmetric + , wrapOnion + , wrapOnionPure ) where import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) @@ -91,6 +95,7 @@ import DPut import DebugTag import Data.Word64Map (fitsInInt) import Data.Bits (shiftR,shiftL) +import qualified Rank2 type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a @@ -124,6 +129,26 @@ deriving instance ( Show (f (AnnounceRequest, Nonce8)) , Show (f DataToRoute) ) => Show (OnionMessage f) +instance Data (OnionMessage Encrypted) where + gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt + toConstr _ = error "OnionMessage.toConstr" + gunfold _ _ = error "OnionMessage.gunfold" +#if MIN_VERSION_base(4,2,0) + dataTypeOf _ = mkNoRepType "Network.Tox.Onion.Transport.OnionMessage" +#else + dataTypeOf _ = mkNorepType "Network.Tox.Onion.Transport.OnionMessage" +#endif + +instance Rank2.Functor OnionMessage where + f <$> m = mapPayload (Proxy :: Proxy Serialize) f m + +instance Payload Serialize OnionMessage where + mapPayload _ f (OnionAnnounce a) = OnionAnnounce (fmap f a) + mapPayload _ f (OnionAnnounceResponse n8 n24 a) = OnionAnnounceResponse n8 n24 (f a) + mapPayload _ f (OnionToRoute k a) = OnionToRoute k a + mapPayload _ f (OnionToRouteResponse a) = OnionToRouteResponse a + + msgNonce :: OnionMessage f -> Nonce24 msgNonce (OnionAnnounce a) = asymmNonce a msgNonce (OnionAnnounceResponse _ n24 _) = n24 @@ -274,10 +299,10 @@ encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do return x -forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> UDPTransport +forwardOnions :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> UDPTransport forwardOnions crypto udp sendTCP = udp { awaitMessage = forwardAwait crypto udp sendTCP } -forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionResponse N1 -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a +forwardAwait :: TransportCrypto -> UDPTransport -> (Int -> OnionMessage Encrypted -> IO ()) {- ^ TCP relay send -} -> HandleLo a -> IO a forwardAwait crypto udp sendTCP kont = do fix $ \another -> do awaitMessage udp $ \case @@ -325,6 +350,7 @@ data OnionRequest n = OnionRequest deriving (Eq,Ord) +{- instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n) , Serialize (Forwarding (ThreeMinus n) (OnionMessage Encrypted)) ) => Data (OnionRequest n) where @@ -336,6 +362,8 @@ instance (Typeable n, Sized (ReturnPath n), Serialize (ReturnPath n) #else dataTypeOf _ = mkNorepType "Network.Tox.Onion.Transport.OnionRequest" #endif +-} + instance (Typeable n, Serialize (ReturnPath n)) => Data (OnionResponse n) where gfoldl f z txt = z (either error id . S.decode) `f` S.encode txt @@ -397,7 +425,17 @@ instance (Sized (ReturnPath n)) => Sized (OnionResponse (S n)) where data Addressed a = Addressed { sockAddr :: SockAddr, unaddressed :: a } | TCPIndex { tcpIndex :: Int, unaddressed :: a } - deriving (Eq,Show) + deriving (Eq,Ord,Show) + +instance (Typeable a, Serialize a) => Data (Addressed a) where + gfoldl f z a = z (either error id . S.decode) `f` S.encode a + toConstr _ = error "Addressed.toConstr" + gunfold _ _ = error "Addressed.gunfold" +#if MIN_VERSION_base(4,2,0) + dataTypeOf _ = mkNoRepType "Network.Tox.Onion.Transport.Addressed" +#else + dataTypeOf _ = mkNorepType "Network.Tox.Onion.Transport.Addressed" +#endif instance Sized a => Sized (Addressed a) where size = case size :: Size a of @@ -434,6 +472,10 @@ addrToIndex _ = 0 indexToAddr :: Int -> SockAddr indexToAddr x = SockAddrInet6 0 0 (fromIntegral x, fromIntegral (x `shiftR` 32),0,0) 0 +-- Note, toxcore would check an address family byte here to detect a TCP-bound +-- packet, but we instead use the IPv6 id and rely on the port number being +-- zero. Since it will be symmetrically encrypted for our eyes only, it's not +-- important to conform on this point. instance Serialize a => Serialize (Addressed a) where get = do saddr <- getForwardAddr a <- get @@ -549,6 +591,7 @@ instance (Serialize (Encrypted (Addressed (Forwarding n msg)))) => Serialize (Fo get = Forwarding <$> getPublicKey <*> get put (Forwarding k x) = putPublicKey k >> put x +{- rewrap :: (ThreeMinus n ~ S (ThreeMinus (S n)), Serialize (ReturnPath n), Serialize @@ -565,6 +608,7 @@ rewrap crypto saddr (OnionRequest nonce msg rpath) = do Addressed dst msg' -> Right (OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath, dst) _ -> Left "Onion forward to TCP client?" +-} handleOnionRequest :: forall a proxy n. ( LessThanThree n @@ -584,7 +628,6 @@ handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = case peeled of Left e -> do - -- todo report encryption error dput XOnion $ unwords [ "peelOnion:", show n, showDestination, e] kont Right (Addressed dst msg') -> do @@ -617,7 +660,7 @@ handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (Return -> TransportCrypto -> SockAddr -> UDPTransport - -> (Int -> OnionResponse N1 -> IO ()) -- ^ TCP-relay onion send. + -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP-relay onion send. -> IO a -> OnionResponse (S n) -> IO a @@ -633,10 +676,9 @@ handleOnionResponse proxy crypto saddr udp sendTCP kont (OnionResponse path msg) sendMessage udp dst (runPut $ putResponse $ OnionResponse path' msg) kont Right (TCPIndex dst path') -> do - -- This should only occur for OnionResponse N1 - case gcast (OnionResponse path' msg) of - Just supported -> sendTCP dst supported - Nothing -> dput XUnexpected "handleOnionResponse: TCP-bound message not supported." + case peanoVal path' of + 0 -> sendTCP dst msg + n -> dput XUnexpected $ "handleOnionResponse: TCP-bound OnionResponse" ++ show n ++ " not supported." kont @@ -900,6 +942,17 @@ wrapOnion crypto skey nonce destkey saddr fwd = do secret <- lookupSharedSecret crypto skey destkey nonce return $ Forwarding (toPublic skey) $ ToxCrypto.encrypt secret plain +wrapOnionPure :: Serialize (Forwarding n msg) => + SecretKey + -> ToxCrypto.State + -> SockAddr + -> Forwarding n msg + -> Forwarding (S n) msg +wrapOnionPure skey st saddr fwd = Forwarding (toPublic skey) (ToxCrypto.encrypt st plain) + where + plain = encodePlain $ Addressed saddr fwd + + -- TODO -- Two types of packets may be sent to Rendezvous via OnionToRoute requests. diff --git a/src/Network/Tox/Relay.hs b/src/Network/Tox/Relay.hs index 7af14ed6..2842fcc2 100644 --- a/src/Network/Tox/Relay.hs +++ b/src/Network/Tox/Relay.hs @@ -201,22 +201,23 @@ handlePacket cons thistcp me crypto sendOnion sendToMe session = \case sendToThem' <- IntMap.lookup i $ associated mySession return $ sendToThem' $ RelayData bs - OnionPacket p -> do - mp <- rewrap crypto (TCPIndex thistcp) p - case mp of - Right (p',addr) -> sendOnion addr p' - _ -> return () + OnionPacket n24 (Addressed addr req) -> do + rpath <- atomically $ do + sym <- transportSymmetric crypto + n <- transportNewNonce crypto + return $ wrapSymmetric sym n (TCPIndex thistcp) NoReturnPath + sendOnion addr $ OnionRequest n24 req rpath _ -> return () -sendTCP_ :: TVar (IntMap (RelayPacket -> IO ())) -> Int -> OnionResponse N1 -> IO () +sendTCP_ :: TVar (IntMap (RelayPacket -> IO ())) -> Int -> OnionMessage Encrypted -> IO () sendTCP_ st addr x = join $ atomically $ IntMap.lookup addr <$> readTVar st >>= \case Nothing -> return $ return () Just send -> return $ send $ OnionPacketResponse x -tcpRelay :: SockAddr -> (SockAddr -> OnionRequest N1 -> IO ()) -> IO (ServerHandle, Int -> OnionResponse N1 -> IO ()) +tcpRelay :: SockAddr -> (SockAddr -> OnionRequest N1 -> IO ()) -> IO (ServerHandle, Int -> OnionMessage Encrypted -> IO ()) tcpRelay udp_addr sendOnion = do crypto <- newCrypto cons <- newTVarIO Map.empty diff --git a/src/Network/Tox/TCP.hs b/src/Network/Tox/TCP.hs index 608becc3..c9c3d9a6 100644 --- a/src/Network/Tox/TCP.hs +++ b/src/Network/Tox/TCP.hs @@ -7,6 +7,7 @@ module Network.Tox.TCP where import Control.Arrow import Control.Concurrent import Control.Concurrent.STM +import Control.Monad import Crypto.Random import Data.Functor.Contravariant import Data.Functor.Identity @@ -22,11 +23,12 @@ import DebugTag import DPut import Network.Address (setPort,PortNumber) import Network.Kademlia.Routing -import Network.Kademlia.Search +import Network.Kademlia.Search hiding (sendQuery) import Network.QueryResponse import Network.QueryResponse.TCP import Network.Tox.DHT.Handlers (toxSpace) -import Network.Tox.Onion.Transport (OnionMessage(..),OnionResponse(..),N1) +import Network.Tox.Onion.Transport hiding (encrypt,decrypt) +import Network.Tox.Onion.Handlers (unwrapAnnounceResponse) import qualified Network.Tox.NodeId as UDP @@ -103,30 +105,77 @@ toxTCP crypto = tcpTransport 30 (tcpStream crypto) tcpSpace :: KademliaSpace NodeId NodeInfo tcpSpace = contramap udpNodeInfo toxSpace -nodeSearch :: Client err meth tid NodeInfo RelayPacket -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo -nodeSearch client = Search +nodeSearch :: TCPClient err () Nonce8 -> Search NodeId (IP, PortNumber) () NodeInfo NodeInfo +nodeSearch tcp = Search { searchSpace = tcpSpace , searchNodeAddress = nodeIP &&& tcpPort - , searchQuery = getNodes client + , searchQuery = getTCPNodes tcp } -getNodes :: Client err meth tid NodeInfo RelayPacket -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo], [NodeInfo], Maybe ())) -getNodes client seeking dst = do - return Nothing -- TODO +data TCPClient err meth tid = TCPClient + { tcpCrypto :: TransportCrypto + , tcpClient :: Client err () tid NodeInfo RelayPacket + , tcpGetGateway :: UDP.NodeInfo -> STM (Maybe NodeInfo) + } + +getTCPNodes :: TCPClient err () Nonce8 -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ())) +getTCPNodes tcp seeking dst = do + r <- getUDPNodes tcp seeking (udpNodeInfo dst) + let tcps (ns,_,mb) = (ns',ns',mb) + where ns' = do + n <- ns + [ NodeInfo n (fromIntegral 443) , NodeInfo n (fromIntegral 80) , NodeInfo n (UDP.nodePort n) ] + return $ tcps <$> r + +getUDPNodes :: TCPClient err () Nonce8 -> NodeId -> UDP.NodeInfo -> IO (Maybe ([UDP.NodeInfo], [UDP.NodeInfo], Maybe ())) +getUDPNodes tcp seeking dst = do + mgateway <- atomically $ tcpGetGateway tcp dst + fmap join $ forM mgateway $ \gateway -> do + (b,c,n24) <- atomically $ do + b <- transportNewKey (tcpCrypto tcp) + c <- transportNewKey (tcpCrypto tcp) + n24 <- transportNewNonce (tcpCrypto tcp) + return (b,c,n24) + wrap2 <- lookupNonceFunction (tcpCrypto tcp) b (UDP.id2key $ UDP.nodeId dst) + wrap1 <- lookupNonceFunction (tcpCrypto tcp) c (UDP.id2key $ nodeId gateway) + wrap0 <- lookupNonceFunction (tcpCrypto tcp) (transportSecret $ tcpCrypto tcp) (UDP.id2key $ UDP.nodeId dst) + let meth = MethodSerializer -- MethodSerializer Nonce8 NodeInfo RelayPacket meth AnnounceRequest (Either String AnnounceResponse) + { methodTimeout = \tid addr -> return (addr,8000000) -- 8 second timeout + , method = () -- meth + , wrapQuery = \n8 src dst x -> + OnionPacket n24 $ Addressed (UDP.nodeAddr $ udpNodeInfo dst) + $ wrapOnionPure b (wrap2 n24) (UDP.nodeAddr $ udpNodeInfo dst) + $ wrapOnionPure c (wrap1 n24) (nodeAddr gateway) + $ NotForwarded $ encryptPayload (wrap0 n24) + $ OnionAnnounce Asymm + { senderKey = transportPublic (tcpCrypto tcp) + , asymmNonce = n24 + , asymmData = pure (x,n8) + } + , unwrapResponse = \case + OnionPacketResponse (OnionAnnounceResponse _ n24' r) + -> decrypt (wrap0 n24') r >>= decodePlain + x -> Left $ "getUDPNodes: unwrapResponse fail " ++ show x + } + r <- sendQuery (tcpClient tcp) meth (AnnounceRequest zeros32 seeking UDP.zeroID) gateway + forM r $ \response -> do + let (ns,_,mb) = either (const ([],[],Nothing)) (unwrapAnnounceResponse Nothing dst) $ response + return (ns,ns, const () <$> mb) + handleOOB :: PublicKey -> ByteString -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket)) handleOOB k bs src dst = do dput XMisc $ "TODO: handleOOB " ++ show src return Nothing -handle2route :: OnionResponse N1 -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket)) +handle2route :: OnionMessage Encrypted -> NodeInfo -> NodeInfo -> IO (Maybe (RelayPacket -> RelayPacket)) handle2route o src dst = do dput XMisc $ "TODO: handle2route " ++ show src return Nothing -tcpClient :: TransportCrypto -> IO (Client String () Nonce8 NodeInfo RelayPacket) -tcpClient crypto = do +newClient :: TransportCrypto -> IO (Client String () Nonce8 NodeInfo RelayPacket) +newClient crypto = do net <- toxTCP crypto drg <- drgNew map_var <- atomically $ newTVar (drg, Data.Word64Map.empty) @@ -136,8 +185,8 @@ tcpClient crypto = do { classifyInbound = \case RelayPing n -> IsQuery () n RelayPong n -> IsResponse n - OnionPacketResponse (OnionResponse _ (OnionAnnounceResponse n8 n24 ciphered)) -> IsResponse n8 - OnionPacketResponse o@(OnionResponse _ (OnionToRouteResponse _)) -> IsUnsolicited $ handle2route o + OnionPacketResponse (OnionAnnounceResponse n8 n24 ciphered) -> IsResponse n8 + OnionPacketResponse o@(OnionToRouteResponse _) -> IsUnsolicited $ handle2route o OOBRecv k bs -> IsUnsolicited $ handleOOB k bs , lookupHandler = \() -> Just MethodHandler { methodParse = \(RelayPing n8) -> Right () diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs index 0b34e8f8..e79e4d8b 100644 --- a/src/Network/Tox/Transport.hs +++ b/src/Network/Tox/Transport.hs @@ -22,7 +22,7 @@ toxTransport :: -> OnionRouter -> (PublicKey -> IO (Maybe NodeInfo)) -> UDPTransport - -> (Int -> OnionResponse N1 -> IO ()) -- ^ TCP-bound callback. + -> (Int -> OnionMessage Encrypted -> IO ()) -- ^ TCP-bound callback. -> IO ( Transport String SockAddr (CryptoPacket Encrypted) , Transport String NodeInfo (DHTMessage Encrypted8) , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) -- cgit v1.2.3