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.
This commit is contained in:
Luke Taylor
Vincent Hanquez
parent
08ebde2f09
commit
2566e46185
@ -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 <https://www.usenix.org/conference/1999-usenix-annual-technical-conference/future-adaptable-password-scheme>
|
||||
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user