From 2566e461851c828b7055163a24d0a4ecdc61467f Mon Sep 17 00:00:00 2001 From: Luke Taylor Date: Tue, 11 Aug 2015 19:35:29 +0100 Subject: [PATCH] Implement the eksBlowfish function This modifies the standard blowfish key schedule function to accept an optional salt and cost as used in bcrypt and modifies the algorithm accordingly to implement the "expensive" version. The standard blowfish version is just the same but with a salt value of zero and a single call to the expandKey function. See the original bcrypt paper for more details. --- Crypto/Cipher/Blowfish/Primitive.hs | 93 +++++++++++++++++++++-------- 1 file changed, 69 insertions(+), 24 deletions(-) diff --git a/Crypto/Cipher/Blowfish/Primitive.hs b/Crypto/Cipher/Blowfish/Primitive.hs index a0d04f8..3fc4823 100644 --- a/Crypto/Cipher/Blowfish/Primitive.hs +++ b/Crypto/Cipher/Blowfish/Primitive.hs @@ -16,16 +16,18 @@ module Crypto.Cipher.Blowfish.Primitive , initBlowfish , encrypt , decrypt + , eksBlowfish ) where import Control.Monad (when) import Data.Bits +import Data.Memory.Endian import Data.Word import Crypto.Error import Crypto.Internal.Compat import Crypto.Internal.Imports -import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray) +import Crypto.Internal.ByteArray (ByteArrayAccess, ByteArray, Bytes) import qualified Crypto.Internal.ByteArray as B import Crypto.Internal.Words import Crypto.Internal.WordArray @@ -64,17 +66,25 @@ cipher ctx b -- | Initialize a new Blowfish context from a key. -- --- key need to be between 0 to 448 bits. +-- key needs to be between 0 and 448 bits. initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context initBlowfish key - | len > (448 `div` 8) = CryptoFailed $ CryptoError_KeySizeInvalid - | otherwise = CryptoPassed $ makeKeySchedule key + | len > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid + | otherwise = CryptoPassed $ makeKeySchedule key (Nothing :: Maybe (Bytes, Int)) where len = B.length key +-- | The BCrypt "expensive key schedule" version of blowfish. +-- +-- Salt must be 128 bits +-- Cost must be between 4 and 31 inclusive +-- See +eksBlowfish :: (ByteArrayAccess salt, ByteArrayAccess password) => Int -> salt -> password -> Context +eksBlowfish cost salt key = makeKeySchedule key (Just (salt, cost)) + coreCrypto :: Context -> Word64 -> Word64 coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0 where - -- transform the input @i over 16 rounds + -- transform the input over 16 rounds doRound :: Word64 -> Int -> Word64 doRound i roundIndex | roundIndex == 16 = @@ -84,7 +94,6 @@ coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0 let newr = fromIntegral (i `shiftR` 32) `xor` (p roundIndex) newi = ((i `shiftL` 32) `xor` (f newr)) .|. (fromIntegral newr) in doRound newi (roundIndex+1) - f :: Word32 -> Word64 f t = let a = s0 (fromIntegral $ (t `shiftR` 24) .&. 0xff) b = s1 (fromIntegral $ (t `shiftR` 16) .&. 0xff) @@ -92,22 +101,26 @@ coreCrypto (BF p s0 s1 s2 s3) input = doRound input 0 d = s3 (fromIntegral $ t .&. 0xff) in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32 -makeKeySchedule :: ByteArrayAccess key => key -> Context -makeKeySchedule key = + +-- | Create a key schedule for either plain Blowfish or the BCrypt "EKS" version +-- For the expensive version, the salt and cost factor are supplied. Salt must be +-- a 128-bit byte array. +-- +-- The standard case is just a single key expansion with the salt set to zero. +makeKeySchedule :: (ByteArrayAccess key, ByteArrayAccess salt) => key-> Maybe (salt, Int) -> Context +makeKeySchedule keyBytes saltCost = let v = unsafeDoIO $ do - let len = B.length key mv <- createKeySchedule - when (len > 0) $ forM_ [0..17] $ \i -> do - let a = B.index key ((i * 4 + 0) `mod` len) - b = B.index key ((i * 4 + 1) `mod` len) - c = B.index key ((i * 4 + 2) `mod` len) - d = B.index key ((i * 4 + 3) `mod` len) - k = (fromIntegral a `shiftL` 24) .|. - (fromIntegral b `shiftL` 16) .|. - (fromIntegral c `shiftL` 8) .|. - (fromIntegral d) - mutableArrayWriteXor32 mv i k - prepare mv + case saltCost of + -- Standard blowfish + Nothing -> expandKey mv 0 0 keyBytes + -- The expensive case + Just (s, cost) -> do + let (salt1, salt2) = splitSalt s + expandKey mv salt1 salt2 keyBytes + forM_ [1..2^cost :: Int] $ \_ -> do + expandKey mv 0 0 keyBytes + expandKey mv 0 0 s mutableArray32Freeze mv in BF (\i -> arrayRead32 v i) (\i -> arrayRead32 v (s0+i)) @@ -115,21 +128,49 @@ makeKeySchedule key = (\i -> arrayRead32 v (s2+i)) (\i -> arrayRead32 v (s3+i)) where + splitSalt s = (fromBE (B.toW64BE s 0), fromBE (B.toW64BE s 8)) + + -- Indices of the S-Box arrays, each containing 256 32-bit words + -- The first 18 words contain the P-Array of subkeys s0 = 18 s1 = 274 s2 = 530 s3 = 786 - prepare mctx = loop 0 0 - where loop i input +expandKey :: ByteArrayAccess ba + => MutableArray32 -- ^ The key schedule + -> Word64 -- ^ First word of the salt + -> Word64 -- ^ Second word of the salt + -> ba -- ^ The key + -> IO () +expandKey mv salt1 salt2 key = do + when (len > 0) $ forM_ [0..17] $ \i -> do + let a = B.index key ((i * 4 + 0) `mod` len) + b = B.index key ((i * 4 + 1) `mod` len) + c = B.index key ((i * 4 + 2) `mod` len) + d = B.index key ((i * 4 + 3) `mod` len) + k = (fromIntegral a `shiftL` 24) .|. + (fromIntegral b `shiftL` 16) .|. + (fromIntegral c `shiftL` 8) .|. + (fromIntegral d) + mutableArrayWriteXor32 mv i k + prepare mv + return () + where + len = B.length key + + -- | Go through the entire key schedule overwriting the P-Array and S-Boxes + prepare mctx = loop 0 salt1 salt1 salt2 + where loop i input slt1 slt2 | i == 1042 = return () | otherwise = do ninput <- coreCryptoMutable input let (nl, nr) = w64to32 ninput mutableArrayWrite32 mctx i nl mutableArrayWrite32 mctx (i+1) nr - loop (i+2) ninput + loop (i+2) (ninput `xor` slt2) slt2 slt1 + -- | Blowfish encrypt a Word using the current state of the key schedule coreCryptoMutable :: Word64 -> IO Word64 coreCryptoMutable input = doRound input 0 where doRound i roundIndex @@ -145,10 +186,14 @@ makeKeySchedule key = let newi = ((i `shiftL` 32) `xor` newr') .|. (fromIntegral newr) doRound newi (roundIndex+1) - + -- The Blowfish Feistel function F f :: Word32 -> IO Word64 f t = do a <- mutableArrayRead32 mctx (s0 + fromIntegral ((t `shiftR` 24) .&. 0xff)) b <- mutableArrayRead32 mctx (s1 + fromIntegral ((t `shiftR` 16) .&. 0xff)) c <- mutableArrayRead32 mctx (s2 + fromIntegral ((t `shiftR` 8) .&. 0xff)) d <- mutableArrayRead32 mctx (s3 + fromIntegral (t .&. 0xff)) return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32) + where s0 = 18 + s1 = 274 + s2 = 530 + s3 = 786