rncryptor 0.3.0.2 → 0.4.0.0

raw patch · 8 files changed

+227/−77 lines, 8 filesdep ~basedep ~bytestringdep ~io-streamsnew-component:exe:rncryptor-decrypt-simplePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, io-streams

API changes (from Hackage documentation)

Files

• example/DecrypterSimple.hs +17/−0
• rncryptor.cabal +18/−2
• src/Crypto/RNCryptor/Types.hs +22/−6
• src/Crypto/RNCryptor/V3/Decrypt.hs +73/−17
• src/Crypto/RNCryptor/V3/Encrypt.hs +2/−1
• src/Crypto/RNCryptor/V3/Stream.hs +29/−51
• test/Main.hs +5/−0
• test/Tests.hs +61/−0

@@ -0,0 +1,17 @@+module Main where++import Crypto.RNCryptor.V3.Decrypt+import System.Environment+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString as BIO+import Control.Exception (throwIO)++main :: IO ()+main = do+  args <- getArgs+  case args of+    file:key:_ -> do+      input <- BIO.readFile file+      case decrypt input (B.pack key) of+        Left err  -> throwIO $ userError (show err)+        Right txt -> BIO.writeFile "/dev/stdout" txt

@@ -1,5 +1,5 @@ name:                rncryptor-version:             0.3.0.2+version:             0.4.0.0 synopsis:            Haskell implementation of the RNCryptor file format description:         Pure Haskell implementation of the RNCrytor spec. license:             MIT@@ -8,7 +8,7 @@ maintainer:          alfredo.dinapoli@gmail.com category:            Network build-type:          Simple-tested-with:         GHC == 7.6, GHC == 7.8+tested-with:         GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.4, GHC == 9.6.6 cabal-version:       >=1.10  flag fastpbkdf2@@ -83,6 +83,22 @@     example   main-is:     StreamingDecrypter.hs+  default-language:+    Haskell2010+  ghc-options:+    -funbox-strict-fields++executable rncryptor-decrypt-simple+  build-depends:+      base+    , bytestring+    , cryptonite >= 0.15+    , io-streams+    , rncryptor -any+  hs-source-dirs:+    example+  main-is:+    DecrypterSimple.hs   default-language:     Haskell2010   ghc-options:

@@ -39,27 +39,43 @@ import              Crypto.MAC.HMAC (Context, initialize, hmac) import qualified    Crypto.MAC.HMAC as Crypto import              Data.ByteArray (ByteArray, convert)-import              Data.ByteString (cons, ByteString, unpack)+import              Data.ByteString (cons, ByteString, unpack, intersperse) import qualified    Data.ByteString.Char8 as C8+import qualified    Data.ByteString as B import              Data.Monoid import              Data.Typeable import              Data.Word import              System.Random import              Test.QuickCheck (Arbitrary(..), vector)+import              Text.Printf (printf)+import qualified Data.List as L   data RNCryptorException =-  InvalidHMACException !ByteString !ByteString-  -- ^ HMAC validation failed. First parameter is the untrusted hmac, the-  -- second the computed one.+    InvalidHMACException !ByteString !ByteString+    -- ^ HMAC validation failed. First parameter is the untrusted hmac, the+    -- second the computed one.+  | TruncatedStream !Int+    -- ^ The stream ended before a whole trailer (at least one cipher block+    -- plus the 32-byte HMAC, block aligned) could be read. Carries the number+    -- of trailing bytes that were available.   deriving (Typeable, Eq)  instance Show RNCryptorException where   show (InvalidHMACException untrusted computed) =-    "InvalidHMACException: Untrusted HMAC was " <> show (unpack untrusted)-                                                <> ", but the computed one is " <> show (unpack computed) <> "."+    "InvalidHMACException: Untrusted HMAC was " <> showHex untrusted+                                                <> "(" <> show (B.length untrusted) <> " bytes), "+                                                <> " but the computed one is "+                                                <> showHex computed+                                                <> "(" <> show (B.length computed) <> " bytes)."+  show (TruncatedStream n) =+    "TruncatedStream: input ended with " <> show n <> " trailing bytes, "+      <> "need at least " <> show (blockSize + 32) <> " and block aligned before the HMAC."  instance Exception RNCryptorException++showHex :: B.ByteString -> String+showHex = L.unwords . map (printf "%02x") . B.unpack  type Password = ByteString type HMAC = ByteString

