From c31ed656d55bbdb387d91464e51840e90503223a Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 24 Oct 2017 01:35:33 -0400 Subject: Implemented "dhtkey" publish method. --- src/Network/Tox.hs | 24 ++++++++- src/Network/Tox/DHT/Transport.hs | 7 ++- src/Network/Tox/Onion/Handlers.hs | 8 --- src/Network/Tox/Onion/Transport.hs | 103 +++++++++++++++++++++++++++++++------ src/Network/Tox/Transport.hs | 2 +- 5 files changed, 115 insertions(+), 29 deletions(-) (limited to 'src/Network') diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs index eb4c6027..c0e1dee0 100644 --- a/src/Network/Tox.hs +++ b/src/Network/Tox.hs @@ -196,7 +196,7 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do mkclient (tbl,var) handlers = let client = Client { clientNet = addHandler eprinter (handleMessage client) $ modifynet client net - , clientDispatcher = dispatch tbl var handlers -- (fmap (contramapAddr (\(ToxPath ni _) -> ni)) . handlers) + , clientDispatcher = dispatch tbl var handlers , clientErrorReporter = eprinter { reportTimeout = reportTimeout ignoreErrors } , clientPending = var , clientAddress = selfAddr @@ -208,7 +208,7 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do data Tox = Tox { toxDHT :: DHT.Client , toxOnion :: Onion.Client RouteId - , toxToRoute :: Transport String Onion.Rendezvous Onion.DataToRoute + , toxToRoute :: Transport String Onion.AnnouncedRendezvous (PublicKey,Onion.OnionData) , toxCrypto :: Transport String SockAddr NetCrypto , toxCryptoKeys :: TransportCrypto , toxRouting :: DHT.Routing @@ -217,6 +217,26 @@ data Tox = Tox , toxOnionRoutes :: OnionRouter } +getContactInfo :: Tox -> IO DHT.DHTPublicKey +getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do + r4 <- readTVar $ DHT.routing4 toxRouting + r6 <- readTVar $ DHT.routing6 toxRouting + nonce <- transportNewNonce toxCryptoKeys + let self = nodeId n4 + n4 = R.thisNode r4 + n6 = R.thisNode r6 + n4s = R.kclosest DHT.toxSpace 4 self r4 + n6s = R.kclosest DHT.toxSpace 4 self r6 + ns = filter (DHT.isGlobal . nodeIP) [n4,n6] + ++ concat (zipWith (\a b -> [a,b]) n4s n6s) + return $ do + timestamp <- round . (* 1000000) <$> getPOSIXTime + return DHT.DHTPublicKey + { dhtpkNonce = timestamp + , dhtpk = id2key self + , dhtpkNodes = DHT.SendNodes $ take 4 ns + } + isLocalHost :: SockAddr -> Bool isLocalHost (SockAddrInet _ host32) = (fromBE32 host32 == 0x7f000001) isLocalHost _ = False diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index 5bd9caa1..0787c2c1 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs @@ -43,6 +43,7 @@ import Data.Monoid import Data.Serialize as S import Data.Tuple import Data.Word +import Foreign.C (CTime(..)) import Network.Socket type DHTTransport = Transport String NodeInfo (DHTMessage Encrypted8) @@ -201,7 +202,11 @@ instance Serialize DHTRequest where -- | `32` | Our DHT public key | -- | `[39, 204]` | Maximum of 4 nodes in packed format | data DHTPublicKey = DHTPublicKey - { dhtpkNonce :: Nonce8 -- no_replay + { dhtpkNonce :: Word64 -- ^ The `no_replay` number is protection if + -- someone tries to replay an older packet and + -- should be set to an always increasing number. + -- It is 8 bytes so you should set a high + -- resolution monotonic time as the value. , dhtpk :: PublicKey -- dht public key , dhtpkNodes :: SendNodes -- other reachable nodes } diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs index 0c137bf5..3eec0390 100644 --- a/src/Network/Tox/Onion/Handlers.hs +++ b/src/Network/Tox/Onion/Handlers.hs @@ -242,14 +242,6 @@ sendOnion getTimeout client req oaddr unwrap = $ join mb -- | Lookup the secret counterpart for a given alias key. -selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector -selectAlias crypto pkey = do - ks <- filter (\(sk,pk) -> pk == id2key pkey) - <$> readTVar (userKeys crypto) - maybe (return SearchingAlias) - (return . uncurry AnnouncingAlias) - (listToMaybe ks) - getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int)) -> TransportCrypto -> Client r diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs index 4c3de3e6..6635fad1 100644 --- a/src/Network/Tox/Onion/Transport.hs +++ b/src/Network/Tox/Onion/Transport.hs @@ -25,6 +25,8 @@ module Network.Tox.Onion.Transport , OnionMessage(..) , Rendezvous(..) , DataToRoute(..) + , OnionData(..) + , AnnouncedRendezvous(..) , AnnounceResponse(..) , AnnounceRequest(..) , Forwarding(..) @@ -41,6 +43,7 @@ module Network.Tox.Onion.Transport , N3 , onionKey , onionAliasSelector + , selectAlias ) where import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort) @@ -50,13 +53,12 @@ import Network.Tox.NodeId import qualified Crypto.Tox as ToxCrypto import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,FriendRequest,asymNodeInfo) -import Debug.Trace -import Control.Arrow import Control.Applicative +import Control.Arrow import Control.Concurrent.STM import Control.Monad -import qualified Data.ByteString as B - ;import Data.ByteString (ByteString) +import qualified Data.ByteString as B + ;import Data.ByteString (ByteString) import Data.Coerce import Data.Function import Data.Functor.Contravariant @@ -64,14 +66,16 @@ import Data.Functor.Identity import Data.IP import Data.Maybe import Data.Monoid -import Data.Serialize as S +import Data.Serialize as S import Data.Type.Equality import Data.Typeable import Data.Word -import GHC.Generics () +import Debug.Trace +import GHC.Generics () import GHC.TypeLits import Network.Socket import System.IO +import qualified Text.ParserCombinators.ReadP as RP type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a @@ -609,6 +613,15 @@ instance Sized OnionData where ConstSize n -> n VarSize f -> f req +instance Serialize OnionData where + get = do + tag <- get + case tag :: Word8 of + 0x9c -> OnionDHTPublicKey <$> get + 0x20 -> OnionFriendRequest <$> get + _ -> fail $ "Unknown onion data: "++show tag + put (OnionDHTPublicKey dpk) = put (0x9c :: Word8) >> put dpk + put (OnionFriendRequest fr) = put (0x20 :: Word8) >> put fr selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey) selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias skey pkey) _ _) @@ -731,30 +744,86 @@ data Rendezvous = Rendezvous deriving Eq instance Show Rendezvous where - show (Rendezvous k ni) = concat [show $ key2id k, ":", show ni] - + showsPrec d (Rendezvous k ni) + = showsPrec d (key2id k) + . (':' :) + . showsPrec d ni + +data AnnouncedRendezvous = AnnouncedRendezvous + { remoteUserKey :: PublicKey + , rendezvous :: Rendezvous + } + deriving Eq + +instance Show AnnouncedRendezvous where + showsPrec d (AnnouncedRendezvous remote rendez) + = showsPrec d (key2id remote) + . (':' :) + . showsPrec d rendez + +instance Read AnnouncedRendezvous where + readsPrec d = RP.readP_to_S $ do + ukstr <- RP.munch (/=':') + RP.char ':' + rkstr <- RP.munch (/=':') + RP.char ':' + nistr <- RP.munch (const True) + return AnnouncedRendezvous + { remoteUserKey = id2key $ read ukstr + , rendezvous = Rendezvous + { rendezvousKey = id2key $ read rkstr + , rendezvousNode = read nistr + } + } + + +selectAlias :: TransportCrypto -> NodeId -> STM AliasSelector +selectAlias crypto pkey = do + ks <- filter (\(sk,pk) -> pk == id2key pkey) + <$> readTVar (userKeys crypto) + maybe (return SearchingAlias) + (return . uncurry AnnouncingAlias) + (listToMaybe ks) parseDataToRoute :: TransportCrypto -> (OnionMessage Encrypted,OnionDestination r) - -> IO (Either (DataToRoute,Rendezvous) (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? - decrypted <- uncomposed - $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto) - (asymmNonce dta) - (Right dta) - return ( runIdentity decrypted - , Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od ) + dtr <- 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) + omsg <- fmap runIdentity + $ uncomposed + $ decryptMessage (sk,pk) + (asymmNonce dta) + (Left (dataFromKey dtr, dataToRoute dtr)) + return ( (pk, omsg) + , AnnouncedRendezvous + (dataFromKey dtr) + $ Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od ) parseDataToRoute _ msg = return $ Right msg encodeDataToRoute :: TransportCrypto - -> (DataToRoute,Rendezvous) + -> ((PublicKey,OnionData),AnnouncedRendezvous) -> IO (Maybe (OnionMessage Encrypted,OnionDestination r)) -encodeDataToRoute crypto (plain, Rendezvous pub ni) = do +encodeDataToRoute crypto ((me,omsg), AnnouncedRendezvous toxid (Rendezvous pub ni)) = do nonce <- atomically $ transportNewNonce crypto + asel <- atomically $ selectAlias crypto (key2id me) + let (sk,pk) = case asel of + AnnouncingAlias sk pk -> (sk,pk) + _ -> (onionAliasSecret crypto, onionAliasPublic crypto) + let plain = DataToRoute { dataFromKey = pk + , dataToRoute = encryptMessage sk toxid nonce omsg + } let dta = encryptMessage (onionAliasSecret crypto) pub nonce plain return $ Just ( OnionToRoute pub -- Public key of destination node Asymm { senderKey = onionAliasPublic crypto diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs index 2a4e7eee..5cda1524 100644 --- a/src/Network/Tox/Transport.hs +++ b/src/Network/Tox/Transport.hs @@ -24,7 +24,7 @@ toxTransport :: -> UDPTransport -> IO ( Transport String NodeInfo (DHTMessage Encrypted8) , Transport String (OnionDestination RouteId) (OnionMessage Encrypted) - , Transport String Rendezvous DataToRoute + , Transport String AnnouncedRendezvous (PublicKey,OnionData) , Transport String SockAddr NetCrypto ) toxTransport crypto orouter closeLookup udp = do (dht,udp1) <- partitionTransport parseDHTAddr (Just . encodeDHTAddr) $ forwardOnions crypto udp -- cgit v1.2.3