ff8a1c524d
In preparation of an implementation of the bcrypt_pbkdf (a variant of PBKDF2 used by OpenSSH) algorithm, certain low-level operations of the Blowfish algorithm need to be generalized and exposed. The Blowfish.Primitive module has already been extended to account for the requirements imposed by the BCrypt algorithm, but the salt length was limited to 16 bytes and the BCrypt specific key schedule setup has been hard-coded into the Blowfish module. This commit makes a clear distintion between the expandKey and expandKeyWithSalt operation. Both take arbitrary sized salts and keys now. The specialized operation for 16 byte salts as used by BCrypt has been preserved and is selected automatically. Also, the BCrypt specific parts have been move to the BCrypt module with regard to separation of concern. A benchmark for generating BCrypt hashes with cost 10 shows a performance improvement from 158 to 141ms on average (Intel i5-6500) after this refactoring. Further experiments suggest that the specialized expandKeyWithSalt128 does not have any advantage over the generalized version and might be removed in favour of less branches and exceptional behaviour.
259 lines
10 KiB
Haskell
259 lines
10 KiB
Haskell
-- |
|
|
-- Module : Crypto.Cipher.Blowfish.Primitive
|
|
-- License : BSD-style
|
|
-- Stability : experimental
|
|
-- Portability : Good
|
|
|
|
-- Rewritten by Vincent Hanquez (c) 2015
|
|
-- Lars Petersen (c) 2018
|
|
--
|
|
-- Original code:
|
|
-- Crypto.Cipher.Blowfish.Primitive, copyright (c) 2012 Stijn van Drongelen
|
|
-- based on: BlowfishAux.hs (C) 2002 HardCore SoftWare, Doug Hoyte
|
|
-- (as found in Crypto-4.2.4)
|
|
|
|
module Crypto.Cipher.Blowfish.Primitive
|
|
( Context
|
|
, initBlowfish
|
|
, encrypt
|
|
, decrypt
|
|
, KeySchedule
|
|
, createKeySchedule
|
|
, freezeKeySchedule
|
|
, expandKey
|
|
, expandKeyWithSalt
|
|
) where
|
|
|
|
import Control.Monad (when)
|
|
import Data.Bits
|
|
import Data.Memory.Endian
|
|
import Data.Word
|
|
|
|
import Crypto.Cipher.Blowfish.Box
|
|
import Crypto.Error
|
|
import Crypto.Internal.ByteArray (ByteArray, ByteArrayAccess, Bytes)
|
|
import qualified Crypto.Internal.ByteArray as B
|
|
import Crypto.Internal.Compat
|
|
import Crypto.Internal.Imports
|
|
import Crypto.Internal.WordArray
|
|
import Crypto.Internal.Words
|
|
|
|
newtype Context = Context Array32
|
|
|
|
instance NFData Context where
|
|
rnf a = a `seq` ()
|
|
|
|
-- | Initialize a new Blowfish context from a key.
|
|
--
|
|
-- key needs to be between 0 and 448 bits.
|
|
initBlowfish :: ByteArrayAccess key => key -> CryptoFailable Context
|
|
initBlowfish key
|
|
| B.length key > (448 `div` 8) = CryptoFailed CryptoError_KeySizeInvalid
|
|
| otherwise = CryptoPassed $ unsafeDoIO $ do
|
|
ks <- createKeySchedule
|
|
expandKey ks key
|
|
freezeKeySchedule ks
|
|
|
|
-- | Get an immutable Blowfish context by freezing a mutable key schedule.
|
|
freezeKeySchedule :: KeySchedule -> IO Context
|
|
freezeKeySchedule (KeySchedule ma) = Context `fmap` mutableArray32Freeze ma
|
|
|
|
expandKey :: (ByteArrayAccess key) => KeySchedule -> key -> IO ()
|
|
expandKey ks@(KeySchedule ma) key = do
|
|
when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do
|
|
mutableArrayWriteXor32 ma i l
|
|
mutableArrayWriteXor32 ma (i + 1) r
|
|
when (i + 2 < 18) (cont a0 a1)
|
|
loop 0 0 0
|
|
where
|
|
loop i l r = do
|
|
n <- cipherBlockMutable ks (fromIntegral l `shiftL` 32 .|. fromIntegral r)
|
|
let nl = fromIntegral (n `shiftR` 32)
|
|
nr = fromIntegral (n .&. 0xffffffff)
|
|
mutableArrayWrite32 ma i nl
|
|
mutableArrayWrite32 ma (i + 1) nr
|
|
when (i < 18 + 1024) (loop (i + 2) nl nr)
|
|
|
|
expandKeyWithSalt :: (ByteArrayAccess key, ByteArrayAccess salt)
|
|
=> KeySchedule
|
|
-> key
|
|
-> salt
|
|
-> IO ()
|
|
expandKeyWithSalt ks key salt
|
|
| B.length salt == 16 = expandKeyWithSalt128 ks key (fromBE $ B.toW64BE salt 0) (fromBE $ B.toW64BE salt 8)
|
|
| otherwise = expandKeyWithSaltAny ks key salt
|
|
|
|
expandKeyWithSaltAny :: (ByteArrayAccess key, ByteArrayAccess salt)
|
|
=> KeySchedule -- ^ The key schedule
|
|
-> key -- ^ The key
|
|
-> salt -- ^ The salt
|
|
-> IO ()
|
|
expandKeyWithSaltAny ks@(KeySchedule ma) key salt = do
|
|
when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do
|
|
mutableArrayWriteXor32 ma i l
|
|
mutableArrayWriteXor32 ma (i + 1) r
|
|
when (i + 2 < 18) (cont a0 a1)
|
|
-- Go through the entire key schedule overwriting the P-Array and S-Boxes
|
|
when (B.length salt > 0) $ iterKeyStream salt 0 0 $ \i l r a0 a1 cont-> do
|
|
let l' = xor l a0
|
|
let r' = xor r a1
|
|
n <- cipherBlockMutable ks (fromIntegral l' `shiftL` 32 .|. fromIntegral r')
|
|
let nl = fromIntegral (n `shiftR` 32)
|
|
nr = fromIntegral (n .&. 0xffffffff)
|
|
mutableArrayWrite32 ma i nl
|
|
mutableArrayWrite32 ma (i + 1) nr
|
|
when (i + 2 < 18 + 1024) (cont nl nr)
|
|
|
|
expandKeyWithSalt128 :: ByteArrayAccess ba
|
|
=> KeySchedule -- ^ The key schedule
|
|
-> ba -- ^ The key
|
|
-> Word64 -- ^ First word of the salt
|
|
-> Word64 -- ^ Second word of the salt
|
|
-> IO ()
|
|
expandKeyWithSalt128 ks@(KeySchedule ma) key salt1 salt2 = do
|
|
when (B.length key > 0) $ iterKeyStream key 0 0 $ \i l r a0 a1 cont-> do
|
|
mutableArrayWriteXor32 ma i l
|
|
mutableArrayWriteXor32 ma (i + 1) r
|
|
when (i + 2 < 18) (cont a0 a1)
|
|
-- Go through the entire key schedule overwriting the P-Array and S-Boxes
|
|
loop 0 salt1 salt1 salt2
|
|
where
|
|
loop i input slt1 slt2
|
|
| i == 1042 = return ()
|
|
| otherwise = do
|
|
n <- cipherBlockMutable ks input
|
|
let nl = fromIntegral (n `shiftR` 32)
|
|
nr = fromIntegral (n .&. 0xffffffff)
|
|
mutableArrayWrite32 ma i nl
|
|
mutableArrayWrite32 ma (i+1) nr
|
|
loop (i+2) (n `xor` slt2) slt2 slt1
|
|
|
|
-- | Encrypt blocks
|
|
--
|
|
-- Input need to be a multiple of 8 bytes
|
|
encrypt :: ByteArray ba => Context -> ba -> ba
|
|
encrypt ctx ba
|
|
| B.length ba == 0 = B.empty
|
|
| B.length ba `mod` 8 /= 0 = error "invalid data length"
|
|
| otherwise = B.mapAsWord64 (cipherBlock ctx False) ba
|
|
|
|
-- | Decrypt blocks
|
|
--
|
|
-- Input need to be a multiple of 8 bytes
|
|
decrypt :: ByteArray ba => Context -> ba -> ba
|
|
decrypt ctx ba
|
|
| B.length ba == 0 = B.empty
|
|
| B.length ba `mod` 8 /= 0 = error "invalid data length"
|
|
| otherwise = B.mapAsWord64 (cipherBlock ctx True) ba
|
|
|
|
-- | Encrypt or decrypt a single block of 64 bits.
|
|
--
|
|
-- The inverse argument decides whether to encrypt or decrypt.
|
|
cipherBlock :: Context -> Bool -> Word64 -> Word64
|
|
cipherBlock (Context ar) inverse input = doRound input 0
|
|
where
|
|
-- | Transform the input over 16 rounds
|
|
doRound :: Word64 -> Int -> Word64
|
|
doRound i roundIndex
|
|
| roundIndex == 16 =
|
|
let final = (fromIntegral (p 16) `shiftL` 32) .|. fromIntegral (p 17)
|
|
in rotateL (i `xor` final) 32
|
|
| otherwise =
|
|
let newr = fromIntegral (i `shiftR` 32) `xor` p roundIndex
|
|
newi = ((i `shiftL` 32) `xor` f newr) .|. fromIntegral newr
|
|
in doRound newi (roundIndex+1)
|
|
|
|
-- | The Blowfish Feistel function F
|
|
f :: Word32 -> Word64
|
|
f t = let a = s0 (0xff .&. (t `shiftR` 24))
|
|
b = s1 (0xff .&. (t `shiftR` 16))
|
|
c = s2 (0xff .&. (t `shiftR` 8))
|
|
d = s3 (0xff .&. t)
|
|
in fromIntegral (((a + b) `xor` c) + d) `shiftL` 32
|
|
|
|
-- | S-Box arrays, each containing 256 32-bit words
|
|
-- The first 18 words contain the P-Array of subkeys
|
|
s0, s1, s2, s3 :: Word32 -> Word32
|
|
s0 i = arrayRead32 ar (fromIntegral i + 18)
|
|
s1 i = arrayRead32 ar (fromIntegral i + 274)
|
|
s2 i = arrayRead32 ar (fromIntegral i + 530)
|
|
s3 i = arrayRead32 ar (fromIntegral i + 786)
|
|
p :: Int -> Word32
|
|
p i | inverse = arrayRead32 ar (17 - fromIntegral i)
|
|
| otherwise = arrayRead32 ar (fromIntegral i)
|
|
|
|
-- | Blowfish encrypt a Word using the current state of the key schedule
|
|
cipherBlockMutable :: KeySchedule -> Word64 -> IO Word64
|
|
cipherBlockMutable (KeySchedule ma) input = doRound input 0
|
|
where
|
|
-- | Transform the input over 16 rounds
|
|
doRound i roundIndex
|
|
| roundIndex == 16 = do
|
|
pVal1 <- mutableArrayRead32 ma 16
|
|
pVal2 <- mutableArrayRead32 ma 17
|
|
let final = (fromIntegral pVal1 `shiftL` 32) .|. fromIntegral pVal2
|
|
return $ rotateL (i `xor` final) 32
|
|
| otherwise = do
|
|
pVal <- mutableArrayRead32 ma roundIndex
|
|
let newr = fromIntegral (i `shiftR` 32) `xor` pVal
|
|
newr' <- f newr
|
|
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 <- s0 (0xff .&. (t `shiftR` 24))
|
|
b <- s1 (0xff .&. (t `shiftR` 16))
|
|
c <- s2 (0xff .&. (t `shiftR` 8))
|
|
d <- s3 (0xff .&. t)
|
|
return (fromIntegral (((a + b) `xor` c) + d) `shiftL` 32)
|
|
|
|
-- | S-Box arrays, each containing 256 32-bit words
|
|
-- The first 18 words contain the P-Array of subkeys
|
|
s0, s1, s2, s3 :: Word32 -> IO Word32
|
|
s0 i = mutableArrayRead32 ma (fromIntegral i + 18)
|
|
s1 i = mutableArrayRead32 ma (fromIntegral i + 274)
|
|
s2 i = mutableArrayRead32 ma (fromIntegral i + 530)
|
|
s3 i = mutableArrayRead32 ma (fromIntegral i + 786)
|
|
|
|
iterKeyStream :: (ByteArrayAccess x)
|
|
=> x
|
|
-> Word32
|
|
-> Word32
|
|
-> (Int -> Word32 -> Word32 -> Word32 -> Word32 -> (Word32 -> Word32 -> IO ()) -> IO ())
|
|
-> IO ()
|
|
iterKeyStream x a0 a1 g = f 0 0 a0 a1
|
|
where
|
|
len = B.length x
|
|
-- Avoiding the modulo operation when interating over the ring
|
|
-- buffer is assumed to be more efficient here. All other
|
|
-- implementations do this, too. The branch prediction shall prefer
|
|
-- the branch with the increment.
|
|
n j = if j + 1 >= len then 0 else j + 1
|
|
f i j0 b0 b1 = g i l r b0 b1 (f (i + 2) j8)
|
|
where
|
|
j1 = n j0
|
|
j2 = n j1
|
|
j3 = n j2
|
|
j4 = n j3
|
|
j5 = n j4
|
|
j6 = n j5
|
|
j7 = n j6
|
|
j8 = n j7
|
|
x0 = fromIntegral (B.index x j0)
|
|
x1 = fromIntegral (B.index x j1)
|
|
x2 = fromIntegral (B.index x j2)
|
|
x3 = fromIntegral (B.index x j3)
|
|
x4 = fromIntegral (B.index x j4)
|
|
x5 = fromIntegral (B.index x j5)
|
|
x6 = fromIntegral (B.index x j6)
|
|
x7 = fromIntegral (B.index x j7)
|
|
l = shiftL x0 24 .|. shiftL x1 16 .|. shiftL x2 8 .|. x3
|
|
r = shiftL x4 24 .|. shiftL x5 16 .|. shiftL x6 8 .|. x7
|
|
{-# INLINE iterKeyStream #-}
|
|
-- Benchmarking shows that GHC considers this function too big to inline
|
|
-- although forcing inlining causes an actual improvement.
|
|
-- It is assumed that all function calls (especially the continuation)
|
|
-- collapse into a tight loop after inlining.
|