@@ -1,14 +1,20 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}+{-# HLINT ignore "Use if" #-} module Crypto.RNCryptor.V3.Decrypt   ( parseHeader   , decrypt   , decryptBlock   , decryptStream+  , decryptStreamWith+  , decryptStreamLenient+  , OnHMACFailure(..)   ) where +import           Control.Exception           (throwIO, Exception (..))+import           Control.Monad               (unless) import           Control.Monad.State-import           Control.Exception           (throwIO) import           Crypto.Cipher.AES           (AES256) import           Crypto.Cipher.Types         (IV, makeIV, BlockCipher, cbcDecrypt) import           Crypto.MAC.HMAC             (update, finalize)@@ -17,11 +23,13 @@ import           Data.Bits                   (xor, (.|.)) import           Data.ByteArray              (convert) import           Data.ByteString             (ByteString)-import qualified Data.ByteString as B import           Data.Foldable import           Data.Maybe                  (fromMaybe) import           Data.Monoid import           Data.Word+import           System.Exit (exitFailure)+import           System.IO (hPutStrLn, stderr)+import qualified Data.ByteString as B import qualified System.IO.Streams as S  --------------------------------------------------------------------------------@@ -91,9 +99,14 @@ -- data = data[:-bord(data[-1])] -- https://github.com/RNCryptor/RNCryptor-python/blob/master/RNCryptor.py#L69 removePaddingSymbols :: ByteString -> ByteString-removePaddingSymbols input =-  let lastWord = B.last input-  in B.take (B.length input - fromEnum lastWord) input+removePaddingSymbols input+  | B.null input = input+  | otherwise =+      let lastByte = B.last input+          padLength = fromEnum lastByte+      in if padLength <= 16 && padLength <= B.length input+           then B.take (B.length input - padLength) input+           else input -- Invalid padding byte, return original input  -------------------------------------------------------------------------------- decryptBytes :: AES256 -> ByteString -> ByteString -> ByteString@@ -150,25 +163,68 @@        True  -> Right (removePaddingSymbols clearText)        False -> Left (InvalidHMACException msgHMAC hmac) ++data OnHMACFailure+  = OHF_abort+  -- | Not recommended for production systems, but useful for debugging.+  | OHF_emit_warning+  | OHF_emit_warning_exit_failure+ -------------------------------------------------------------------------------- -- | Efficiently decrypts an incoming stream of bytes.-decryptStream :: ByteString-              -- ^ The user key (e.g. password)-              -> S.InputStream ByteString-              -- ^ The input source (mostly likely stdin)-              -> S.OutputStream ByteString-              -- ^ The output source (mostly likely stdout)-              -> IO ()-decryptStream userKey inS outS = do+decryptStreamWith :: OnHMACFailure+                  -> ByteString+                  -- ^ The user key (e.g. password)+                  -> S.InputStream ByteString+                  -- ^ The input source (mostly likely stdin)+                  -> S.OutputStream ByteString+                  -- ^ The output source (mostly likely stdout)+                  -> IO ()+decryptStreamWith onInvalidHMAC userKey inS outS = do   rawHdr <- S.readExactly 34 inS   let hdr = parseHeader rawHdr       ctx = newRNCryptorContext userKey hdr       ctx' = ctx { ctxHMACCtx = update (ctxHMACCtx ctx) rawHdr }-  processStream ctx' inS outS decryptBlock finaliseDecryption+  -- Hold back the last cipher block (PKCS#7 padding lives there) plus the HMAC.+  processStream (blockSize + 32) ctx' inS outS decryptBlock finaliseDecryption   where-    finaliseDecryption lastBlock ctx = do-      let (cipherText, msgHMAC) = B.splitAt (B.length lastBlock - 32) lastBlock+    finaliseDecryption trailer ctx = do+      let trailerLen = B.length trailer+      unless (trailerLen >= blockSize + 32 && (trailerLen - 32) `rem` blockSize == 0) $+        throwIO (TruncatedStream trailerLen)+      let (cipherText, msgHMAC) = B.splitAt (trailerLen - 32) trailer           (ctx', clearText)     = decryptBlock ctx cipherText           hmac = convert $ finalize (ctxHMACCtx ctx')-      unless (consistentTimeEqual msgHMAC hmac) (throwIO $ InvalidHMACException msgHMAC hmac)       S.write (Just $ removePaddingSymbols clearText) outS+      let invalidHMacEx = InvalidHMACException msgHMAC hmac+      case consistentTimeEqual msgHMAC hmac of+        True  -> pure ()+        False -> case onInvalidHMAC of+          OHF_abort        -> throwIO invalidHMacEx+          OHF_emit_warning -> do+            hPutStrLn stderr (displayException invalidHMacEx)+          OHF_emit_warning_exit_failure -> do+            exitFailure++--------------------------------------------------------------------------------+-- | Efficiently decrypts an incoming stream of bytes.+decryptStream :: ByteString+              -- ^ The user key (e.g. password)+              -> S.InputStream ByteString+              -- ^ The input source (mostly likely stdin)+              -> S.OutputStream ByteString+              -- ^ The output source (mostly likely stdout)+              -> IO ()+decryptStream = decryptStreamWith OHF_abort++--------------------------------------------------------------------------------+-- | Efficiently decrypts an incoming stream of bytes, not failing if the+-- stream fails HMAC validation.+decryptStreamLenient :: ByteString+                     -- ^ The user key (e.g. password)+                     -> S.InputStream ByteString+                     -- ^ The input source (mostly likely stdin)+                     -> S.OutputStream ByteString+                     -- ^ The output source (mostly likely stdout)+                     -> IO ()+decryptStreamLenient = decryptStreamWith OHF_emit_warning

@@ -63,7 +63,8 @@                          -> IO () encryptStreamWithContext ctx inS outS = do   S.write (Just (renderRNCryptorHeader $ ctxHeader ctx)) outS-  processStream ctx inS outS encryptBlock finaliseEncryption+  -- Nothing to hold back: the finaliser pads whatever tail is left.+  processStream 0 ctx inS outS encryptBlock finaliseEncryption   where     finaliseEncryption lastBlock lastCtx = do       let (ctx', cipherText) = encryptBlock lastCtx (lastBlock <> pkcs7Padding blockSize (B.length lastBlock))

@@ -1,29 +1,21 @@ {-# LANGUAGE BangPatterns #-} module Crypto.RNCryptor.V3.Stream   ( processStream-  , StreamingState(..)   ) where +import           Crypto.RNCryptor.Types import           Data.ByteString (ByteString) import qualified Data.ByteString as B-import           Data.Word-import           Control.Monad.State-import           Crypto.RNCryptor.Types-import           Data.Monoid import qualified System.IO.Streams as S ------------------------------------------------------------------------------------ | The 'StreamingState' the streamer can be at. This is needed to drive the--- computation as well as reading leftovers unread back in case we need to--- chop the buffer read, if not multiple of the 'blockSize'.-data StreamingState =-    Continue-  | FetchLeftOver !Int-  | DrainSource deriving (Show, Eq)------------------------------------------------------------------------------------- | Efficiently transform an incoming stream of bytes.-processStream :: RNCryptorContext+-- | Drive a block transform over an input stream in constant memory. Whole+-- blocks are transformed and written as soon as they are available; the last+-- 'holdBack' bytes are never transformed here and are handed to the finaliser+-- at end of input.+processStream :: Int+              -- ^ How many trailing bytes the finaliser needs to see+              -- untouched (decrypt: last block + HMAC, encrypt: 0).+              -> RNCryptorContext               -- ^ The RNCryptor context for this operation               -> S.InputStream ByteString               -- ^ The input source (mostly likely stdin)@@ -34,38 +26,24 @@               -> (ByteString -> RNCryptorContext -> IO ())               -- ^ The finaliser               -> IO ()-processStream context inS outS blockFn finaliser = go Continue mempty context+processStream holdBack context inS outS applyToBlock finaliser = go B.empty context   where-    slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize)--    go :: StreamingState -> ByteString -> RNCryptorContext -> IO ()-    go dc !iBuffer ctx = do-      nextChunk <- case dc of-        FetchLeftOver size -> do-          lo <- S.readExactly size inS-          p  <- S.read inS-          return $ fmap (mappend lo) p-        _ -> S.read inS-      case nextChunk of-        Nothing -> finaliser iBuffer ctx-        (Just v) -> do-          let (sz, sl) = slack v-          case dc of-            DrainSource -> go DrainSource (iBuffer <> v) ctx-            _ -> do-              whatsNext <- S.peek inS-              case whatsNext of-                Nothing -> finaliser (iBuffer <> v) ctx-                Just nt ->-                  case sz + B.length nt < 4096 of-                    True  -> go DrainSource (iBuffer <> v) ctx-                    False -> do-                      -- If I'm here, it means I can safely process this chunk-                      let (toProcess, rest) = B.splitAt (sz - sl) v-                      let (newCtx, res) = blockFn ctx toProcess-                      S.write (Just res) outS-                      case sl == 0 of-                        False -> do-                          S.unRead rest inS-                          go (FetchLeftOver sl) iBuffer newCtx-                        True -> go Continue iBuffer newCtx+    -- 'carry' stays below holdBack + blockSize bytes: anything beyond that is+    -- a whole block and gets transformed on the read that completes it. That+    -- bound is what keeps memory independent of input size and of how the+    -- input is chunked. The only end-of-input signal is 'S.read' returning+    -- 'Nothing'; no peeking, no guessing from chunk sizes.+    go !carry !ctx = do+      mchunk <- S.read inS+      case mchunk of+        Nothing    -> finaliser carry ctx+        Just chunk -> do+          let buf         = carry <> chunk+              processable = ((B.length buf - holdBack) `div` blockSize) * blockSize+          if processable <= 0+            then go buf ctx+            else do+              let (blocks, rest) = B.splitAt processable buf+                  (ctx', out)    = applyToBlock ctx blocks+              S.write (Just out) outS+              go rest ctx'

@@ -26,8 +26,13 @@                , testCase "Multibyte password" Pwd.multibytePassword                , testCase "Longer text and password" Pwd.longerTextAndPassword                ]+           , testGroup "Streaming with chunked input" [+                 testCase "one-byte chunks" testOneByteChunks+               , testCase "HMAC as final chunk" testHMACAsFinalChunk+               ]          , withQuickCheckDepth "RNCryptor properties" 100 [              testProperty "encrypt/decrypt roundtrip" testEncryptDecryptRoundtrip            , testProperty "encrypt/decrypt streaming roundtrip" testStreamingEncryptDecryptRoundtrip+           , testProperty "encrypt/decrypt chunked streaming roundtrip" testChunkedStreamingRoundtrip          ]      ]

@@ -72,3 +72,64 @@                               ]   let swiftPassword = B.pack [112,97,115,115,119,111,114,100]   decrypt swiftEncrypted swiftPassword @=? Right "01"++--------------------------------------------------------------------------------+-- Streaming with arbitrary chunking. A pipe hands io-streams whatever is in+-- the buffer at read time, down to a single byte, so the streaming code must+-- produce the same output for every way of cutting the input into chunks.++-- | Cut the input into chunks of the given sizes; whatever the sizes don't+-- cover becomes one final chunk. Non-positive sizes are skipped.+chunksOf :: [Int] -> B.ByteString -> [B.ByteString]+chunksOf _ bs | B.null bs = []+chunksOf [] bs = [bs]+chunksOf (n:ns) bs+  | n <= 0    = chunksOf ns bs+  | otherwise = let (h, t) = B.splitAt n bs in h : chunksOf ns t++-- | Chunk sizes biased towards slivers smaller than a block + HMAC.+newtype ChunkSizes = ChunkSizes [Int] deriving Show++instance Arbitrary ChunkSizes where+  arbitrary = ChunkSizes <$> listOf (frequency [(4, choose (1, 48)), (1, choose (49, 4096))])+  shrink (ChunkSizes xs) = ChunkSizes <$> shrink xs++chunkedRoundTrip :: B.ByteString -> [Int] -> [Int] -> B.ByteString -> IO B.ByteString+chunkedRoundTrip key encChunks decChunks plainText = do+  plainTextInS                      <- fromList (chunksOf encChunks plainText)+  (cipherTextOutS, flushCipherText) <- listOutputStream+  encryptStream key plainTextInS cipherTextOutS+  cipherText                        <- B.concat <$> flushCipherText+  cipherTextInS                     <- fromList (chunksOf decChunks cipherText)+  (plainTextOutS, flushPlainText)   <- listOutputStream+  decryptStream key cipherTextInS plainTextOutS+  B.concat <$> flushPlainText++testChunkedStreamingRoundtrip :: UserInput -> ChunkSizes -> ChunkSizes -> ArbByteString -> Property+testChunkedStreamingRoundtrip pwd (ChunkSizes encChunks) (ChunkSizes decChunks) input =+  B.length (unInput pwd) > 0 ==> M.monadicIO $ do+    let plainText = fromABS input+    input' <- M.run (chunkedRoundTrip (unInput pwd) encChunks decChunks plainText)+    M.assert (plainText == input')++testOneByteChunks :: Assertion+testOneByteChunks = do+  let plainText = C8.pack (take 1000 (cycle ['a'..'z']))+      ones      = repeat 1+  input' <- chunkedRoundTrip "password" ones ones plainText+  input' @?= plainText++-- The final chunk is exactly the 32-byte HMAC, so the last cipher block+-- arrives in the chunk before it.+testHMACAsFinalChunk :: Assertion+testHMACAsFinalChunk = do+  let plainText = C8.pack (take 1000 (cycle ['a'..'z']))+  plainTextInS                      <- fromByteString plainText+  (cipherTextOutS, flushCipherText) <- listOutputStream+  encryptStream "password" plainTextInS cipherTextOutS+  cipherText                        <- B.concat <$> flushCipherText+  cipherTextInS                     <- fromList (chunksOf [B.length cipherText - 32] cipherText)+  (plainTextOutS, flushPlainText)   <- listOutputStream+  decryptStream "password" cipherTextInS plainTextOutS+  input'                            <- B.concat <$> flushPlainText+  input' @?= plainText