From 2fdb0342f8cfcaf4924a0ce43e7fccb236eb0d5e Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 10 Jul 2017 20:30:10 -0400 Subject: Fixed Tox decryption. --- src/Network/DatagramServer/Tox.hs | 125 ++++++++++++++++++++++++++++++++++---- 1 file changed, 112 insertions(+), 13 deletions(-) (limited to 'src/Network/DatagramServer') diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs index 5003f3a4..9d60d066 100644 --- a/src/Network/DatagramServer/Tox.hs +++ b/src/Network/DatagramServer/Tox.hs @@ -51,6 +51,10 @@ import Text.PrettyPrint.HughesPJClass hiding (($$), (<>)) import qualified Data.ByteArray as BA import Data.ByteArray ( Bytes, convert ) import Data.Monoid +import System.Endian +import qualified Data.ByteString.Base16 as Base16 +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Char8 as C8 type Key32 = Word256 -- 32 byte key @@ -119,9 +123,14 @@ data Message a = Message , msgNonce :: TransactionID Message , msgPayload :: a } - deriving (Show, Generic, Functor, Foldable, Traversable) + deriving (Eq, Show, Generic, Functor, Foldable, Traversable) -deriving instance Show (NodeId Message) -- TODO: print as hex +instance Show (NodeId Message) where + showsPrec d pubkey s = + "NodeId \"" ++ C8.unpack (Base16.encode $ convert pubkey) ++ '"':s + +instance Show (TransactionID Message) where + showsPrec d nonce = mappend "TID " . quoted (mappend $ bin2hex nonce) isQuery :: Message a -> Bool isQuery (Message { msgType = SendNodes }) = False @@ -231,13 +240,26 @@ data ToxCipherContext = ToxCipherContext data Ciphered = Ciphered { cipheredMAC :: Poly1305.Auth , cipheredBytes :: ByteString } + deriving Eq + +quoted shows s = '"':shows ('"':s) + +bin2hex :: ByteArrayAccess bs => bs -> String +bin2hex = C8.unpack . Base16.encode . convert + +instance Show Ciphered where + showsPrec d (Ciphered (Poly1305.Auth mac) bytes) = + mappend "Ciphered (Auth " + . quoted (mappend $ bin2hex mac) + . (") " ++) + . quoted (mappend $ bin2hex bytes) getMessage :: Get (Message Ciphered) getMessage = do typ <- get nid <- get tid <- get - mac <- Poly1305.Auth . convert <$> getBytes 2 + mac <- Poly1305.Auth . convert <$> getBytes 16 cnt <- remaining bs <- getBytes cnt return Message { msgType = typ @@ -254,11 +276,19 @@ putMessage (Message {..}) = do putByteString (convert mac) putByteString bs +-- XXX: assumes ByteArray is little-endian id2key :: NodeId Message -> PublicKey id2key recipient = case publicKey recipient of CryptoPassed key -> key CryptoFailed e -> error ("id2key: "++show e) +-- XXX: S.decode is Big-endian +-- TODO: implement ByteArray instance, avoid S.decode +key2id :: PublicKey -> NodeId Message +key2id pk = case S.decode (BA.convert pk) of + Left _ -> error "key2id" + Right nid -> nid + zeros32 :: Bytes zeros32 = BA.replicate 32 0 @@ -305,6 +335,11 @@ encipherAndHash hash crypt m = Ciphered a c decipherAndAuth :: Poly1305.State -> XSalsa.State -> Ciphered -> Either String ByteString decipherAndAuth hash crypt (Ciphered mac c) + {- + | C8.length m /= C8.length c = Left $ "Unequal lengths: "++show (C8.length m, C8.length c) + -- | C8.length c /= 40 = Left $ "Unexpected c length: " ++ show (C8.length c, bin2hex c) + | otherwise = Right m + -} | (a == mac) = Right m | otherwise = Left "decipherAndAuth: auth fail" where @@ -340,14 +375,16 @@ curve25519 = CurveFP (CurvePrime prime curvecommon) instance Envelope Message where newtype TransactionID Message = TID Nonce24 - deriving (Eq,Ord,Show,Serialize) -- Read + deriving (Eq,Ord) -- Read newtype NodeId Message = NodeId Word256 - deriving (Serialize, Eq, Ord, Bits, FiniteBits) + deriving (Eq, Ord, Bits, FiniteBits) type QueryMethod Message = MessageType newtype QueryExtra Message = QueryNonce { qryNonce :: Nonce8 } + deriving (Eq, Ord, Show) + newtype ResponseExtra Message = ResponseNonce { rspNonce :: Nonce8 } data PacketDestination Message = ToxAddr { toxID :: NodeId Message @@ -381,23 +418,83 @@ instance Envelope Message where $ S.decode $ Char8.pack (take 24 $ show cnt ++ repeat ' ') +{- +instance Serialize (TransactionID Message) where + get = do + lo <- getWord64le + mid <- getWord64le + hi <- getWord64le + return $ TID (LargeKey lo + (LargeKey mid hi)) + + put (TID (LargeKey lo (LargeKey mid hi))) = do + putWord64le lo + putWord64le mid + putWord64le hi + +instance Serialize (NodeId Message) where + get = do + lo <- getWord64le + mid <- getWord64le + hi <- getWord64le + highest <- getWord64le + return $ NodeId (LargeKey lo + (LargeKey mid + (LargeKey hi highest))) + put (NodeId (LargeKey lo (LargeKey mid (LargeKey hi highest)))) = do + putWord64le lo + putWord64le mid + putWord64le hi + putWord64le highest + +-} + +instance Serialize (TransactionID Message) where + get = do + hi <- getWord64be + mid <- getWord64be + lo <- getWord64be + return $ TID (LargeKey lo + (LargeKey mid hi)) + + put (TID (LargeKey lo (LargeKey mid hi))) = do + putWord64be hi + putWord64be mid + putWord64be lo + +instance Serialize (NodeId Message) where + get = do + highest <- getWord64be + hi <- getWord64be + mid <- getWord64be + lo <- getWord64be + return $ NodeId (LargeKey lo + (LargeKey mid + (LargeKey hi highest))) + put (NodeId (LargeKey lo (LargeKey mid (LargeKey hi highest)))) = do + putWord64be highest + putWord64be hi + putWord64be mid + putWord64be lo + + staticAssert isLittleEndian -- assumed by 'withWord64Ptr' with3Word64Ptr :: Nonce24 -> (Ptr Word64 -> IO a) -> IO a with3Word64Ptr (LargeKey wlo (LargeKey wmid whi)) kont = allocaBytes (sizeOf wlo * 3) $ \p -> do - pokeElemOff p 0 wlo - pokeElemOff p 1 wmid - pokeElemOff p 2 whi + pokeElemOff p 2 $ toBE64 wlo + pokeElemOff p 1 $ toBE64 wmid + pokeElemOff p 0 $ toBE64 whi kont p with4Word64Ptr :: Key32 -> (Ptr Word64 -> IO a) -> IO a with4Word64Ptr (LargeKey wlo (LargeKey wmid (LargeKey whi whighest))) kont = allocaBytes (sizeOf wlo * 4) $ \p -> do - pokeElemOff p 0 wlo - pokeElemOff p 1 wmid - pokeElemOff p 2 whi - pokeElemOff p 3 whighest + pokeElemOff p 3 $ toBE64 wlo + pokeElemOff p 2 $ toBE64 wmid + pokeElemOff p 1 $ toBE64 whi + pokeElemOff p 0 $ toBE64 whighest kont p @@ -440,13 +537,15 @@ instance WireFormat ByteString Message where initializeServerState _ _ = do k <- generateSecretKey + {- nid <- withByteArray (toPublic k) $ \p -> do wlo <- peekElemOff p 0 wmid <- peekElemOff p 1 whi <- peekElemOff p 2 whigest <- peekElemOff p 3 return $ LargeKey wlo (LargeKey wmid (LargeKey whi whigest)) - return (NodeId nid, ToxCipherContext k) + -} + return (key2id $ toPublic k, ToxCipherContext k) instance Read (NodeId Message) where readsPrec d s = map (\(w,xs) -> (NodeId w, xs)) $ decodeHex s -- cgit v1.2.3