From a2e5733be6ea04b2e5352aa00bc4cb5bc685931f Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Fri, 24 Feb 2023 20:55:59 +0000 Subject: [PATCH] core: update/fix webrtc frame encryption function to return error (#1950) * core: update/fix webrtc frame encryption function to return error * ios: update C header * more tests --- apps/ios/SimpleXChat/SimpleX.h | 4 +- src/Simplex/Chat/Mobile.hs | 4 +- src/Simplex/Chat/Mobile/WebRTC.hs | 88 ++++++++++++++++++------------- tests/WebRTCTests.hs | 26 +++++++-- 4 files changed, 77 insertions(+), 45 deletions(-) diff --git a/apps/ios/SimpleXChat/SimpleX.h b/apps/ios/SimpleXChat/SimpleX.h index 9d9ebfa04..36f716223 100644 --- a/apps/ios/SimpleXChat/SimpleX.h +++ b/apps/ios/SimpleXChat/SimpleX.h @@ -22,5 +22,5 @@ extern char *chat_recv_msg(chat_ctrl ctl); extern char *chat_recv_msg_wait(chat_ctrl ctl, int wait); extern char *chat_parse_markdown(char *str); extern char *chat_parse_server(char *str); -extern void chat_encrypt_media(char *key, char *frame, int len); -extern void chat_decrypt_media(char *key, char *frame, int len); +extern char *chat_encrypt_media(char *key, char *frame, int len); +extern char *chat_decrypt_media(char *key, char *frame, int len); diff --git a/src/Simplex/Chat/Mobile.hs b/src/Simplex/Chat/Mobile.hs index 36c21088b..96dadf9c8 100644 --- a/src/Simplex/Chat/Mobile.hs +++ b/src/Simplex/Chat/Mobile.hs @@ -65,9 +65,9 @@ foreign export ccall "chat_parse_markdown" cChatParseMarkdown :: CString -> IO C foreign export ccall "chat_parse_server" cChatParseServer :: CString -> IO CJSONString -foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO () +foreign export ccall "chat_encrypt_media" cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString -foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO () +foreign export ccall "chat_decrypt_media" cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString -- | check / migrate database and initialize chat controller on success cChatMigrateInit :: CString -> CString -> Ptr (StablePtr ChatController) -> IO CJSONString diff --git a/src/Simplex/Chat/Mobile/WebRTC.hs b/src/Simplex/Chat/Mobile/WebRTC.hs index e73f7d6ef..61cf7e58c 100644 --- a/src/Simplex/Chat/Mobile/WebRTC.hs +++ b/src/Simplex/Chat/Mobile/WebRTC.hs @@ -1,54 +1,72 @@ +{-# LANGUAGE FlexibleContexts #-} + module Simplex.Chat.Mobile.WebRTC where import Control.Monad.Except import qualified Crypto.Cipher.Types as AES import Crypto.Random (getRandomBytes) +import Data.Bifunctor (bimap) import qualified Data.ByteArray as BA import qualified Data.ByteString as B import qualified Data.ByteString.Base64.URL as U import Data.ByteString.Internal (ByteString (PS), memcpy) -import Data.Either (fromRight) +import Data.Either (fromLeft) import Data.Word (Word8) -import Foreign.C (CInt, CString) +import Foreign.C (CInt, CString, newCAString) import Foreign.ForeignPtr (newForeignPtr_) import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) import Foreign.Ptr (Ptr, plusPtr) import qualified Simplex.Messaging.Crypto as C -cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO () +cChatEncryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString cChatEncryptMedia = cTransformMedia chatEncryptMedia -cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO () +cChatDecryptMedia :: CString -> Ptr Word8 -> CInt -> IO CString cChatDecryptMedia = cTransformMedia chatDecryptMedia -cTransformMedia :: (ByteString -> ByteString -> IO ByteString) -> CString -> Ptr Word8 -> CInt -> IO () +cTransformMedia :: (ByteString -> ByteString -> ExceptT String IO ByteString) -> CString -> Ptr Word8 -> CInt -> IO CString cTransformMedia f cKey cFrame cFrameLen = do key <- B.packCString cKey - frame <- getByteString cFrame cFrameLen - frame' <- f key frame - putByteString frame' cFrame cFrameLen + frame <- getFrame + runExceptT (f key frame >>= liftIO . putFrame) >>= newCAString . fromLeft "" + where + getFrame = do + fp <- newForeignPtr_ cFrame + pure $ PS fp 0 $ fromIntegral cFrameLen + putFrame bs@(PS fp offset _) = do + let len = B.length bs + p = unsafeForeignPtrToPtr fp `plusPtr` offset + when (len <= fromIntegral cFrameLen) $ memcpy cFrame p len {-# INLINE cTransformMedia #-} -chatEncryptMedia :: ByteString -> ByteString -> IO ByteString -chatEncryptMedia keyStr frame = fromRight frame <$> encrypt - where - encrypt = runExceptT $ do - key <- liftEither $ U.decode keyStr - iv <- liftIO $ getRandomBytes ivSize - let (frame', _) = B.splitAt (B.length frame - C.authTagSize - ivSize) frame - (tag, frame'') <- withExceptT show $ C.encryptAESNoPad (C.Key key) (C.IV iv) frame' - let authTag = BA.convert $ C.unAuthTag tag - pure $ frame'' <> authTag <> iv +chatEncryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString +chatEncryptMedia keyStr frame = do + checkFrameLen frame + key <- decodeKey keyStr + iv <- liftIO $ getRandomBytes ivSize + let (frame', _) = B.splitAt (B.length frame - reservedSize) frame + (tag, frame'') <- withExceptT show $ C.encryptAESNoPad key (C.IV $ iv <> ivPad) frame' + let authTag = BA.convert $ C.unAuthTag tag + pure $ frame'' <> authTag <> iv -chatDecryptMedia :: ByteString -> ByteString -> IO ByteString -chatDecryptMedia keyStr frame = fromRight frame <$> decrypt - where - decrypt = runExceptT $ do - key <- liftEither $ U.decode keyStr - let (rest, iv) = B.splitAt (B.length frame - ivSize) frame - (frame', tag) = B.splitAt (B.length rest - C.authTagSize) rest - authTag = C.AuthTag $ AES.AuthTag $ BA.convert tag - withExceptT show $ C.decryptAESNoPad (C.Key key) (C.IV iv) frame' authTag +chatDecryptMedia :: ByteString -> ByteString -> ExceptT String IO ByteString +chatDecryptMedia keyStr frame = do + checkFrameLen frame + key <- decodeKey keyStr + let (rest, iv) = B.splitAt (B.length frame - ivSize) frame + (frame', tag) = B.splitAt (B.length rest - C.authTagSize) rest + authTag = C.AuthTag $ AES.AuthTag $ BA.convert tag + frame'' <- withExceptT show $ C.decryptAESNoPad key (C.IV $ iv <> ivPad) frame' authTag + pure $ frame'' <> B.replicate reservedSize 0 + +checkFrameLen :: ByteString -> ExceptT String IO () +checkFrameLen frame = + when (B.length frame < reservedSize) $ throwError "frame has no [reserved space] IV and/or auth tag" +{-# INLINE checkFrameLen #-} + +decodeKey :: ByteString -> ExceptT String IO C.Key +decodeKey = liftEither . bimap ("invalid key: " <>) C.Key . U.decode +{-# INLINE decodeKey #-} authTagSize :: Int authTagSize = C.authTagSize @@ -58,15 +76,9 @@ ivSize :: Int ivSize = 12 {-# INLINE ivSize #-} -getByteString :: Ptr Word8 -> CInt -> IO ByteString -getByteString p size = do - fp <- newForeignPtr_ p - pure $ PS fp 0 $ fromIntegral size -{-# INLINE getByteString #-} +ivPad :: ByteString +ivPad = B.replicate 4 0 -putByteString :: ByteString -> Ptr Word8 -> CInt -> IO () -putByteString bs@(PS fp offset _) to size = do - let len = B.length bs - p = unsafeForeignPtrToPtr fp `plusPtr` offset - when (len <= fromIntegral size) $ memcpy to p len -{-# INLINE putByteString #-} +reservedSize :: Int +reservedSize = authTagSize + ivSize +{-# INLINE reservedSize #-} diff --git a/tests/WebRTCTests.hs b/tests/WebRTCTests.hs index c9a41e358..f512c88ef 100644 --- a/tests/WebRTCTests.hs +++ b/tests/WebRTCTests.hs @@ -1,5 +1,6 @@ module WebRTCTests where +import Control.Monad.Except import Crypto.Random (getRandomBytes) import qualified Data.ByteString.Base64.URL as U import qualified Data.ByteString.Char8 as B @@ -11,8 +12,27 @@ webRTCTests = describe "WebRTC crypto" $ do it "encrypts and decrypts media" $ do key <- U.encode <$> getRandomBytes 32 frame <- getRandomBytes 1000 - let reservedSize = authTagSize + ivSize - frame' <- chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL' + Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL' B.length frame' `shouldBe` B.length frame + reservedSize - frame'' <- chatDecryptMedia key frame' + Right frame'' <- runExceptT $ chatDecryptMedia key frame' frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL' + it "should fail on invalid frame size" $ do + key <- U.encode <$> getRandomBytes 32 + frame <- getRandomBytes 10 + runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "frame has no [reserved space] IV and/or auth tag" + runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "frame has no [reserved space] IV and/or auth tag" + it "should fail on invalid key" $ do + let key = B.replicate 32 '#' + frame <- (<> B.replicate reservedSize '\NUL') <$> getRandomBytes 100 + runExceptT (chatEncryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0" + runExceptT (chatDecryptMedia key frame) `shouldReturn` Left "invalid key: invalid character at offset: 0" + it "should fail on invalid auth tag" $ do + key <- U.encode <$> getRandomBytes 32 + frame <- getRandomBytes 1000 + Right frame' <- runExceptT $ chatEncryptMedia key $ frame <> B.replicate reservedSize '\NUL' + Right frame'' <- runExceptT $ chatDecryptMedia key frame' + frame'' `shouldBe` frame <> B.replicate reservedSize '\NUL' + let (rest, iv) = B.splitAt (B.length frame' - ivSize) frame + (encFrame, _tag) = B.splitAt (B.length rest - authTagSize) rest + badFrame = encFrame <> B.replicate authTagSize '\NUL' <> iv + runExceptT (chatDecryptMedia key badFrame) `shouldReturn` Left "AESDecryptError"