From 2a26202a32a0e2ff9c786e10314f940216ff19bd Mon Sep 17 00:00:00 2001 From: Lars Petersen Date: Thu, 14 Mar 2019 20:19:35 +0100 Subject: [PATCH] Add implementation of bcrypt_pbkdf --- Crypto/Cipher/Blowfish/Box.hs | 16 ++- Crypto/Cipher/Blowfish/Primitive.hs | 1 + Crypto/KDF/BCryptPBKDF.hs | 187 ++++++++++++++++++++++++++++ cryptonite.cabal | 4 +- tests/BCryptPBKDF.hs | 75 +++++++++++ tests/Tests.hs | 2 + 6 files changed, 283 insertions(+), 2 deletions(-) create mode 100644 Crypto/KDF/BCryptPBKDF.hs create mode 100644 tests/BCryptPBKDF.hs diff --git a/Crypto/Cipher/Blowfish/Box.hs b/Crypto/Cipher/Blowfish/Box.hs index 34414a7..62f1adc 100644 --- a/Crypto/Cipher/Blowfish/Box.hs +++ b/Crypto/Cipher/Blowfish/Box.hs @@ -7,13 +7,27 @@ module Crypto.Cipher.Blowfish.Box ( KeySchedule(..) , createKeySchedule + , copyKeySchedule ) where import Crypto.Internal.WordArray (MutableArray32, - mutableArray32FromAddrBE) + mutableArray32FromAddrBE, + mutableArrayRead32, + mutableArrayWrite32) newtype KeySchedule = KeySchedule MutableArray32 +-- | Copy the state of one key schedule into the other. +-- The first parameter is the destination and the second the source. +copyKeySchedule :: KeySchedule -> KeySchedule -> IO () +copyKeySchedule (KeySchedule dst) (KeySchedule src) = loop 0 + where + loop 1042 = return () + loop i = do + w32 <-mutableArrayRead32 src i + mutableArrayWrite32 dst i w32 + loop (i + 1) + -- | Create a key schedule mutable array of the pbox followed by -- all the sboxes. createKeySchedule :: IO KeySchedule diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index b3708cd..8ce7cbe 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -22,6 +22,7 @@ module Crypto.Cipher.Blowfish.Primitive , freezeKeySchedule , expandKey , expandKeyWithSalt + , cipherBlockMutable ) where import Control.Monad (when) diff --git a/Crypto/KDF/BCryptPBKDF.hs b/Crypto/KDF/BCryptPBKDF.hs new file mode 100644 index 0000000..7a2fa8b --- /dev/null +++ b/Crypto/KDF/BCryptPBKDF.hs @@ -0,0 +1,187 @@ +-- | +-- Module : Crypto.KDF.BCryptPBKDF +-- License : BSD-style +-- Stability : experimental +-- Portability : Good +-- +-- Port of the bcrypt_pbkdf key derivation function from OpenBSD +-- as described at . +module Crypto.KDF.BCryptPBKDF + ( Parameters (..) + , generate + , hashInternal + ) +where + +import Basement.Block (MutableBlock) +import qualified Basement.Block as Block +import qualified Basement.Block.Mutable as Block +import Basement.Monad (PrimState) +import Basement.Types.OffsetSize (CountOf (..), Offset (..)) +import Control.Exception (finally) +import Control.Monad (when) +import qualified Crypto.Cipher.Blowfish.Box as Blowfish +import qualified Crypto.Cipher.Blowfish.Primitive as Blowfish +import Crypto.Hash.Algorithms (SHA512 (..)) +import Crypto.Hash.Types (Context, + hashDigestSize, + hashInternalContextSize, + hashInternalFinalize, + hashInternalInit, + hashInternalUpdate) +import Crypto.Internal.Compat (unsafeDoIO) +import Data.Bits +import qualified Data.ByteArray as B +import Data.Foldable (forM_) +import Data.Memory.PtrMethods (memCopy, memSet, memXor) +import Data.Word +import Foreign.Ptr (Ptr, castPtr) +import Foreign.Storable (peekByteOff, pokeByteOff) + +data Parameters = Parameters + { iterCounts :: Int -- ^ The number of user-defined iterations for the algorithm + -- (must be > 0) + , outputLength :: Int -- ^ The number of bytes to generate out of BCryptPBKDF + -- (must be in 1..1024) + } deriving (Eq, Ord, Show) + +-- | Derive a key of specified length using the bcrypt_pbkdf algorithm. +generate :: (B.ByteArray pass, B.ByteArray salt, B.ByteArray output) + => Parameters + -> pass + -> salt + -> output +generate params pass salt + | iterCounts params < 1 = error "BCryptPBKDF: iterCounts must be > 0" + | keyLen < 1 || keyLen > 1024 = error "BCryptPBKDF: outputLength must be in 1..1024" + | otherwise = B.unsafeCreate keyLen deriveKey + where + outLen, tmpLen, blkLen, keyLen, passLen, saltLen, ctxLen, hashLen, blocks :: Int + outLen = 32 + tmpLen = 32 + blkLen = 4 + passLen = B.length pass + saltLen = B.length salt + keyLen = outputLength params + ctxLen = hashInternalContextSize SHA512 + hashLen = hashDigestSize SHA512 -- 64 + blocks = (keyLen + outLen - 1) `div` outLen + + deriveKey :: Ptr Word8 -> IO () + deriveKey keyPtr = do + -- Allocate all necessary memory. The algorihm shall not allocate + -- any more dynamic memory after this point. Blocks need to be pinned + -- as pointers to them are passed to the SHA512 implementation. + ksClean <- Blowfish.createKeySchedule + ksDirty <- Blowfish.createKeySchedule + ctxMBlock <- Block.newPinned (CountOf ctxLen :: CountOf Word8) + outMBlock <- Block.newPinned (CountOf outLen :: CountOf Word8) + tmpMBlock <- Block.newPinned (CountOf tmpLen :: CountOf Word8) + blkMBlock <- Block.newPinned (CountOf blkLen :: CountOf Word8) + passHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8) + saltHashMBlock <- Block.newPinned (CountOf hashLen :: CountOf Word8) + -- Finally erase all memory areas that contain information from + -- which the derived key could be reconstructed. + -- As all MutableBlocks are pinned it shall be guaranteed that + -- no temporary trampoline buffers are allocated. + finallyErase outMBlock $ finallyErase passHashMBlock $ + B.withByteArray pass $ \passPtr-> + B.withByteArray salt $ \saltPtr-> + Block.withMutablePtr ctxMBlock $ \ctxPtr-> + Block.withMutablePtr outMBlock $ \outPtr-> + Block.withMutablePtr tmpMBlock $ \tmpPtr-> + Block.withMutablePtr blkMBlock $ \blkPtr-> + Block.withMutablePtr passHashMBlock $ \passHashPtr-> + Block.withMutablePtr saltHashMBlock $ \saltHashPtr-> do + -- Hash the password. + let shaPtr = castPtr ctxPtr :: Ptr (Context SHA512) + hashInternalInit shaPtr + hashInternalUpdate shaPtr passPtr (fromIntegral passLen) + hashInternalFinalize shaPtr (castPtr passHashPtr) + passHashBlock <- Block.unsafeFreeze passHashMBlock + forM_ [1..blocks] $ \block-> do + -- Poke the increased block counter. + Block.unsafeWrite blkMBlock 0 (fromIntegral $ block `shiftR` 24) + Block.unsafeWrite blkMBlock 1 (fromIntegral $ block `shiftR` 16) + Block.unsafeWrite blkMBlock 2 (fromIntegral $ block `shiftR` 8) + Block.unsafeWrite blkMBlock 3 (fromIntegral $ block `shiftR` 0) + -- First round (slightly different). + hashInternalInit shaPtr + hashInternalUpdate shaPtr saltPtr (fromIntegral saltLen) + hashInternalUpdate shaPtr blkPtr (fromIntegral blkLen) + hashInternalFinalize shaPtr (castPtr saltHashPtr) + Block.unsafeFreeze saltHashMBlock >>= \x-> do + Blowfish.copyKeySchedule ksDirty ksClean + hashInternalMutable ksDirty passHashBlock x tmpMBlock + memCopy outPtr tmpPtr outLen + -- Remaining rounds. + forM_ [2..iterCounts params] $ const $ do + hashInternalInit shaPtr + hashInternalUpdate shaPtr tmpPtr (fromIntegral tmpLen) + hashInternalFinalize shaPtr (castPtr saltHashPtr) + Block.unsafeFreeze saltHashMBlock >>= \x-> do + Blowfish.copyKeySchedule ksDirty ksClean + hashInternalMutable ksDirty passHashBlock x tmpMBlock + memXor outPtr outPtr tmpPtr outLen + -- Spread the current out buffer evenly over the key buffer. + -- After both loops have run every byte of the key buffer + -- will have been written to exactly once and every byte + -- of the output will have been used. + forM_ [0..outLen - 1] $ \outIdx-> do + let keyIdx = outIdx * blocks + block - 1 + when (keyIdx < keyLen) $ do + w8 <- peekByteOff outPtr outIdx :: IO Word8 + pokeByteOff keyPtr keyIdx w8 + +-- | Internal hash function used by `generate`. +-- +-- Normal users should not need this. +hashInternal :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt, B.ByteArray output) + => pass + -> salt + -> output +hashInternal passHash saltHash + | B.length passHash /= 64 = error "passHash must be 512 bits" + | B.length saltHash /= 64 = error "saltHash must be 512 bits" + | otherwise = unsafeDoIO $ do + ks0 <- Blowfish.createKeySchedule + outMBlock <- Block.newPinned 32 + hashInternalMutable ks0 passHash saltHash outMBlock + B.convert `fmap` Block.freeze outMBlock + +hashInternalMutable :: (B.ByteArrayAccess pass, B.ByteArrayAccess salt) + => Blowfish.KeySchedule + -> pass + -> salt + -> MutableBlock Word8 (PrimState IO) + -> IO () +hashInternalMutable bfks passHash saltHash outMBlock = do + Blowfish.expandKeyWithSalt bfks passHash saltHash + forM_ [0..63 :: Int] $ const $ do + Blowfish.expandKey bfks saltHash + Blowfish.expandKey bfks passHash + -- "OxychromaticBlowfishSwatDynamite" represented as 4 Word64 in big-endian. + store 0 =<< cipher 64 0x4f78796368726f6d + store 8 =<< cipher 64 0x61746963426c6f77 + store 16 =<< cipher 64 0x6669736853776174 + store 24 =<< cipher 64 0x44796e616d697465 + where + store :: Offset Word8 -> Word64 -> IO () + store o w64 = do + Block.unsafeWrite outMBlock (o + 0) (fromIntegral $ w64 `shiftR` 32) + Block.unsafeWrite outMBlock (o + 1) (fromIntegral $ w64 `shiftR` 40) + Block.unsafeWrite outMBlock (o + 2) (fromIntegral $ w64 `shiftR` 48) + Block.unsafeWrite outMBlock (o + 3) (fromIntegral $ w64 `shiftR` 56) + Block.unsafeWrite outMBlock (o + 4) (fromIntegral $ w64 `shiftR` 0) + Block.unsafeWrite outMBlock (o + 5) (fromIntegral $ w64 `shiftR` 8) + Block.unsafeWrite outMBlock (o + 6) (fromIntegral $ w64 `shiftR` 16) + Block.unsafeWrite outMBlock (o + 7) (fromIntegral $ w64 `shiftR` 24) + cipher :: Int -> Word64 -> IO Word64 + cipher 0 block = return block + cipher i block = Blowfish.cipherBlockMutable bfks block >>= cipher (i - 1) + +finallyErase :: MutableBlock Word8 (PrimState IO) -> IO () -> IO () +finallyErase mblock action = + action `finally` Block.withMutablePtr mblock (\ptr-> memSet ptr 0 len) + where + CountOf len = Block.mutableLengthBytes mblock diff --git a/cryptonite.cabal b/cryptonite.cabal index c939c33..22f16c4 100644 --- a/cryptonite.cabal +++ b/cryptonite.cabal @@ -12,7 +12,7 @@ Description: . * Asymmetric crypto: DSA, RSA, DH, ECDH, ECDSA, ECC, Curve25519, Curve448, Ed25519, Ed448 . - * Key Derivation Function: PBKDF2, Scrypt, HKDF, Argon2 + * Key Derivation Function: PBKDF2, Scrypt, HKDF, Argon2, BCrypt, BCryptPBKDF . * Cryptographic Random generation: System Entropy, Deterministic Random Generator . @@ -138,6 +138,7 @@ Library Crypto.KDF.PBKDF2 Crypto.KDF.Scrypt Crypto.KDF.BCrypt + Crypto.KDF.BCryptPBKDF Crypto.KDF.HKDF Crypto.Hash Crypto.Hash.IO @@ -378,6 +379,7 @@ Test-Suite test-cryptonite Other-modules: BlockCipher ChaCha BCrypt + BCryptPBKDF ECC ECC.Edwards25519 Hash diff --git a/tests/BCryptPBKDF.hs b/tests/BCryptPBKDF.hs new file mode 100644 index 0000000..2554d80 --- /dev/null +++ b/tests/BCryptPBKDF.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE OverloadedStrings #-} + +module BCryptPBKDF (tests) where + +import qualified Data.ByteString as B + +import Test.Tasty +import Test.Tasty.HUnit + +import Crypto.KDF.BCryptPBKDF (Parameters (..), generate, + hashInternal) + +tests :: TestTree +tests = testGroup "BCryptPBKDF" + [ testGroup "generate" + [ testCase "1" generate1 + , testCase "2" generate2 + , testCase "3" generate3 + ] + , testGroup "hashInternal" + [ testCase "1" hashInternal1 + ] + ] + where + -- test vector taken from the go implementation by @dchest + generate1 = expected @=? generate params pass salt + where + params = Parameters 12 32 + pass = "password" :: B.ByteString + salt = "salt" :: B.ByteString + expected = B.pack + [ 0x1a, 0xe4, 0x2c, 0x05, 0xd4, 0x87, 0xbc, 0x02 + , 0xf6, 0x49, 0x21, 0xa4, 0xeb, 0xe4, 0xea, 0x93 + , 0xbc, 0xac, 0xfe, 0x13, 0x5f, 0xda, 0x99, 0x97 + , 0x4c, 0x06, 0xb7, 0xb0, 0x1f, 0xae, 0x14, 0x9a + ] :: B.ByteString + + -- test vector generated with the go implemenation by @dchest + generate2 = expected @=? generate params pass salt + where + params = Parameters 7 71 + pass = "DieWuerdeDesMenschenIstUnantastbar" :: B.ByteString + salt = "Tafelsalz" :: B.ByteString + expected = B.pack + [ 0x17, 0xb4, 0x76, 0xaa, 0xd7, 0x42, 0x33, 0x49 + , 0x5c, 0xe8, 0x79, 0x49, 0x15, 0x74, 0x4c, 0x71 + , 0xf9, 0x99, 0x66, 0x89, 0x7a, 0x60, 0xc3, 0x70 + , 0xb4, 0x3c, 0xa8, 0x83, 0x80, 0x5a, 0x56, 0xde + , 0x38, 0xbc, 0x51, 0x8c, 0xd4, 0xeb, 0xd1, 0xcf + , 0x46, 0x0a, 0x68, 0x3d, 0xc8, 0x12, 0xcf, 0xf8 + , 0x43, 0xce, 0x21, 0x9d, 0x98, 0x81, 0x20, 0x26 + , 0x6e, 0x42, 0x0f, 0xaa, 0x75, 0x5d, 0x09, 0x8d + , 0x45, 0xda, 0xd5, 0x15, 0x6e, 0x65, 0x1d + ] :: B.ByteString + + -- test vector generated with the go implemenation by @dchest + generate3 = expected @=? generate params pass salt + where + params = Parameters 5 5 + pass = "ABC" :: B.ByteString + salt = "DEF" :: B.ByteString + expected = B.pack + [ 0xdd, 0x6e, 0xa0, 0x69, 0x29 + ] :: B.ByteString + + hashInternal1 = expected @=? hashInternal passHash saltHash + where + passHash = B.pack [ 0 .. 63 ] :: B.ByteString + saltHash = B.pack [ 64 .. 127 ] :: B.ByteString + expected = B.pack + [ 0x87, 0x90, 0x48, 0x70, 0xee, 0xf9, 0xde, 0xdd + , 0xf8, 0xe7, 0x61, 0x1a, 0x14, 0x01, 0x06, 0xe6 + , 0xaa, 0xf1, 0xa3, 0x63, 0xd9, 0xa2, 0xc5, 0x04 + , 0xdb, 0x35, 0x64, 0x43, 0x72, 0x1e, 0xb5, 0x55 + ] :: B.ByteString diff --git a/tests/Tests.hs b/tests/Tests.hs index 2f973c9..bd64ecc 100644 --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -6,6 +6,7 @@ import Imports import qualified Number import qualified Number.F2m import qualified BCrypt +import qualified BCryptPBKDF import qualified ECC import qualified ECC.Edwards25519 import qualified Hash @@ -63,6 +64,7 @@ tests = testGroup "cryptonite" [ KAT_PBKDF2.tests , KAT_Scrypt.tests , BCrypt.tests + , BCryptPBKDF.tests , KAT_HKDF.tests , KAT_Argon2.tests ]