crypton 2.1.11 → 2.1.12
raw patch · 24 files changed
+244/−73 lines, 24 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +25/−0
- Crypto/Cipher/AES/Primitive.hs +21/−2
- Crypto/Cipher/AESGCMSIV.hs +4/−1
- Crypto/Cipher/ChaCha.hs +4/−1
- Crypto/Cipher/Types/GF.hs +3/−5
- Crypto/Hash.hs +2/−14
- Crypto/Hash/IO.hs +1/−2
- Crypto/Hash/Types.hs +17/−1
- Crypto/KDF/Argon2.hs +5/−2
- Crypto/KDF/BCryptPBKDF.hs +3/−2
- Crypto/KDF/PBKDF2.hs +12/−4
- Crypto/KDF/Scrypt.hs +22/−5
- Crypto/MAC/CMAC.hs +5/−12
- Crypto/MAC/KMAC.hs +4/−5
- Crypto/PubKey/ECC/P256.hs +9/−4
- cbits/aes/armv8_impl.c +14/−8
- cbits/aes/gf.c +4/−4
- cbits/crypton_aes.c +4/−0
- crypton.cabal +1/−1
- tests/BlockCipher/AESGCMSIVSpec.hs +24/−0
- tests/ECDSASpec.hs +31/−0
- tests/KDF/PBKDF2Spec.hs +12/−0
- tests/KDF/ScryptSpec.hs +11/−0
- tests/PubKey/P256Spec.hs +6/−0
CHANGELOG.md view
@@ -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
Crypto/Cipher/AES/Primitive.hs view
@@ -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 #-}
Crypto/Cipher/AESGCMSIV.hs view
@@ -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
Crypto/Cipher/ChaCha.hs view
@@ -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
Crypto/Cipher/Types/GF.hs view
@@ -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 {-
Crypto/Hash.hs view
@@ -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
Crypto/Hash/IO.hs view
@@ -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
Crypto/Hash/Types.hs view
@@ -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. --
Crypto/KDF/Argon2.hs view
@@ -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
Crypto/KDF/BCryptPBKDF.hs view
@@ -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
Crypto/KDF/PBKDF2.hs view
@@ -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 ->
Crypto/KDF/Scrypt.hs view
@@ -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)
Crypto/MAC/CMAC.hs view
@@ -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
Crypto/MAC/KMAC.hs view
@@ -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 ()
Crypto/PubKey/ECC/P256.hs view
@@ -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 --
cbits/aes/armv8_impl.c view
@@ -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;
cbits/aes/gf.c view
@@ -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)); }
cbits/crypton_aes.c view
@@ -28,6 +28,7 @@ * SUCH DAMAGE. */ +#include <stddef.h> #include <string.h> #include <stdio.h> @@ -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) {
crypton.cabal view
@@ -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
tests/BlockCipher/AESGCMSIVSpec.hs view
@@ -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)
tests/ECDSASpec.hs view
@@ -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))
tests/KDF/PBKDF2Spec.hs view
@@ -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
tests/KDF/ScryptSpec.hs view
@@ -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)
tests/PubKey/P256Spec.hs view
@@ -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