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