diff options
| -rw-r--r-- | libraries/integer-gmp/cbits/wrappers.c | 61 | ||||
| -rw-r--r-- | libraries/integer-gmp/include/HsIntegerGmp.h.in | 3 | ||||
| -rw-r--r-- | libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs | 1 | ||||
| -rw-r--r-- | libraries/integer-gmp/src/GHC/Integer/Type.hs | 48 | ||||
| -rw-r--r-- | testsuite/tests/lib/integer/integerGmpInternals.hs | 4 |
5 files changed, 113 insertions, 4 deletions
diff --git a/libraries/integer-gmp/cbits/wrappers.c b/libraries/integer-gmp/cbits/wrappers.c index 446a681388..8f147ad0c1 100644 --- a/libraries/integer-gmp/cbits/wrappers.c +++ b/libraries/integer-gmp/cbits/wrappers.c @@ -11,6 +11,7 @@ #include "HsFFI.h" #include "MachDeps.h" +#include "HsIntegerGmp.h" #include <assert.h> #include <stdbool.h> @@ -626,7 +627,7 @@ integer_gmp_powm(mp_limb_t rp[], // result } const mpz_t b = CONST_MPZ_INIT(bp, mp_limb_zero_p(bp,bn) ? 0 : bn); - const mpz_t e = CONST_MPZ_INIT(ep, mp_limb_zero_p(ep,en) ? 0 : en); + const mpz_t e = CONST_MPZ_INIT(ep, en); const mpz_t m = CONST_MPZ_INIT(mp, mn); mpz_t r; @@ -687,6 +688,64 @@ integer_gmp_powm_word(const mp_limb_t b0, // base return integer_gmp_powm1(&b0, !!b0, &e0, !!e0, m0); } +/* version of integer_gmp_powm() based on mpz_powm_sec + * + * With GMP 5.0 or later execution time depends on size of arguments + * and size of result. + * + * 'M' must be odd and 'E' non-negative. + */ +mp_size_t +integer_gmp_powm_sec(mp_limb_t rp[], // result + const mp_limb_t bp[], const mp_size_t bn, // base + const mp_limb_t ep[], const mp_size_t en, // exponent + const mp_limb_t mp[], const mp_size_t mn) // mod +{ + assert(!mp_limb_zero_p(mp,mn)); + assert(mp[0] & 1); + + if ((mn == 1 || mn == -1) && mp[0] == 1) { + rp[0] = 0; + return 1; + } + + if (mp_limb_zero_p(ep,en)) { + rp[0] = 1; + return 1; + } + + assert(en > 0); + + const mpz_t b = CONST_MPZ_INIT(bp, mp_limb_zero_p(bp,bn) ? 0 : bn); + const mpz_t e = CONST_MPZ_INIT(ep, en); + const mpz_t m = CONST_MPZ_INIT(mp, mn); + + mpz_t r; + mpz_init (r); + +#if HAVE_SECURE_POWM == 0 + mpz_powm(r, b, e, m); +#else + mpz_powm_sec(r, b, e, m); +#endif + + const mp_size_t rn = r[0]._mp_size; + + if (rn) { + assert(0 < rn && rn <= mn); + memcpy(rp, r[0]._mp_d, rn*sizeof(mp_limb_t)); + } + + mpz_clear (r); + + if (!rn) { + rp[0] = 0; + return 1; + } + + return rn; +} + /* wrapper around mpz_invert() * diff --git a/libraries/integer-gmp/include/HsIntegerGmp.h.in b/libraries/integer-gmp/include/HsIntegerGmp.h.in index 4823841881..08ff8dff5f 100644 --- a/libraries/integer-gmp/include/HsIntegerGmp.h.in +++ b/libraries/integer-gmp/include/HsIntegerGmp.h.in @@ -9,3 +9,6 @@ #define GHC_GMP_VERSION_PL @GhcGmpVerPl@ #define GHC_GMP_VERSION \ (@GhcGmpVerMj@ * 10000 + @GhcGmpVerMi@ * 100 + @GhcGmpVerPl@) + +/* Whether GMP supports mpz_powm_sec */ +#define HAVE_SECURE_POWM @HaveSecurePowm@ diff --git a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs index 0d8d5720a8..fcf4da541d 100644 --- a/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs +++ b/libraries/integer-gmp/src/GHC/Integer/GMP/Internals.hs @@ -48,6 +48,7 @@ module GHC.Integer.GMP.Internals , lcmInteger , sqrInteger , powModInteger + , powModSecInteger , recipModInteger -- ** Additional conversion operations to 'Integer' diff --git a/libraries/integer-gmp/src/GHC/Integer/Type.hs b/libraries/integer-gmp/src/GHC/Integer/Type.hs index 952ff6d3e9..cb1ceec271 100644 --- a/libraries/integer-gmp/src/GHC/Integer/Type.hs +++ b/libraries/integer-gmp/src/GHC/Integer/Type.hs @@ -25,6 +25,7 @@ module GHC.Integer.Type where #include "MachDeps.h" +#include "HsIntegerGmp.h" -- Sanity check as CPP defines are implicitly 0-valued when undefined #if !(defined(SIZEOF_LONG) && defined(SIZEOF_HSWORD) \ @@ -1376,6 +1377,32 @@ powModInteger b e m = case m of b' = integerToSBigNat b e' = integerToSBigNat e +-- | \"@'powModSecInteger' /b/ /e/ /m/@\" computes base @/b/@ raised to +-- exponent @/e/@ modulo @/m/@. It is required that @/e/ >= 0@ and +-- @/m/@ is odd. +-- +-- This is a \"secure\" variant of 'powModInteger' using the +-- @mpz_powm_sec()@ function which is designed to be resilient to side +-- channel attacks and is therefore intended for cryptographic +-- applications. +-- +-- This primitive is only available when the underlying GMP library +-- supports it (GMP >= 5). Otherwise, it internally falls back to +-- @'powModInteger'@, and a warning will be emitted when used. +-- +-- @since TODO +{-# NOINLINE powModSecInteger #-} +powModSecInteger :: Integer -> Integer -> Integer -> Integer +powModSecInteger b e m = bigNatToInteger (powModSecSBigNat b' e' m') + where + b' = integerToSBigNat b + e' = integerToSBigNat e + m' = absSBigNat (integerToSBigNat m) + +#if HAVE_SECURE_POWM == 0 +{-# WARNING powModSecInteger "The underlying GMP library does not support a secure version of powModInteger which is side-channel resistant - you need at least GMP version 5 to support this" #-} +#endif + -- | Version of 'powModInteger' operating on 'BigNat's -- -- @since 1.0.0.0 @@ -1428,6 +1455,27 @@ foreign import ccall unsafe "integer_gmp_powm1" integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb# +-- internal non-exported helper +powModSecSBigNat :: SBigNat -> SBigNat -> BigNat -> BigNat +powModSecSBigNat b e m@(BN# m#) = runS $ do + r@(MBN# r#) <- newBigNat# mn# + I# rn_# <- liftIO (integer_gmp_powm_sec# r# b# bn# e# en# m# mn#) + let rn# = narrowGmpSize# rn_# + case isTrue# (rn# ==# mn#) of + False -> unsafeShrinkFreezeBigNat# r rn# + True -> unsafeFreezeBigNat# r + where + !(BN# b#) = absSBigNat b + !(BN# e#) = absSBigNat e + bn# = ssizeofSBigNat# b + en# = ssizeofSBigNat# e + mn# = sizeofBigNat# m + +foreign import ccall unsafe "integer_gmp_powm_sec" + integer_gmp_powm_sec# :: MutableByteArray# RealWorld + -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpSize + -- | \"@'recipModInteger' /x/ /m/@\" computes the inverse of @/x/@ modulo @/m/@. If -- the inverse exists, the return value @/y/@ will satisfy @0 < /y/ < diff --git a/testsuite/tests/lib/integer/integerGmpInternals.hs b/testsuite/tests/lib/integer/integerGmpInternals.hs index 4edf5d6b4a..c90df5c90d 100644 --- a/testsuite/tests/lib/integer/integerGmpInternals.hs +++ b/testsuite/tests/lib/integer/integerGmpInternals.hs @@ -20,13 +20,11 @@ import qualified GHC.Integer.GMP.Internals as I recipModInteger :: Integer -> Integer -> Integer recipModInteger = I.recipModInteger --- FIXME: Lacks GMP2 version gcdExtInteger :: Integer -> Integer -> (Integer, Integer) gcdExtInteger a b = case I.gcdExtInteger a b of (# g, s #) -> (g, s) --- FIXME: Lacks GMP2 version powModSecInteger :: Integer -> Integer -> Integer -> Integer -powModSecInteger = powModInteger +powModSecInteger = I.powModSecInteger powModInteger :: Integer -> Integer -> Integer -> Integer powModInteger = I.powModInteger |