RSA-CRT hardening

- PKCS1 sign verifies that the computed signature is a valid signature (see
  Arjen Lenstra 1996, Florian Weimer 2015
  https://people.redhat.com/~fweimer/rsa-crt-leaks.pdf)
- other RSA operations (including decrypt / PSS / ..): extend with optional
  `rsa_crt_hardening:bool` argument (defaulting to false)

pk/mirage_crypto_pk.mli

@@ -134,9 +134,17 @@ module Rsa : sig
 
       @raise Invalid_argument if [message] is [0x00] or [0x01]. *)
 
-  val decrypt : ?mask:mask -> key:priv -> Cstruct.t -> Cstruct.t
-  (** [decrypt ~mask key ciphertext] is the decrypted [ciphertext], left-padded
-      with [0x00] up to [key] size.
+  val decrypt : ?rsa_crt_hardening:bool -> ?mask:mask -> key:priv ->
+    Cstruct.t -> Cstruct.t
+  (** [decrypt ~rsa_crt_hardening ~mask key ciphertext] is the decrypted
+      [ciphertext], left-padded with [0x00] up to [key] size.
+
+      [~rsa_crt_hardening] defaults to [false]. If [true] verifies that the
+      result is correct. This is to counter Chinese remainder theorem attacks to
+      factorize primes. If the computed signature is incorrrect, it is again
+      computed in the classical way (c ^ d mod n) without the Chinese remainder
+      theorem optimization. The deterministic PKCS1 signing, which is at danger,
+      uses [true] as default.
 
       [~mask] defaults to [`Yes].
 
@@ -171,14 +179,18 @@ module Rsa : sig
 
         @raise Insufficient_key (see {{!Insufficient_key}Insufficient_key}) *)
 
-    val decrypt : ?mask:mask -> key:priv -> Cstruct.t -> Cstruct.t option
-    (** [decrypt mask key ciphertext] is [Some message] if the [ciphertext] was
-        produced by the corresponding {{!encrypt}encrypt} operation, or [None]
-        otherwise. *)
+    val decrypt : ?rsa_crt_hardening:bool -> ?mask:mask -> key:priv ->
+      Cstruct.t -> Cstruct.t option
+    (** [decrypt ~rsa_crt_hardening ~mask ~key ciphertext] is [Some message] if
+        the [ciphertext] was produced by the corresponding {{!encrypt}encrypt}
+        operation, or [None] otherwise. [rsa_crt_hardening] defaults to
+        [false]. *)
 
-    val sig_encode : ?mask:mask -> key:priv -> Cstruct.t -> Cstruct.t
-    (** [sig_encode ?mask ~key message] is the PKCS1-padded (type 1) [message]
-        signed by the [key].
+    val sig_encode : ?rsa_crt_hardening:bool -> ?mask:mask -> key:priv ->
+      Cstruct.t -> Cstruct.t
+    (** [sig_encode ~rsa_crt_hardening ~mask ~key message] is the PKCS1-padded
+        (type 1) [message] signed by the [key]. [rsa_crt_hardening] defaults to
+        [true] and verifies that the computed signature is correct.
 
         {b Note} This operation performs only the padding and RSA transformation
         steps of the PKCS 1.5 signature. The full signature is implemented by
@@ -194,18 +206,23 @@ module Rsa : sig
     val min_key : Mirage_crypto.Hash.hash -> bits
     (** [min_key hash] is the minimum key size required by {{!sign}[sign]}. *)
 
-    val sign : ?mask:mask -> hash:Mirage_crypto.Hash.hash -> key:priv -> Cstruct.t or_digest -> Cstruct.t
-    (** [sign ?mask ~hash ~key message] is the PKCS 1.5 signature of
-        [message], signed by the [key], using the hash function [hash]. This is
-        the full signature, with the ASN-encoded message digest as the payload.
+    val sign : ?rsa_crt_hardening:bool -> ?mask:mask ->
+      hash:Mirage_crypto.Hash.hash -> key:priv -> Cstruct.t or_digest ->
+      Cstruct.t
+    (** [sign ~rsa_crt_hardening ~mask ~hash ~key message] is the PKCS 1.5
+        signature of [message], signed by the [key], using the hash function
+        [hash]. This is the full signature, with the ASN-encoded message digest
+        as the payload. [rsa_crt_hardening] defaults to [true] and verifies that
+        the computed signature is correct.
 
         [message] is either the actual message, or its digest.
 
         @raise Insufficient_key (see {{!Insufficient_key}Insufficient_key})
 
         @raise Invalid_argument if message is a [`Digest] of the wrong size.  *)
 
-    val verify : hashp:(Mirage_crypto.Hash.hash -> bool) -> key:pub -> signature:Cstruct.t -> Cstruct.t or_digest -> bool
+    val verify : hashp:(Mirage_crypto.Hash.hash -> bool) -> key:pub ->
+      signature:Cstruct.t -> Cstruct.t or_digest -> bool
     (** [verify ~hashp ~key ~signature message] checks that [signature] is the
         PKCS 1.5 signature of the [message] under the given [key].
 
@@ -226,16 +243,19 @@ module Rsa : sig
       [hlen] is the hash length. *)
   module OAEP (H : Mirage_crypto.Hash.S) : sig
 
-    val encrypt : ?g:Mirage_crypto_rng.g -> ?label:Cstruct.t -> key:pub -> Cstruct.t -> Cstruct.t
+    val encrypt : ?g:Mirage_crypto_rng.g -> ?label:Cstruct.t -> key:pub ->
+      Cstruct.t -> Cstruct.t
     (** [encrypt ~g ~label ~key message] is {b OAEP}-padded and encrypted
         [message], using the optional [label].
 
         @raise Insufficient_key (see {{!Insufficient_key}Insufficient_key}) *)
 
-    val decrypt : ?mask:mask -> ?label:Cstruct.t -> key:priv -> Cstruct.t -> Cstruct.t option
-    (** [decrypt ~mask ~label ~key ciphertext] is [Some message] if the
-        [ciphertext] was produced by the corresponding {{!encrypt}encrypt}
-        operation, or [None] otherwise. *)
+    val decrypt : ?rsa_crt_hardening:bool -> ?mask:mask -> ?label:Cstruct.t ->
+      key:priv -> Cstruct.t -> Cstruct.t option
+    (** [decrypt ~rsa_crt_hardening ~mask ~label ~key ciphertext] is
+        [Some message] if the [ciphertext] was produced by the corresponding
+        {{!encrypt}encrypt} operation, or [None] otherwise. [rsa_crt_hardening]
+        defaults to [false]. *)
   end
 
   (** {b PSS}-based signing, as defined by {b PKCS #1 v2.1}.
@@ -247,9 +267,11 @@ module Rsa : sig
       hash length and [slen] is the seed length. *)
   module PSS (H: Mirage_crypto.Hash.S) : sig
 
-    val sign : ?g:Mirage_crypto_rng.g -> ?mask:mask -> ?slen:int -> key:priv -> Cstruct.t or_digest -> Cstruct.t
-    (** [sign ~g ~mask ~slen ~key message] the {p PSS}-padded digest of
-        [message], signed with the [key].
+    val sign : ?g:Mirage_crypto_rng.g -> ?rsa_crt_hardening:bool ->
+      ?mask:mask -> ?slen:int -> key:priv -> Cstruct.t or_digest -> Cstruct.t
+    (** [sign ~g ~rsa_crt_hardening ~mask ~slen ~key message] the {p PSS}-padded
+        digest of [message], signed with the [key]. [rsa_crt_hardening] defaults
+        to [false].
 
         [slen] is the optional seed length and defaults to the size of the
         underlying hash function.

pk/rsa.ml

@@ -77,35 +77,44 @@ and priv_bits ({ n; _ } : priv) = Numeric.Z.bits n
 
 let encrypt_unsafe ~key: ({ e; n } : pub) msg = Z.(powm msg e n)
 
-let decrypt_unsafe ~key: ({ p; q; dp; dq; q'; _} : priv) c =
+let decrypt_unsafe ~rsa_crt_hardening ~key:({ e; d; n; p; q; dp; dq; q'} : priv) c =
   let m1 = Z.(powm_sec c dp p)
   and m2 = Z.(powm_sec c dq q) in
   let h  = Z.(erem (q' * (m1 - m2)) p) in
-  Z.(h * q + m2)
-
-let decrypt_blinded_unsafe ?g ~key: ({ e; n; _} as key : priv) c =
+  let m  = Z.(h * q + m2) in
+  (* counter Arjen Lenstra's CRT attack by verifying the signature. Since the
+     public exponent is small, this is not very expensive. Mentioned again
+     "Factoring RSA keys with TLS Perfect Forward Secrecy" (Weimer, 2015). *)
+  if not rsa_crt_hardening || Z.(powm m e n) = c then
+    m
+  else
+    Z.(powm_sec c d n)
+
+let decrypt_blinded_unsafe ~rsa_crt_hardening ?g ~key:({ e; n; _} as key : priv) c =
   let r  = until (rprime n) (fun _ -> Rng.Z.gen_r ?g Z.two n) in
   let r' = Z.(invert r n) in
-  let x  = decrypt_unsafe ~key Z.(powm_sec r e n * c mod n) in
+  let x  = decrypt_unsafe ~rsa_crt_hardening ~key Z.(powm_sec r e n * c mod n) in
   Z.(r' * x mod n)
 
 let (encrypt_z, decrypt_z) =
   let check_params n msg =
     if msg < Z.two then invalid_arg "Rsa: message: %a" Z.pp_print msg;
     if n <= msg then raise Insufficient_key in
   (fun ~(key : pub) msg -> check_params key.n msg ; encrypt_unsafe ~key msg),
-  (fun ~mask ~(key : priv) msg ->
+  (fun ~rsa_crt_hardening ~mask ~(key : priv) msg ->
     check_params key.n msg ;
     match mask with
-    | `No         -> decrypt_unsafe            ~key msg
-    | `Yes        -> decrypt_blinded_unsafe    ~key msg
-    | `Yes_with g -> decrypt_blinded_unsafe ~g ~key msg )
+    | `No         -> decrypt_unsafe ~rsa_crt_hardening ~key msg
+    | `Yes        -> decrypt_blinded_unsafe ~rsa_crt_hardening ~key msg
+    | `Yes_with g -> decrypt_blinded_unsafe ~rsa_crt_hardening ~g ~key msg )
 
 let reformat out f msg =
   Numeric.Z.(of_cstruct_be msg |> f |> to_cstruct_be ~size:(out // 8))
 
 let encrypt ~key              = reformat (pub_bits key)  (encrypt_z ~key)
-and decrypt ?(mask=`Yes) ~key = reformat (priv_bits key) (decrypt_z ~mask ~key)
+
+let decrypt ?(rsa_crt_hardening=false) ?(mask=`Yes) ~key =
+  reformat (priv_bits key) (decrypt_z ~rsa_crt_hardening ~mask ~key)
 
 let well_formed ~e ~p ~q =
   Z.three <= e && p <> q &&
@@ -175,17 +184,17 @@ module PKCS1 = struct
       try unpad (transform msg) with Insufficient_key -> None
     else None
 
-  let sig_encode ?mask ~key msg =
-    padded pad_01 (decrypt ?mask ~key) (priv_bits key) msg
+  let sig_encode ?(rsa_crt_hardening = true) ?mask ~key msg =
+    padded pad_01 (decrypt ~rsa_crt_hardening ?mask ~key) (priv_bits key) msg
 
   let sig_decode ~key msg =
     unpadded unpad_01 (encrypt ~key) (pub_bits key) msg
 
   let encrypt ?g ~key msg =
     padded (pad_02 ?g) (encrypt ~key) (pub_bits key) msg
 
-  let decrypt ?mask ~key msg =
-    unpadded unpad_02 (decrypt ?mask ~key) (priv_bits key) msg
+  let decrypt ?(rsa_crt_hardening = false) ?mask ~key msg =
+    unpadded unpad_02 (decrypt ~rsa_crt_hardening ?mask ~key) (priv_bits key) msg
 
   let asns = List.(combine Hash.hashes &. map of_string) [
     "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10"     (* md5 *)
@@ -200,8 +209,9 @@ module PKCS1 = struct
 
   let detect msg = List.find_opt (fun (_, asn) -> Cs.is_prefix asn msg) asns
 
-  let sign ?mask ~hash ~key msg =
-    sig_encode ?mask ~key Cs.(asn_of_hash hash <+> digest_or ~hash msg)
+  let sign ?(rsa_crt_hardening = true) ?mask ~hash ~key msg =
+    let msg' = Cs.(asn_of_hash hash <+> digest_or ~hash msg) in
+    sig_encode ~rsa_crt_hardening ?mask ~key msg'
 
   let verify ~hashp ~key ~signature msg =
     let open Option in
@@ -261,10 +271,10 @@ module OAEP (H : Hash.S) = struct
     if len msg > max_msg_bytes k then raise Insufficient_key
     else encrypt ~key @@ eme_oaep_encode ?g ?label k msg
 
-  let decrypt ?mask ?label ~key em =
+  let decrypt ?(rsa_crt_hardening = false) ?mask ?label ~key em =
     let k = priv_bits key // 8 in
     if len em <> k || max_msg_bytes k < 0 then None else
-      try eme_oaep_decode ?label @@ decrypt ?mask ~key em
+      try eme_oaep_decode ?label @@ decrypt ~rsa_crt_hardening ?mask ~key em
       with Insufficient_key -> None
 
   (* XXX Review rfc3447 7.1.2 and
@@ -317,10 +327,12 @@ module PSS (H: Hash.S) = struct
   let sufficient_key ~slen kbits =
     hlen + slen + 2 <= kbits / 8 (* 8 * (hlen + slen + 1) + 2 <= kbits *)
 
-  let sign ?g ?mask ?(slen = hlen) ~key msg =
+  let sign ?g ?(rsa_crt_hardening = false) ?mask ?(slen = hlen) ~key msg =
     let b = priv_bits key in
     if not (sufficient_key ~slen b) then raise Insufficient_key
-    else decrypt ?mask ~key @@ emsa_pss_encode ?g (imax 0 slen) (b - 1) msg
+    else
+      let msg' = emsa_pss_encode ?g (imax 0 slen) (b - 1) msg in
+      decrypt ~rsa_crt_hardening ?mask ~key msg'
 
   let verify ?(slen = hlen) ~key ~signature msg =
     let b = pub_bits key