diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,30 @@ # CHANGELOG for crypton +## 2.1.12 + +**Fixes from a security review**, backported from 2.2.6. + +* fix(scrypt): refuse n < 2, non-positive r or p, and overflowing sizes + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix(aes): keep the AArch64 one-shot GCM loops from wrapping near 4 GiB + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix(gcmsiv): give Nothing for a tag that is not 16 bytes + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix(pbkdf2): refuse iteration counts the C cannot take in the fast path + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix(p256): negating the point at infinity gives the point at infinity + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix(p256): a zero scalar lifts to the point at infinity + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix: lengths of 4 GiB or more in ChaChaDRG and Argon2 + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix(gcm): refuse incremental input past 2^36 - 32 bytes + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix: doubling in GF(2^n) without branching on secret bits + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) +* fix(hash): feed every hash update through updateBlocks + [#370](https://github.com/kazu-yamamoto/crypton/pull/370) + ## 2.1.11 **crypton runs again on x86-64 processors without AVX2.** From 2.1.8 the diff --git a/Crypto/Cipher/AES/Primitive.hs b/Crypto/Cipher/AES/Primitive.hs --- a/Crypto/Cipher/AES/Primitive.hs +++ b/Crypto/Cipher/AES/Primitive.hs @@ -63,6 +63,7 @@ import Foreign.C.String import Foreign.C.Types import Foreign.Ptr +import Foreign.Storable (peekByteOff) import Crypto.Cipher.Types import Crypto.Cipher.Types.Block (IV (..)) @@ -664,7 +665,9 @@ -- needs to happen after AAD appending, or after initialization if no AAD data. {-# NOINLINE gcmAppendEncrypt #-} gcmAppendEncrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) -gcmAppendEncrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doEnc +gcmAppendEncrypt ctx gcm input + | gcmTooLong gcm len = error gcmTooLongMessage + | otherwise = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doEnc where len = B.length input doEnc gcmStPtr aesPtr = @@ -684,7 +687,9 @@ -- needs to happen after AAD appending, or after initialization if no AAD data. {-# NOINLINE gcmAppendDecrypt #-} gcmAppendDecrypt :: ByteArray ba => AES -> AESGCM -> ba -> (ba, AESGCM) -gcmAppendDecrypt ctx gcm input = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doDec +gcmAppendDecrypt ctx gcm input + | gcmTooLong gcm len = error gcmTooLongMessage + | otherwise = unsafeDoIO $ withGCMKeyAndCopySt ctx gcm doDec where len = B.length input doDec gcmStPtr aesPtr = @@ -697,6 +702,20 @@ aesPtr (i `plusPtr` off) (fromIntegral n) + +-- | SP 800-38D 5.2.1.1 limits a message to 2^39 - 256 bits; past that the +-- 32-bit counter wraps and the keystream repeats. The bytes so far are +-- @length_input@ in @aes_gcm@ (cbits/crypton_aes.h). +gcmTooLong :: AESGCM -> Int -> Bool +gcmTooLong (AESGCM st) len = fromIntegral len > gcmMaxInput - used + where + used = unsafeDoIO $ withByteArray st $ \p -> peekByteOff p 312 :: IO Word64 + +gcmMaxInput :: Word64 +gcmMaxInput = 2 ^ (36 :: Int) - 32 + +gcmTooLongMessage :: String +gcmTooLongMessage = "AES-GCM: a message is limited to 2^36 - 32 bytes" -- | Generate the Tag from GCM context {-# NOINLINE gcmFinish #-} diff --git a/Crypto/Cipher/AESGCMSIV.hs b/Crypto/Cipher/AESGCMSIV.hs --- a/Crypto/Cipher/AESGCMSIV.hs +++ b/Crypto/Cipher/AESGCMSIV.hs @@ -145,13 +145,16 @@ -- cipher. -- -- Lengths of additional data and ciphertext must be less than 2^32 bytes, --- otherwise an exception is thrown. +-- otherwise an exception is thrown. A tag that is not 16 bytes gives +-- 'Nothing'. decrypt :: (BlockCipher128 aes, ByteArrayAccess aad, ByteArray ba) => aes -> Nonce -> aad -> ba -> AuthTag -> Maybe ba decrypt aes iv aad ciphertext (AuthTag tag) | lengthInvalid aad = error "AESGCMSIV: aad is too large" | lengthInvalid ciphertext = error "AESGCMSIV: ciphertext is too large" + -- the tag is also the initial counter block, read up to byte 15 + | B.length tag /= 16 = Nothing | tag `B.constEq` buildTag mek ss iv = Just plaintext | otherwise = Nothing where diff --git a/Crypto/Cipher/ChaCha.hs b/Crypto/Cipher/ChaCha.hs --- a/Crypto/Cipher/ChaCha.hs +++ b/Crypto/Cipher/ChaCha.hs @@ -225,9 +225,12 @@ -> (ba, StateSimple) generateSimple (StateSimple prevSt) nbBytes = unsafeDoIO $ do newSt <- B.copy prevSt (\_ -> return ()) + -- in pieces, as the C takes a uint32_t; each is a multiple of the 16 + -- bytes it rekeys after, so the stream is the same as in one call output <- B.alloc nbBytes $ \dstPtr -> B.withByteArray newSt $ \stPtr -> - ccrypton_chacha_random 8 dstPtr stPtr (fromIntegral nbBytes) + B.inCLengths nbBytes $ \off n -> + ccrypton_chacha_random 8 (dstPtr `plusPtr` off) stPtr (fromIntegral n) return (output, StateSimple newSt) -- | similar to 'generate' but accepts a number of rounds, and always generates diff --git a/Crypto/Cipher/Types/GF.hs b/Crypto/Cipher/Types/GF.hs --- a/Crypto/Cipher/Types/GF.hs +++ b/Crypto/Cipher/Types/GF.hs @@ -34,13 +34,11 @@ | otherwise = error "unsupported block size in GF" where gf :: Word64 -> Word64 -> (Word64, Word64) + -- the carries are secret, so they are masks rather than branches gf srcLo srcHi = - ( (if carryLo then (.|. 1) else id) (srcHi `shiftL` 1) - , (if carryHi then xor 0x87 else id) $ (srcLo `shiftL` 1) + ( (srcHi `shiftL` 1) .|. (srcLo `shiftR` 63) + , (srcLo `shiftL` 1) `xor` (0x87 .&. negate (srcHi `shiftR` 63)) ) - where - carryHi = srcHi `testBit` 63 - carryLo = srcLo `testBit` 63 len = B.length b {- diff --git a/Crypto/Hash.hs b/Crypto/Hash.hs --- a/Crypto/Hash.hs +++ b/Crypto/Hash.hs @@ -52,9 +52,8 @@ import Crypto.Internal.ByteArray (ByteArrayAccess, allocAndFreezePrim) import qualified Crypto.Internal.ByteArray as B import qualified Data.ByteString.Lazy as L -import Data.Int (Int32) import qualified Foreign.Marshal.Utils as FMU -import Foreign.Ptr (Ptr, castPtr, plusPtr) +import Foreign.Ptr (Ptr, castPtr) -- | Hash a strict bytestring into a digest. hash :: (ByteArrayAccess ba, HashAlgorithm a) => ba -> Digest a @@ -92,20 +91,9 @@ hashUpdates c l | null ls = c | otherwise = Context $ B.copyAndFreeze c $ \(ctx :: Ptr (Context a)) -> - mapM_ (\b -> B.withByteArray b (processBlocks ctx (B.length b))) ls + mapM_ (\b -> B.withByteArray b (updateBlocks ctx (B.length b))) ls where ls = filter (not . B.null) l - -- process the data in 2GB chunks to fit in uint32_t and Int on 32 bit systems - processBlocks ctx bytesLeft dataPtr - | bytesLeft == 0 = return () - | otherwise = do - hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed) - processBlocks - ctx - (bytesLeft - actuallyProcessed) - (dataPtr `plusPtr` actuallyProcessed) - where - actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Int32)) -- | Finalize a context and return a digest. hashFinalize diff --git a/Crypto/Hash/IO.hs b/Crypto/Hash/IO.hs --- a/Crypto/Hash/IO.hs +++ b/Crypto/Hash/IO.hs @@ -60,8 +60,7 @@ => MutableContext a -> ((Ptr (Context a) -> IO ()) -> IO ()) -> IO () doUpdate _ withCtx = withCtx $ \ctx -> - B.withByteArray dat $ \d -> - hashInternalUpdate ctx d (fromIntegral $ B.length dat) + B.withByteArray dat $ updateBlocks ctx (B.length dat) -- | Finalize a mutable hash context and compute a digest hashMutableFinalize diff --git a/Crypto/Hash/Types.hs b/Crypto/Hash/Types.hs --- a/Crypto/Hash/Types.hs +++ b/Crypto/Hash/Types.hs @@ -18,6 +18,7 @@ HashAlgorithmPrefix (..), Context (..), Digest (..), + updateBlocks, ) where import Control.DeepSeq (deepseq) @@ -31,6 +32,7 @@ import Data.ByteString.Base16 (encodeBase16) import Data.Char (digitToInt, isHexDigit) import Data.Data (Data) +import Data.Int (Int32) import Data.Primitive.ByteArray ( ByteArray, MutableByteArray, @@ -41,8 +43,22 @@ writeByteArray, ) import qualified Data.Text as Text -import Foreign.Ptr (Ptr, castPtr) +import Foreign.Ptr (Ptr, castPtr, plusPtr) import GHC.TypeLits (Nat) + +-- | Feed a buffer of any length to 'hashInternalUpdate', in 2GB chunks: the +-- C takes a @uint32_t@, and a longer length would be silently truncated. +updateBlocks :: HashAlgorithm a => Ptr (Context a) -> Int -> Ptr Word8 -> IO () +updateBlocks ctx bytesLeft dataPtr + | bytesLeft <= 0 = return () + | otherwise = do + hashInternalUpdate ctx dataPtr (fromIntegral actuallyProcessed) + updateBlocks + ctx + (bytesLeft - actuallyProcessed) + (dataPtr `plusPtr` actuallyProcessed) + where + actuallyProcessed = min bytesLeft (fromIntegral (maxBound :: Int32)) -- | Class representing hashing algorithms. -- diff --git a/Crypto/KDF/Argon2.hs b/Crypto/KDF/Argon2.hs --- a/Crypto/KDF/Argon2.hs +++ b/Crypto/KDF/Argon2.hs @@ -107,8 +107,8 @@ -- | Hash a password with Argon2. -- -- Options the underlying implementation refuses -- iterations, memory or --- parallelism outside the range it accepts -- are reported as --- 'CryptoError_ParameterInvalid'. +-- parallelism outside the range it accepts, or a password or salt of 2^32 +-- bytes or more -- are reported as 'CryptoError_ParameterInvalid'. hash :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray out) => Options @@ -120,6 +120,9 @@ | saltLen < saltMinLength = CryptoFailed CryptoError_SaltTooSmall | outLen < outputMinLength = CryptoFailed CryptoError_OutputLengthTooSmall | outLen > outputMaxLength = CryptoFailed CryptoError_OutputLengthTooBig + -- the C keeps these lengths as uint32_t and would truncate them + | B.overCLength passwordLen || B.overCLength saltLen = + CryptoFailed CryptoError_ParameterInvalid | otherwise = unsafeDoIO $ do -- the bounds on iterations, memory and parallelism are checked by the -- C implementation, which reports them through its return code diff --git a/Crypto/KDF/BCryptPBKDF.hs b/Crypto/KDF/BCryptPBKDF.hs --- a/Crypto/KDF/BCryptPBKDF.hs +++ b/Crypto/KDF/BCryptPBKDF.hs @@ -27,6 +27,7 @@ hashInternalFinalize, hashInternalInit, hashInternalUpdate, + updateBlocks, ) import Crypto.Internal.Compat (unsafeDoIO) import Data.Bits @@ -112,7 +113,7 @@ -- Hash the password. let shaPtr = castPtr ctxPtr' :: Ptr (Context SHA512) hashInternalInit shaPtr - hashInternalUpdate shaPtr passPtr (fromIntegral passLen) + updateBlocks shaPtr passLen passPtr hashInternalFinalize shaPtr (castPtr passHashPtr) -- Create a stable ByteString view of the password hash -- (passHashFP is not modified after this point). @@ -125,7 +126,7 @@ pokeByteOff blkPtr 3 (fromIntegral (block `shiftR` 0 :: Int) :: Word8) -- First round (slightly different). hashInternalInit shaPtr - hashInternalUpdate shaPtr saltPtr (fromIntegral saltLen) + updateBlocks shaPtr saltLen saltPtr hashInternalUpdate shaPtr blkPtr (fromIntegral blkLen) hashInternalFinalize shaPtr (castPtr saltHashPtr) let saltHashBS = BSI.fromForeignPtr saltHashFP 0 hashLen diff --git a/Crypto/KDF/PBKDF2.hs b/Crypto/KDF/PBKDF2.hs --- a/Crypto/KDF/PBKDF2.hs +++ b/Crypto/KDF/PBKDF2.hs @@ -60,7 +60,7 @@ data Parameters = Parameters { iterCounts :: Int -- ^ the number of user-defined iterations for the algorithms. e.g. WPA2 uses 4000. - -- (must be > 0) + -- (must be > 0, and below 2^32 for the fast functions) , outputLength :: Int -- ^ the number of bytes to generate out of PBKDF2 -- (must not be negative) @@ -76,6 +76,14 @@ | outputLength params < 0 = Just CryptoError_ParameterInvalid | otherwise = Nothing +-- | 'validateParameters', and an iteration count the C can take: it is a +-- @uint32_t@ there, so 2^32 + 1 would silently run once. +validateFastParameters :: Parameters -> Maybe CryptoError +validateFastParameters params + | toInteger (iterCounts params) > toInteger (maxBound :: Word32) = + Just CryptoError_ParameterInvalid + | otherwise = validateParameters params + -- | generate the pbkdf2 key derivation function from the output -- -- Parameters outside the ranges documented for t'Parameters' raise @@ -172,7 +180,7 @@ -> salt -> CryptoFailable out tryFastPBKDF2_SHA1 params password salt - | Just err <- validateParameters params = CryptoFailed err + | Just err <- validateFastParameters params = CryptoFailed err | otherwise = CryptoPassed $ B.allocAndFreeze (outputLength params) $ \outPtr -> B.withByteArray password $ \passPtr -> B.withByteArray salt $ \saltPtr -> @@ -208,7 +216,7 @@ -> salt -> CryptoFailable out tryFastPBKDF2_SHA256 params password salt - | Just err <- validateParameters params = CryptoFailed err + | Just err <- validateFastParameters params = CryptoFailed err | otherwise = CryptoPassed $ B.allocAndFreeze (outputLength params) $ \outPtr -> B.withByteArray password $ \passPtr -> B.withByteArray salt $ \saltPtr -> @@ -244,7 +252,7 @@ -> salt -> CryptoFailable out tryFastPBKDF2_SHA512 params password salt - | Just err <- validateParameters params = CryptoFailed err + | Just err <- validateFastParameters params = CryptoFailed err | otherwise = CryptoPassed $ B.allocAndFreeze (outputLength params) $ \outPtr -> B.withByteArray password $ \passPtr -> B.withByteArray salt $ \saltPtr -> diff --git a/Crypto/KDF/Scrypt.hs b/Crypto/KDF/Scrypt.hs --- a/Crypto/KDF/Scrypt.hs +++ b/Crypto/KDF/Scrypt.hs @@ -34,9 +34,9 @@ { n :: Word64 -- ^ Cpu/Memory cost ratio. must be a power of 2 greater than 1. also known as N. , r :: Int - -- ^ Must satisfy r * p < 2^30 + -- ^ Must be positive and satisfy r * p < 2^30 , p :: Int - -- ^ Must satisfy r * p < 2^30 + -- ^ Must be positive and satisfy r * p < 2^30 , outputLength :: Int -- ^ the number of bytes to generate out of Scrypt } @@ -60,7 +60,9 @@ -- | Generate the scrypt key derivation data, reporting parameters the -- implementation refuses rather than raising. -- --- @n@ has to be a power of two, and @r@ times @p@ has to stay below 2^30. +-- @n@ has to be a power of two greater than 1, @r@ and @p@ positive, @r@ +-- times @p@ below 2^30, and the 128 * @r@ * @n@ bytes of working memory +-- addressable. tryGenerate :: (ByteArrayAccess password, ByteArrayAccess salt, ByteArray output) => Parameters @@ -68,8 +70,7 @@ -> salt -> CryptoFailable output tryGenerate params password salt - | r params * p params >= 0x40000000 = CryptoFailed CryptoError_ParameterInvalid - | popCount (n params) /= 1 = CryptoFailed CryptoError_ParameterInvalid + | not (validParameters params) = CryptoFailed CryptoError_ParameterInvalid | otherwise = CryptoPassed $ unsafeDoIO $ do let b = PBKDF2.generate prf (PBKDF2.Parameters 1 intLen) password salt :: B.Bytes newSalt <- B.copy b $ \bPtr -> @@ -93,3 +94,19 @@ prf = PBKDF2.prfHMAC SHA256 intLen = p params * 128 * r params {-# NOINLINE tryGenerate #-} + +-- Checked in Integer, so that no product can wrap before it is compared. +validParameters :: Parameters -> Bool +validParameters params = + n params >= 2 + && popCount (n params) == 1 + && r' >= 1 + && p' >= 1 + && r' * p' < 0x40000000 + && 128 * r' * n' <= maxInt + && 128 * r' * p' <= maxInt + where + n' = toInteger (n params) + r' = toInteger (r params) + p' = toInteger (p params) + maxInt = toInteger (maxBound :: Int) diff --git a/Crypto/MAC/CMAC.hs b/Crypto/MAC/CMAC.hs --- a/Crypto/MAC/CMAC.hs +++ b/Crypto/MAC/CMAC.hs @@ -17,7 +17,7 @@ subKeys, ) where -import Data.Bits (setBit, shiftL, testBit) +import Data.Bits (setBit, shiftL, shiftR, (.&.), (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.Word @@ -97,13 +97,12 @@ k1 = subKey ipt k0 k2 = subKey ipt k1 --- polynomial multiply operation to culculate subkey +-- polynomial multiply operation to culculate subkey; the top bit is secret, +-- so it becomes a mask rather than a branch subKey :: ByteArray ba => [Word8] -> ba -> ba subKey ipt ws = case B.unpack ws of [] -> B.empty - w : _ - | testBit w 7 -> B.pack ipt `bxor` shiftL1 ws - | otherwise -> shiftL1 ws + w : _ -> B.pack (map (.&. negate (w `shiftR` 7)) ipt) `bxor` shiftL1 ws shiftL1 :: ByteArray ba => ba -> ba shiftL1 = B.pack . shiftL1W . B.unpack @@ -113,13 +112,7 @@ shiftL1W ws@(_ : ns) = rec' $ zip ws (ns ++ [0]) where rec' [] = [] - rec' ((x, y) : ps) = w : rec' ps - where - w - | testBit y 7 = setBit sl1 0 - | otherwise = sl1 - where - sl1 = shiftL x 1 + rec' ((x, y) : ps) = (shiftL x 1 .|. shiftR y 7) : rec' ps bxor :: ByteArray ba => ba -> ba -> ba bxor = B.bxor diff --git a/Crypto/MAC/KMAC.hs b/Crypto/MAC/KMAC.hs --- a/Crypto/MAC/KMAC.hs +++ b/Crypto/MAC/KMAC.hs @@ -26,7 +26,7 @@ import qualified Crypto.Hash as H import Crypto.Hash.SHAKE (HashSHAKE (..)) -import Crypto.Hash.Types (Digest (..), HashAlgorithm (..)) +import Crypto.Hash.Types (Digest (..), HashAlgorithm (..), updateBlocks) import qualified Crypto.Hash.Types as H import Crypto.Internal.Builder import Crypto.Internal.ByteArray (allocAndFreezePrim) @@ -48,8 +48,8 @@ => name -> string -> prefix -> H.Context a cshakeInit n s p = H.Context $ B.allocAndFreeze c $ \(ptr :: Ptr (H.Context a)) -> do hashInternalInit ptr - B.withByteArray b $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length b) - B.withByteArray p $ \d -> hashInternalUpdate ptr d (fromIntegral $ B.length p) + B.withByteArray b $ updateBlocks ptr (B.length b) + B.withByteArray p $ updateBlocks ptr (B.length p) where c = hashInternalContextSize (undefined :: a) w = hashBlockSize (undefined :: a) @@ -74,8 +74,7 @@ allocAndFreezePrim (hashDigestSize (undefined :: a)) $ \(dig :: Ptr (Digest a)) -> do ((!_) :: B.Bytes) <- B.copy c $ \(ctx :: Ptr (H.Context a)) -> do - B.withByteArray s $ \d -> - hashInternalUpdate ctx d (fromIntegral $ B.length s) + B.withByteArray s $ updateBlocks ctx (B.length s) cshakeInternalFinalize ctx dig return () diff --git a/Crypto/PubKey/ECC/P256.hs b/Crypto/PubKey/ECC/P256.hs --- a/Crypto/PubKey/ECC/P256.hs +++ b/Crypto/PubKey/ECC/P256.hs @@ -102,9 +102,11 @@ -- Using the curve generator as base point compute: -- -- > scalar * G +-- +-- Zero gives the point at infinity, as P-384 and P-521 do. toPoint :: Scalar -> Point toPoint s - | scalarIsZero s = error "cannot create point from zero" + | scalarIsZero s = Point (B.zero pointSize) | otherwise = withNewPoint $ \px py -> withScalar s $ \p -> ccrypton_p256_basepoint_mul p px py @@ -120,9 +122,12 @@ -- | Negate a point pointNegate :: Point -> Point -pointNegate a = withNewPoint $ \dx dy -> - withPoint a $ \ax ay -> - ccrypton_p256e_point_negate ax ay dx dy +pointNegate a + -- infinity is held as (0, 0), and p - 0 would make it (0, p) + | pointIsAtInfinity a = a + | otherwise = withNewPoint $ \dx dy -> + withPoint a $ \ax ay -> + ccrypton_p256e_point_negate ax ay dx dy -- | Multiply a point by a scalar -- diff --git a/cbits/aes/armv8_impl.c b/cbits/aes/armv8_impl.c --- a/cbits/aes/armv8_impl.c +++ b/cbits/aes/armv8_impl.c @@ -590,8 +590,8 @@ do { \ poly64x2_t b_ = vreinterpretq_p64_u8(vrev64q_u8(blk)); \ if (bn == 0) { \ - uint32_t left_ = gtotal - gidx; \ - blen = left_ < WAY ? left_ : WAY; \ + uint64_t left_ = gtotal - gidx; \ + blen = (uint32_t) (left_ < WAY ? left_ : WAY); \ acc = vreinterpretq_u64_u8( \ vextq_u8(vreinterpretq_u8_u64(acc), \ vreinterpretq_u8_u64(acc), 8)); \ @@ -625,9 +625,12 @@ uint8x16_t ek0; uint64x2_t acc = vdupq_n_u64(0), gH = acc, gM = acc, gL = acc; uint32x4_t base; - uint32_t c = 1, bn = 0, blen = 0, gidx = 0; - uint32_t gtotal = (aadlen + 15) / 16 + (inlen + 15) / 16 + 1; - uint32_t i, done; + uint32_t c = 1, bn = 0, blen = 0; + /* 64-bit: in 32 bits, i + 16 and done + 16 * WAY wrap for lengths + * near 4 GiB and the loops run past the buffers. */ + uint64_t gidx = 0; + uint64_t gtotal = ((uint64_t) aadlen + 15) / 16 + ((uint64_t) inlen + 15) / 16 + 1; + uint64_t i, done; uint8_t y0[16], lenb[16]; uint64_t la, lc; @@ -720,9 +723,12 @@ uint8x16_t ek0; uint64x2_t acc = vdupq_n_u64(0), gH = acc, gM = acc, gL = acc; uint32x4_t base; - uint32_t c = 1, bn = 0, blen = 0, gidx = 0; - uint32_t gtotal = (aadlen + 15) / 16 + (inlen + 15) / 16 + 1; - uint32_t i, done; + uint32_t c = 1, bn = 0, blen = 0; + /* 64-bit: in 32 bits, i + 16 and done + 16 * WAY wrap for lengths + * near 4 GiB and the loops run past the buffers. */ + uint64_t gidx = 0; + uint64_t gtotal = ((uint64_t) aadlen + 15) / 16 + ((uint64_t) inlen + 15) / 16 + 1; + uint64_t i, done; uint8_t y0[16], lenb[16], want[16]; uint64_t la, lc; uint8_t diff = 0; diff --git a/cbits/aes/gf.c b/cbits/aes/gf.c --- a/cbits/aes/gf.c +++ b/cbits/aes/gf.c @@ -37,10 +37,10 @@ /* inplace GFMUL for xts mode */ void crypton_aes_generic_gf_mulx(block128 *a) { - const uint64_t gf_mask = cpu_to_le64(0x8000000000000000ULL); - uint64_t r = ((a->q[1] & gf_mask) ? cpu_to_le64(0x87) : 0); - a->q[1] = cpu_to_le64((le64_to_cpu(a->q[1]) << 1) | (a->q[0] & gf_mask ? 1 : 0)); - a->q[0] = cpu_to_le64(le64_to_cpu(a->q[0]) << 1) ^ r; + /* the carries are secret: shifts and a mask, not branches */ + uint64_t lo = le64_to_cpu(a->q[0]), hi = le64_to_cpu(a->q[1]); + a->q[1] = cpu_to_le64((hi << 1) | (lo >> 63)); + a->q[0] = cpu_to_le64((lo << 1) ^ ((0 - (hi >> 63)) & 0x87)); } diff --git a/cbits/crypton_aes.c b/cbits/crypton_aes.c --- a/cbits/crypton_aes.c +++ b/cbits/crypton_aes.c @@ -28,6 +28,7 @@ * SUCH DAMAGE. */ +#include #include #include @@ -629,6 +630,9 @@ crypton_hinit(gcm->htable, &h); gcm_message_init(gcm, iv, len); } + +/* Crypto.Cipher.AES.Primitive reads length_input at this offset */ +typedef char crypton_gcm_length_input_offset[offsetof(aes_gcm, length_input) == 312 ? 1 : -1]; void crypton_aes_gcm_aad(aes_gcm *gcm, uint8_t *input, uint32_t length) { diff --git a/crypton.cabal b/crypton.cabal --- a/crypton.cabal +++ b/crypton.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: crypton -version: 2.1.11 +version: 2.1.12 -- crypton's own code is BSD-3-Clause. The parts of -- cbits/aes/gcm_fused_x86.c that follow picotls's fusion are MIT, and the -- vendored s2n-bignum assembly in cbits/s2n is taken under ISC; each has diff --git a/tests/BlockCipher/AESGCMSIVSpec.hs b/tests/BlockCipher/AESGCMSIVSpec.hs --- a/tests/BlockCipher/AESGCMSIVSpec.hs +++ b/tests/BlockCipher/AESGCMSIVSpec.hs @@ -654,12 +654,36 @@ (tag, ciphertext) = encrypt c iv aad input in decrypt c iv aad ciphertext tag === Just input +tagKey :: AES128 +tagKey = throwCryptoError (cipherInit (B.replicate 16 1 :: ByteString)) + +tagNonce :: Nonce +tagNonce = throwCryptoError (nonce (B.replicate 12 3 :: ByteString)) + +message :: ByteString +message = "authenticated message" + +fullTag :: B.Bytes +ciphertext :: ByteString +(AuthTag fullTag, ciphertext) = encrypt tagKey tagNonce ("" :: ByteString) message + +withTag :: B.Bytes -> Maybe ByteString +withTag t = decrypt tagKey tagNonce ("" :: ByteString) ciphertext (AuthTag t) + spec :: Spec spec = describe "AES-GCM-SIV" $ do describe "KATs" $ do katTests "encrypt" makeEncryptionTest katTests "decrypt" makeDecryptionTest + describe "tag length" $ do + -- the tag doubles as the counter block, so a short one used to + -- be written past and a long one raised from pure code + it "refuses an empty tag" $ withTag B.empty `shouldBe` Nothing + it "refuses a 15-byte tag" $ withTag (B.take 15 fullTag) `shouldBe` Nothing + it "refuses a 17-byte tag" $ + withTag (fullTag `B.append` B.singleton 0) `shouldBe` Nothing + it "accepts the 16-byte tag" $ withTag fullTag `shouldBe` Just message describe "properties" $ do prop "AES128" $ encDecTest (Proxy :: Proxy AES128) prop "AES256" $ encDecTest (Proxy :: Proxy AES256) diff --git a/tests/ECDSASpec.hs b/tests/ECDSASpec.hs --- a/tests/ECDSASpec.hs +++ b/tests/ECDSASpec.hs @@ -122,6 +122,19 @@ prop "SHA256" $ propertyECDSA SHA256 prop "SHA384" $ propertyECDSA SHA384 prop "SHA512" $ propertyECDSA SHA512 + -- a zero k used to raise "cannot create point from zero" on P-256, + -- where P-384 and P-521 gave Nothing + describe "zero scalar" $ do + it "signWith k = 0 gives Nothing on every NIST curve" $ do + zeroK ECDSA.Curve_P256R1 `shouldBe` True + zeroK ECDSA.Curve_P384R1 `shouldBe` True + zeroK ECDSA.Curve_P521R1 `shouldBe` True + it "pointBaseSmul 0 is the point at infinity on P-256" $ + ECDSA.pointBaseSmul (Just ECDSA.Curve_P256R1) zero256 + `shouldBe` ECDSA.pointAdd + (Just ECDSA.Curve_P256R1) + g256 + (ECDSA.pointNegate (Just ECDSA.Curve_P256R1) g256) describe "recovery" $ do modifyMaxSuccess (const 100) $ testRecover ECC.SEC_p128r1 modifyMaxSuccess (const 100) $ testRecover ECC.SEC_p128r2 @@ -158,3 +171,21 @@ , eqTest "verification" True (ECDSA.verify prx hashAlg pubECDSA sigECDSA msg) , eqTest "alteration" False (ECDSA.verify prx hashAlg pubECDSA sigECDSA msg') ] + +zeroK + :: (ECDSA.EllipticCurveECDSA curve, ECDSA.EllipticCurveBasepointArith curve) + => curve -> Bool +zeroK curve = isNothing (ECDSA.signWith prx k d SHA256 (B.pack [1, 2, 3])) + where + prx = Just curve + k = throwCryptoError (ECDSA.scalarFromInteger prx 0) + d = throwCryptoError (ECDSA.scalarFromInteger prx 12345) + +zero256 :: ECDSA.Scalar ECDSA.Curve_P256R1 +zero256 = throwCryptoError (ECDSA.scalarFromInteger (Just ECDSA.Curve_P256R1) 0) + +g256 :: ECDSA.Point ECDSA.Curve_P256R1 +g256 = + ECDSA.pointBaseSmul + (Just ECDSA.Curve_P256R1) + (throwCryptoError (ECDSA.scalarFromInteger (Just ECDSA.Curve_P256R1) 1)) diff --git a/tests/KDF/PBKDF2Spec.hs b/tests/KDF/PBKDF2Spec.hs --- a/tests/KDF/PBKDF2Spec.hs +++ b/tests/KDF/PBKDF2Spec.hs @@ -101,6 +101,18 @@ evaluate (fast1 (PBKDF2.Parameters 1 (-1))) `shouldThrow` cryptoError evaluate (fast256 (PBKDF2.Parameters 1 (-1))) `shouldThrow` cryptoError evaluate (fast512 (PBKDF2.Parameters 1 (-1))) `shouldThrow` cryptoError + -- the C takes the count as uint32_t: 2^32 + 1 used to run once, + -- and 2^32 hit assert(iterations) and aborted + it "rejects an iteration count above 2^32 - 1 in the fast path" $ do + let big = PBKDF2.Parameters (2 ^ (32 :: Int) + 1) 32 + PBKDF2.tryFastPBKDF2_SHA1 big badPass badSalt `shouldBe` refused + PBKDF2.tryFastPBKDF2_SHA256 big badPass badSalt `shouldBe` refused + PBKDF2.tryFastPBKDF2_SHA512 big badPass badSalt `shouldBe` refused + PBKDF2.tryFastPBKDF2_SHA256 + (PBKDF2.Parameters (2 ^ (32 :: Int)) 32) + badPass + badSalt + `shouldBe` refused it "reports them without raising" $ do PBKDF2.tryGenerate badPrf (PBKDF2.Parameters 0 32) badPass badSalt `shouldBe` refused diff --git a/tests/KDF/ScryptSpec.hs b/tests/KDF/ScryptSpec.hs --- a/tests/KDF/ScryptSpec.hs +++ b/tests/KDF/ScryptSpec.hs @@ -44,6 +44,17 @@ it "reports them without raising" $ do run' (Scrypt.Parameters 3 8 1 32) `shouldBe` refused run' (Scrypt.Parameters 16 1073741824 1 32) `shouldBe` refused + it "rejects n = 1, which the mixing loop overruns" $ + run' (Scrypt.Parameters 1 8 1 32) `shouldBe` refused + it "rejects n = 0" $ + run' (Scrypt.Parameters 0 8 1 32) `shouldBe` refused + it "rejects r or p that is not positive" $ do + run' (Scrypt.Parameters 16 0 1 32) `shouldBe` refused + run' (Scrypt.Parameters 16 (-1) 1 32) `shouldBe` refused + run' (Scrypt.Parameters 16 8 0 32) `shouldBe` refused + run' (Scrypt.Parameters 16 8 (-1) 32) `shouldBe` refused + it "rejects 128 * r * n that does not fit in an Int" $ + run' (Scrypt.Parameters (2 ^ (57 :: Int)) 1 1 32) `shouldBe` refused where run params = Scrypt.generate params ("password" :: ByteString) ("salt" :: ByteString) diff --git a/tests/PubKey/P256Spec.hs b/tests/PubKey/P256Spec.hs --- a/tests/PubKey/P256Spec.hs +++ b/tests/PubKey/P256Spec.hs @@ -232,6 +232,12 @@ it "point-mul-order" $ P256.pointIsAtInfinity (P256.pointMul P256.scalarN point7) `shouldBe` True + -- infinity is (0, 0); negating it used to give (0, p), which is + -- neither infinity nor on the curve + it "point-negate-infinity" $ do + let o = P256.pointAdd point7 (P256.pointNegate point7) + P256.pointIsAtInfinity (P256.pointNegate o) `shouldBe` True + P256.pointAdd (P256.pointNegate o) point7 `shouldBe` point7 it "point-mul-order-minus-one" $ P256.pointMul (unP256Scalar (P256Scalar (curveN - 1))) point7 `shouldBe` P256.pointNegate point7