rncryptor 0.0.1.0 → 0.0.2.0
raw patch · 8 files changed
+402/−203 lines, 8 filesdep +randomdep −base64-bytestringdep ~basedep ~bytestringdep ~cipher-aesnew-component:exe:rncryptor-decryptnew-component:exe:rncryptor-encryptPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: random
Dependencies removed: base64-bytestring
Dependency ranges changed: base, bytestring, cipher-aes, io-streams
API changes (from Hackage documentation)
- Crypto.RNCryptor.V3: decrypt :: ByteString -> ByteString -> ByteString
- Crypto.RNCryptor.V3: decryptBlock :: RNCryptorContext -> ByteString -> (RNCryptorContext, ByteString)
- Crypto.RNCryptor.V3: decryptStream :: ByteString -> InputStream ByteString -> OutputStream ByteString -> IO ()
- Crypto.RNCryptor.V3: instance Eq DecryptionState
- Crypto.RNCryptor.V3: instance Show DecryptionState
- Crypto.RNCryptor.V3: parseHeader :: ByteString -> RNCryptorHeader
- Crypto.RNCryptor.V3: pkcs7Padding :: Int -> Int -> ByteString
+ Crypto.RNCryptor.Padding: pkcs7Padding :: Int -> Int -> ByteString
+ Crypto.RNCryptor.Types: blockSize :: Int
+ Crypto.RNCryptor.Types: newRNCryptorHeader :: ByteString -> IO RNCryptorHeader
+ Crypto.RNCryptor.Types: renderRNCryptorHeader :: RNCryptorHeader -> ByteString
+ Crypto.RNCryptor.V3.Decrypt: decrypt :: ByteString -> ByteString -> ByteString
+ Crypto.RNCryptor.V3.Decrypt: decryptBlock :: RNCryptorContext -> ByteString -> (RNCryptorContext, ByteString)
+ Crypto.RNCryptor.V3.Decrypt: decryptStream :: ByteString -> InputStream ByteString -> OutputStream ByteString -> IO ()
+ Crypto.RNCryptor.V3.Decrypt: instance Eq DecryptionState
+ Crypto.RNCryptor.V3.Decrypt: instance Show DecryptionState
+ Crypto.RNCryptor.V3.Decrypt: parseHeader :: ByteString -> RNCryptorHeader
+ Crypto.RNCryptor.V3.Encrypt: encrypt :: RNCryptorContext -> ByteString -> ByteString
+ Crypto.RNCryptor.V3.Encrypt: encryptBlock :: RNCryptorContext -> ByteString -> (RNCryptorContext, ByteString)
+ Crypto.RNCryptor.V3.Encrypt: encryptStream :: ByteString -> InputStream ByteString -> OutputStream ByteString -> IO ()
+ Crypto.RNCryptor.V3.Encrypt: instance Eq EncryptionState
+ Crypto.RNCryptor.V3.Encrypt: instance Show EncryptionState
+ Crypto.RNCryptor.V3.Encrypt: pkcs7Padding :: Int -> Int -> ByteString
- Crypto.RNCryptor.Types: RNCryptorHeader :: !Word8 -> !Word8 -> !ByteString -> !ByteString -> !AESIV -> (ByteString -> ByteString) -> RNCryptorHeader
+ Crypto.RNCryptor.Types: RNCryptorHeader :: !Word8 -> !Word8 -> !ByteString -> !ByteString -> !ByteString -> (ByteString -> ByteString) -> RNCryptorHeader
- Crypto.RNCryptor.Types: rncIV :: RNCryptorHeader -> !AESIV
+ Crypto.RNCryptor.Types: rncIV :: RNCryptorHeader -> !ByteString
Files
- example/StreamingDecrypter.hs +2/−2
- example/StreamingEncrypter.hs +14/−0
- rncryptor.cabal +22/−4
- src/Crypto/RNCryptor/Padding.hs +19/−0
- src/Crypto/RNCryptor/Types.hs +48/−3
- src/Crypto/RNCryptor/V3.hs +6/−194
- src/Crypto/RNCryptor/V3/Decrypt.hs +185/−0
- src/Crypto/RNCryptor/V3/Encrypt.hs +106/−0
example/StreamingDecrypter.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Crypto.RNCryptor.V3+import Crypto.RNCryptor.V3.Decrypt import qualified System.IO.Streams as S import System.Environment import qualified Data.ByteString.Char8 as B@@ -11,4 +11,4 @@ args <- getArgs case args of key:_ -> decryptStream (B.pack key) S.stdin S.stdout- _ -> putStrLn "usage: rncryptor-stream <key>"+ _ -> putStrLn "usage: rncryptor-decrypt <key>"
+ example/StreamingEncrypter.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Crypto.RNCryptor.V3.Encrypt+import qualified System.IO.Streams as S+import System.Environment+import qualified Data.ByteString.Char8 as B++main :: IO ()+main = do+ args <- getArgs+ case args of+ key:_ -> encryptStream (B.pack key) S.stdin S.stdout+ _ -> putStrLn "usage: rncryptor-encrypt <key>"
rncryptor.cabal view
@@ -1,5 +1,5 @@ name: rncryptor-version: 0.0.1.0+version: 0.0.2.0 synopsis: Haskell implementation of the RNCryptor file format description: Pure Haskell implementation of the RNCrytor spec. license: MIT@@ -17,14 +17,17 @@ library exposed-modules:+ Crypto.RNCryptor.Padding Crypto.RNCryptor.V3+ Crypto.RNCryptor.V3.Encrypt+ Crypto.RNCryptor.V3.Decrypt Crypto.RNCryptor.Types other-modules: build-depends: base >=4.6 && < 5 , bytestring >= 0.9.0 , mtl >= 2.1- , base64-bytestring >= 1.0.0.1+ , random >= 1.0.0.1 , QuickCheck >= 2.6 && < 2.8 , io-streams >= 1.2.0.0 , cipher-aes >= 0.2.0@@ -56,18 +59,33 @@ , tasty-quickcheck , tasty-hunit -executable rncryptor-stream+executable rncryptor-decrypt build-depends: base , bytestring , io-streams- , base64-bytestring , cipher-aes , rncryptor -any hs-source-dirs: example main-is: StreamingDecrypter.hs+ default-language:+ Haskell2010+ ghc-options:+ -funbox-strict-fields++executable rncryptor-encrypt+ build-depends:+ base+ , bytestring+ , io-streams+ , cipher-aes+ , rncryptor -any+ hs-source-dirs:+ example+ main-is:+ StreamingEncrypter.hs default-language: Haskell2010 ghc-options:
+ src/Crypto/RNCryptor/Padding.hs view
@@ -0,0 +1,19 @@+module Crypto.RNCryptor.Padding+ ( pkcs7Padding ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+++--------------------------------------------------------------------------------+-- | Computes the padding as per PKCS#7. The specification can be found +-- here: <http://tools.ietf.org/html/rfc5652#section-6.3>+pkcs7Padding :: Int+ -- ^ The block size (e.g. 16 bytes)+ -> Int+ -- ^ The input size+ -> ByteString+ -- ^ The resulting padding+pkcs7Padding k l =+ let octetsSize = k - (l `rem` k)+ in B.pack $ replicate octetsSize (fromIntegral octetsSize)
src/Crypto/RNCryptor/Types.hs view
@@ -1,12 +1,20 @@-+{-# LANGUAGE RecordWildCards #-} module Crypto.RNCryptor.Types ( RNCryptorHeader(..) , RNCryptorContext(ctxHeader, ctxCipher) , newRNCryptorContext+ , newRNCryptorHeader+ , renderRNCryptorHeader+ , blockSize ) where -import Data.ByteString (ByteString)+import Data.ByteString (cons, ByteString)+import qualified Data.ByteString.Char8 as C8 import Data.Word+import Data.Monoid+import System.Random+import Control.Applicative+import Control.Monad import Crypto.Cipher.AES import Crypto.PBKDF.ByteString @@ -20,7 +28,7 @@ -- ^ iff option includes "uses password" , rncHMACSalt :: !ByteString -- ^ iff options includes "uses password"- , rncIV :: !AESIV+ , rncIV :: !ByteString -- ^ The initialisation vector -- The ciphertext is variable and encrypted in CBC mode , rncHMAC :: (ByteString -> ByteString)@@ -28,6 +36,43 @@ -- as the HMAC is at the end of the file. } +--------------------------------------------------------------------------------+saltSize :: Int+saltSize = 8++--------------------------------------------------------------------------------+blockSize :: Int+blockSize = 16++--------------------------------------------------------------------------------+randomSaltIO :: Int -> IO ByteString+randomSaltIO sz = C8.pack <$> forM [1 .. sz] (const $ randomRIO ('\NUL', '\255'))++--------------------------------------------------------------------------------+-- | Generates a new 'RNCryptorHeader', suitable for encryption.+newRNCryptorHeader :: ByteString -> IO RNCryptorHeader+newRNCryptorHeader userKey = do+ let version = toEnum 3+ let options = toEnum 1+ eSalt <- randomSaltIO saltSize+ iv <- randomSaltIO blockSize+ hmacSalt <- randomSaltIO saltSize+ return RNCryptorHeader {+ rncVersion = version+ , rncOptions = options+ , rncEncryptionSalt = eSalt+ , rncHMACSalt = hmacSalt+ , rncIV = iv+ , rncHMAC = const $ sha1PBKDF2 userKey hmacSalt 10000 32+ }++--------------------------------------------------------------------------------+-- | Concatenates this 'RNCryptorHeader' into a raw sequence of bytes, up to the+-- IV. This means you need to append the ciphertext plus the HMAC to finalise +-- the encrypted file.+renderRNCryptorHeader :: RNCryptorHeader -> ByteString+renderRNCryptorHeader RNCryptorHeader{..} =+ rncVersion `cons` rncOptions `cons` (rncEncryptionSalt <> rncHMACSalt <> rncIV) -------------------------------------------------------------------------------- -- A convenient datatype to avoid carrying around the AES cypher,
src/Crypto/RNCryptor/V3.hs view
@@ -1,196 +1,8 @@-{-# LANGUAGE BangPatterns #-}-module Crypto.RNCryptor.V3- ( pkcs7Padding- , parseHeader- , decrypt- , decryptBlock- , decryptStream+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+module Crypto.RNCryptor.V3 (+ module Crypto.RNCryptor.V3.Encrypt+ , module Crypto.RNCryptor.V3.Decrypt ) where -import Data.ByteString (ByteString)-import qualified Data.ByteString as B-import Data.Word-import Control.Monad.State-import Crypto.RNCryptor.Types-import Crypto.Cipher.AES-import Data.Monoid-import qualified System.IO.Streams as S-------------------------------------------------------------------------------------- | Computes the padding as per PKCS#7. The specification can be found --- here: http://tools.ietf.org/html/rfc5652#section-6.3-pkcs7Padding :: Int- -- ^ The block size (e.g. 16 bytes)- -> Int- -- ^ The input size- -> ByteString- -- ^ The resulting padding-pkcs7Padding k l =- let octetsSize = k - (l `mod` k)- in B.pack $ replicate octetsSize (fromInteger . toInteger $ octetsSize)------------------------------------------------------------------------------------- | Parse the input 'ByteString' to extract the 'RNCryptorHeader', as --- defined in the V3 spec. The incoming 'ByteString' is expected to have--- at least 34 bytes available. As the HMAC can be found only at the very--- end of an encrypted file, 'RNCryptorHeader' provides by default a function--- to parse the HMAC, callable at the right time during streaming/parsing.-parseHeader :: ByteString -> RNCryptorHeader-parseHeader input = flip evalState input $ do- v <- parseVersion- o <- parseOptions- eSalt <- parseEncryptionSalt- hmacSalt <- parseHMACSalt- iv <- parseIV- return RNCryptorHeader {- rncVersion = v- , rncOptions = o- , rncEncryptionSalt = eSalt- , rncHMACSalt = hmacSalt- , rncIV = iv- , rncHMAC = parseHMAC- }-----------------------------------------------------------------------------------parseSingleWord8 :: String -> State ByteString Word8-parseSingleWord8 err = do- bs <- get- let (v,vs) = B.splitAt 1 bs- put vs- case B.unpack v of- x:[] -> return x- _ -> fail err-----------------------------------------------------------------------------------parseBSOfSize :: Int -> String -> State ByteString ByteString-parseBSOfSize sz err = do- bs <- get- let (v,vs) = B.splitAt sz bs- put vs- case B.unpack v of- [] -> fail err- _ -> return v-----------------------------------------------------------------------------------parseVersion :: State ByteString Word8-parseVersion = parseSingleWord8 "parseVersion: not enough bytes."-----------------------------------------------------------------------------------parseOptions :: State ByteString Word8-parseOptions = parseSingleWord8 "parseOptions: not enough bytes."-----------------------------------------------------------------------------------parseEncryptionSalt :: State ByteString ByteString-parseEncryptionSalt = parseBSOfSize 8 "parseEncryptionSalt: not enough bytes."-----------------------------------------------------------------------------------parseHMACSalt :: State ByteString ByteString-parseHMACSalt = parseBSOfSize 8 "parseHMACSalt: not enough bytes."-----------------------------------------------------------------------------------parseIV :: State ByteString AESIV-parseIV = fmap aesIV_ (parseBSOfSize 16 "parseIV: not enough bytes.")-----------------------------------------------------------------------------------parseHMAC :: ByteString -> ByteString-parseHMAC leftover = flip evalState leftover $ parseBSOfSize 32 "parseHMAC: not enough bytes."-----------------------------------------------------------------------------------blockSize :: Int-blockSize = 16------------------------------------------------------------------------------------- | This was taken directly from the Python implementation, see "post_decrypt_data",--- even though it doesn't seem to be a usual PKCS#7 removal:--- 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------------------------------------------------------------------------------------- | Decrypt a raw Bytestring block. The function returns the clear text block--- plus a new 'RNCryptorContext', which is needed because the IV needs to be--- set to the last 16 bytes of the previous cipher text. (Thanks to Rob Napier--- for the insight).-decryptBlock :: RNCryptorContext- -> ByteString- -> (RNCryptorContext, ByteString)-decryptBlock ctx cipherText = - let clearText = decryptCBC (ctxCipher ctx) (rncIV . ctxHeader $ ctx) cipherText- !sz = B.length cipherText- !newHeader = (ctxHeader ctx) { rncIV = aesIV_ (B.drop (sz - 16) cipherText) }- in (ctx { ctxHeader = newHeader }, clearText)------------------------------------------------------------------------------------- | Decrypt an encrypted message. Please be aware that this is a user-friendly--- but dangerous function, in the sense that it will load the *ENTIRE* input in--- memory. It's mostly suitable for small inputs like passwords. For large--- inputs, where size exceeds the available memory, please use 'decryptStream'.-decrypt :: ByteString -> ByteString -> ByteString-decrypt input pwd =- let (rawHdr, rest) = B.splitAt 34 input- -- remove the hmac at the end of the file- (toDecrypt, _) = B.splitAt (B.length rest - 32) rest- hdr = parseHeader rawHdr- ctx = newRNCryptorContext pwd hdr- clearText = decryptCBC (ctxCipher ctx) (rncIV . ctxHeader $ ctx) toDecrypt- in removePaddingSymbols clearText-------------------------------------------------------------------------------------- | The 'DecryptionState' 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 DecryptionState =- Continue- | FetchLeftOver !Int- | DrainSource deriving (Show, Eq)-----------------------------------------------------------------------------------decryptStream :: ByteString- -> S.InputStream ByteString- -> S.OutputStream ByteString- -> IO ()-decryptStream userKey inS outS = do- rawHdr <- S.readExactly 34 inS- let hdr = parseHeader rawHdr- let ctx = newRNCryptorContext userKey hdr- go Continue mempty ctx- where- slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize)-- go :: DecryptionState -> 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 -> finaliseDecryption 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 -> finaliseDecryption (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 decrypt this chunk- let (toDecrypt, rest) = B.splitAt (sz - sl) v- let (newCtx, clearT) = decryptBlock ctx toDecrypt- S.write (Just $ clearT) outS- S.unRead rest inS- go (FetchLeftOver sl) iBuffer newCtx-- finaliseDecryption lastBlock ctx = do- let (rest, _) = B.splitAt (B.length lastBlock - 32) lastBlock --strip the hmac- S.write (Just $ removePaddingSymbols (snd $ decryptBlock ctx rest)) outS+import Crypto.RNCryptor.V3.Encrypt+import Crypto.RNCryptor.V3.Decrypt
+ src/Crypto/RNCryptor/V3/Decrypt.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE BangPatterns #-}+module Crypto.RNCryptor.V3.Decrypt+ ( parseHeader+ , decrypt+ , decryptBlock+ , decryptStream+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Data.Word+import Control.Monad.State+import Crypto.RNCryptor.Types+import Crypto.Cipher.AES+import Data.Monoid+import qualified System.IO.Streams as S+++--------------------------------------------------------------------------------+-- | Parse the input 'ByteString' to extract the 'RNCryptorHeader', as +-- defined in the V3 spec. The incoming 'ByteString' is expected to have+-- at least 34 bytes available. As the HMAC can be found only at the very+-- end of an encrypted file, 'RNCryptorHeader' provides by default a function+-- to parse the HMAC, callable at the right time during streaming/parsing.+parseHeader :: ByteString -> RNCryptorHeader+parseHeader input = flip evalState input $ do+ v <- parseVersion+ o <- parseOptions+ eSalt <- parseEncryptionSalt+ hmacSalt <- parseHMACSalt+ iv <- parseIV+ return RNCryptorHeader {+ rncVersion = v+ , rncOptions = o+ , rncEncryptionSalt = eSalt+ , rncHMACSalt = hmacSalt+ , rncIV = iv+ , rncHMAC = parseHMAC+ }++--------------------------------------------------------------------------------+parseSingleWord8 :: String -> State ByteString Word8+parseSingleWord8 err = do+ bs <- get+ let (v,vs) = B.splitAt 1 bs+ put vs+ case B.unpack v of+ x:[] -> return x+ _ -> fail err++--------------------------------------------------------------------------------+parseBSOfSize :: Int -> String -> State ByteString ByteString+parseBSOfSize sz err = do+ bs <- get+ let (v,vs) = B.splitAt sz bs+ put vs+ case B.unpack v of+ [] -> fail err+ _ -> return v++--------------------------------------------------------------------------------+parseVersion :: State ByteString Word8+parseVersion = parseSingleWord8 "parseVersion: not enough bytes."++--------------------------------------------------------------------------------+parseOptions :: State ByteString Word8+parseOptions = parseSingleWord8 "parseOptions: not enough bytes."++--------------------------------------------------------------------------------+parseEncryptionSalt :: State ByteString ByteString+parseEncryptionSalt = parseBSOfSize 8 "parseEncryptionSalt: not enough bytes."++--------------------------------------------------------------------------------+parseHMACSalt :: State ByteString ByteString+parseHMACSalt = parseBSOfSize 8 "parseHMACSalt: not enough bytes."++--------------------------------------------------------------------------------+parseIV :: State ByteString ByteString+parseIV = parseBSOfSize 16 "parseIV: not enough bytes."++--------------------------------------------------------------------------------+parseHMAC :: ByteString -> ByteString+parseHMAC leftover = flip evalState leftover $ parseBSOfSize 32 "parseHMAC: not enough bytes."++--------------------------------------------------------------------------------+-- | This was taken directly from the Python implementation, see "post_decrypt_data",+-- even though it doesn't seem to be a usual PKCS#7 removal:+-- 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++--------------------------------------------------------------------------------+-- | Decrypt a raw Bytestring block. The function returns the clear text block+-- plus a new 'RNCryptorContext', which is needed because the IV needs to be+-- set to the last 16 bytes of the previous cipher text. (Thanks to Rob Napier+-- for the insight).+decryptBlock :: RNCryptorContext+ -> ByteString+ -> (RNCryptorContext, ByteString)+decryptBlock ctx cipherText = + let clearText = decryptCBC (ctxCipher ctx) (aesIV_ . rncIV . ctxHeader $ ctx) cipherText+ !sz = B.length cipherText+ !newHeader = (ctxHeader ctx) { rncIV = (B.drop (sz - 16) cipherText) }+ in (ctx { ctxHeader = newHeader }, clearText)++--------------------------------------------------------------------------------+-- | Decrypt an encrypted message. Please be aware that this is a user-friendly+-- but dangerous function, in the sense that it will load the *ENTIRE* input in+-- memory. It's mostly suitable for small inputs like passwords. For large+-- inputs, where size exceeds the available memory, please use 'decryptStream'.+decrypt :: ByteString -> ByteString -> ByteString+decrypt input pwd =+ let (rawHdr, rest) = B.splitAt 34 input+ -- remove the hmac at the end of the file+ (toDecrypt, _) = B.splitAt (B.length rest - 32) rest+ hdr = parseHeader rawHdr+ ctx = newRNCryptorContext pwd hdr+ clearText = decryptCBC (ctxCipher ctx) (aesIV_ . rncIV . ctxHeader $ ctx) toDecrypt+ in removePaddingSymbols clearText+++--------------------------------------------------------------------------------+-- | The 'DecryptionState' 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 DecryptionState =+ Continue+ | FetchLeftOver !Int+ | DrainSource deriving (Show, Eq)++--------------------------------------------------------------------------------+-- | 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+ rawHdr <- S.readExactly 34 inS+ let hdr = parseHeader rawHdr+ let ctx = newRNCryptorContext userKey hdr+ go Continue mempty ctx+ where+ slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize)++ go :: DecryptionState -> 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 -> finaliseDecryption 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 -> finaliseDecryption (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 decrypt this chunk+ let (toDecrypt, rest) = B.splitAt (sz - sl) v+ let (newCtx, clearT) = decryptBlock ctx toDecrypt+ S.write (Just clearT) outS+ case sl == 0 of+ False -> do+ S.unRead rest inS+ go (FetchLeftOver sl) iBuffer newCtx+ True -> go Continue iBuffer newCtx++ finaliseDecryption lastBlock ctx = do+ let (rest, _) = B.splitAt (B.length lastBlock - 32) lastBlock --strip the hmac+ S.write (Just $ removePaddingSymbols (snd $ decryptBlock ctx rest)) outS
+ src/Crypto/RNCryptor/V3/Encrypt.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE BangPatterns #-}+module Crypto.RNCryptor.V3.Encrypt+ ( pkcs7Padding+ , encrypt+ , encryptBlock+ , encryptStream+ ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import Crypto.RNCryptor.Types+import Crypto.RNCryptor.Padding+import Crypto.Cipher.AES+import Data.Monoid+import qualified System.IO.Streams as S+++--------------------------------------------------------------------------------+-- | Encrypt a raw Bytestring block. The function returns the encrypt text block+-- plus a new 'RNCryptorContext', which is needed because the IV needs to be+-- set to the last 16 bytes of the previous cipher text. (Thanks to Rob Napier+-- for the insight).+encryptBlock :: RNCryptorContext+ -> ByteString+ -> (RNCryptorContext, ByteString)+encryptBlock ctx clearText = + let cipherText = encryptCBC (ctxCipher ctx) (rncIV . ctxHeader $ ctx) clearText+ !sz = B.length clearText+ !newHeader = (ctxHeader ctx) { rncIV = (B.drop (sz - 16) clearText) }+ in (ctx { ctxHeader = newHeader }, cipherText)++--------------------------------------------------------------------------------+-- | Encrypt a message. Please be aware that this is a user-friendly+-- but dangerous function, in the sense that it will load the *ENTIRE* input in+-- memory. It's mostly suitable for small inputs like passwords. For large+-- inputs, where size exceeds the available memory, please use 'encryptStream'.+encrypt :: RNCryptorContext -> ByteString -> ByteString+encrypt ctx input =+ let hdr = ctxHeader ctx+ inSz = B.length input+ (_, clearText) = encryptBlock ctx (input <> pkcs7Padding blockSize inSz)+ in renderRNCryptorHeader hdr <> clearText <> (rncHMAC hdr $ mempty)+++--------------------------------------------------------------------------------+-- | The 'EncryptionState' 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 EncryptionState =+ Continue+ | FetchLeftOver !Int+ | DrainSource deriving (Show, Eq)++--------------------------------------------------------------------------------+-- | Efficiently encrypt an incoming stream of bytes.+encryptStream :: 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 ()+encryptStream userKey inS outS = do+ hdr <- newRNCryptorHeader userKey+ let ctx = newRNCryptorContext userKey hdr+ S.write (Just $ renderRNCryptorHeader hdr) outS+ go Continue mempty ctx+ where+ slack input = let bsL = B.length input in (bsL, bsL `mod` blockSize)++ go :: EncryptionState -> 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 -> finaliseEncryption 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 -> finaliseEncryption (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 decrypt this chunk+ let (toEncrypt, rest) = B.splitAt (sz - sl) v+ let (newCtx, cryptoB) = encryptBlock ctx toEncrypt+ S.write (Just cryptoB) outS+ case sl == 0 of+ False -> do+ S.unRead rest inS+ go (FetchLeftOver sl) iBuffer newCtx+ True -> go Continue iBuffer newCtx++ finaliseEncryption lastBlock ctx = do+ let inSz = B.length lastBlock+ padding = pkcs7Padding blockSize inSz+ S.write (Just (snd $ encryptBlock ctx (lastBlock <> padding))) outS