Do not allow sloppy keys.

They were not sloppy after all, and should be accepted at mirage-crypto
level.

It reverts most of the changes in
f4dd7dc while keeping the regression
test.

Signed-off-by: Pau Ruiz Safont <pau.safont@citrix.com>

CHANGES.md

@@ -1,3 +1,8 @@
+## v0.12.0
+
+* BREAKING Remove `~sloppy` from Private_key.decode_{pem,der}. The seemingly
+  bad RSA keys were valid and should have been accepted by mirage-crypto.
+
 ## v0.11.2 (2020-05-14)
 
 * Private_key.decode_{pem,der} now has a `~sloppy` option to recover from

lib/private_key.ml

@@ -1,6 +1,3 @@
-let src = Logs.Src.create "x509.private_key" ~doc:"X509 private key"
-module Log = (val Logs.src_log src : Logs.LOG)
-
 type t = [ `RSA of Mirage_crypto_pk.Rsa.priv ]
 
 let keytype = function
@@ -18,24 +15,13 @@ module Asn = struct
         (required ~label:"exponent"    integer)
         (required ~label:"coefficient" integer))
 
-  let rsa_private_key ~sloppy =
+  let rsa_private_key =
     let f (v, (n, (e, (d, (p, (q, (dp, (dq, (q', other))))))))) =
       match (v, other) with
       | (0, None) ->
         begin match Rsa.priv ~e ~d ~n ~p ~q ~dp ~dq ~q' with
           | Ok p -> p
-          | Error (`Msg msg) as err ->
-            let r =
-              if sloppy then begin
-                Log.warn (fun m -> m "sloppy decoding mode: Rsa.priv failed with \
-                                      %s, using Rsa.priv_of_primes" msg);
-                Rsa.priv_of_primes ~e ~p ~q
-              end else
-                err
-            in
-            match r with
-            | Ok p -> p
-            | Error (`Msg m) -> parse_error "bad RSA private key %s" m
+          | Error (`Msg m) -> parse_error "bad RSA private key %s" m
         end
       | _         -> parse_error "multi-prime RSA keys not supported"
     and g { Rsa.e; d; n; p; q; dp; dq; q' } =
@@ -54,25 +40,22 @@ module Asn = struct
      -@ (optional ~label:"otherPrimeInfos" other_prime_infos)
 
   (* For outside uses. *)
-  let rsa_private_of_cstruct ~sloppy =
-    Asn_grammars.decode (Asn.codec Asn.der (rsa_private_key ~sloppy))
+  let (rsa_private_of_cstruct, rsa_private_to_cstruct) =
+    Asn_grammars.projections_of Asn.der rsa_private_key
 
   (* PKCS8 *)
-  let rsa_priv_of_cs ~sloppy =
-    fst (Asn_grammars.project_exn (rsa_private_key ~sloppy))
-
-  let rsa_priv_to_cs =
-    snd (Asn_grammars.project_exn (rsa_private_key ~sloppy:false))
+  let (rsa_priv_of_cs, rsa_priv_to_cs) =
+    Asn_grammars.project_exn rsa_private_key
 
-  let reparse_private ~sloppy = function
-    | (0, Algorithm.RSA, cs) -> rsa_priv_of_cs ~sloppy cs
+  let reparse_private = function
+    | (0, Algorithm.RSA, cs) -> rsa_priv_of_cs cs
     | _ -> parse_error "unknown private key info"
 
   let unparse_private pk =
     (0, Algorithm.RSA, rsa_priv_to_cs pk)
 
-  let private_key_info ~sloppy =
-    map (reparse_private ~sloppy) unparse_private @@
+  let private_key_info =
+    map reparse_private unparse_private @@
     sequence3
       (required ~label:"version"             int)
       (required ~label:"privateKeyAlgorithm" Algorithm.identifier)
@@ -81,25 +64,23 @@ module Asn = struct
          (optional ~label:"attributes" @@ implicit 0 (SET of Attributes)
          which are defined in X.501; but nobody seems to use them anyways *)
 
-  let private_of_cstruct ~sloppy =
-    Asn_grammars.decode (Asn.codec Asn.der (private_key_info ~sloppy))
+  let private_of_cstruct = rsa_private_of_cstruct
 
-  let private_to_cstruct =
-    snd (Asn_grammars.projections_of Asn.der (private_key_info ~sloppy:false))
+  let private_to_cstruct = rsa_private_to_cstruct
 end
 
 (* TODO what about RSA PRIVATE vs PRIVATE?
    - atm decode handles both, encode uses PRIVATE *)
 
-let decode_der ?(sloppy = false) cs =
+let decode_der cs =
   let open Rresult.R.Infix in
-  Asn_grammars.err_to_msg (Asn.private_of_cstruct ~sloppy cs) >>| fun key ->
+  Asn_grammars.err_to_msg (Asn.private_of_cstruct cs) >>| fun key ->
   `RSA key
 
 let encode_der = function
   | `RSA k -> Asn.private_to_cstruct k
 
-let decode_pem ?(sloppy = false) cs =
+let decode_pem cs =
   let open Rresult.R.Infix in
   Pem.parse cs >>= fun data ->
   let rsa_p (t, _) = String.equal "RSA PRIVATE KEY" t
@@ -109,9 +90,9 @@ let decode_pem ?(sloppy = false) cs =
   and p, _ = List.partition pk_p data
   in
   Pem.foldM (fun (_, k) ->
-      Asn_grammars.err_to_msg (Asn.rsa_private_of_cstruct ~sloppy k)) r >>= fun k ->
+      Asn_grammars.err_to_msg (Asn.rsa_private_of_cstruct k)) r >>= fun k ->
   Pem.foldM (fun (_, k) ->
-      Asn_grammars.err_to_msg (Asn.private_of_cstruct ~sloppy k)) p >>= fun k' ->
+      Asn_grammars.err_to_msg (Asn.private_of_cstruct k)) p >>= fun k' ->
   Pem.exactly_one ~what:"private key" (k @ k') >>| fun k ->
   `RSA k
 

lib/x509.mli

@@ -110,21 +110,18 @@ module Private_key : sig
   (** The polymorphic variant of private keys. *)
   type t = [ `RSA of Mirage_crypto_pk.Rsa.priv ]
 
-  (** [decode_der ~sloppy der] is [t], where the private key of [der] is
-      extracted. If [sloppy] is provided and [true] (default: false),
-      the key will be reconstructed from its prime numbers and public exponent.
-      It must be in PKCS8 (RFC 5208, Section 5) PrivateKeyInfo structure. *)
-  val decode_der : ?sloppy:bool -> Cstruct.t -> (t, [> R.msg ]) result
+  (** [decode_der der] is [t], where the private key of [der] is
+      extracted. It must be in PKCS8 (RFC 5208, Section 5) PrivateKeyInfo structure. *)
+  val decode_der : Cstruct.t -> (t, [> R.msg ]) result
 
   (** [encode_der key] is [der], the encoded private key as PKCS8 (RFC 5208,
       Section 5) PrivateKeyInfo structure. *)
   val encode_der : t -> Cstruct.t
 
-  (** [decode_pem ~sloppy pem] is [t], where the private key of [pem] is
-      extracted. If [sloppy] is provided and [true] (default: false),
-      the key will be reconstructed from its prime numbers and public exponent.
+  (** [decode_pem pem] is [t], where the private key of [pem] is
+      extracted.
       Both RSA PRIVATE KEY and PRIVATE KEY stanzas are supported. *)
-  val decode_pem : ?sloppy:bool -> Cstruct.t -> (t, [> R.msg ]) result
+  val decode_pem : Cstruct.t -> (t, [> R.msg ]) result
 
   (** [encode_pem key] is [pem], the encoded private key (using [PRIVATE KEY]). *)
   val encode_pem : t -> Cstruct.t

tests/regression.ml

@@ -128,23 +128,10 @@ let test_gcloud_key () =
   (* discussion in https://github.com/mirage/mirage-crypto/issues/62 *)
   let file = "gcloud" in
   let data = regression file in
-  (match Private_key.decode_pem data with
-   | Ok _ -> Alcotest.failf "private key %s, expected decoding error" file
-   | Error (`Msg _) -> ());
-  let se = Z.of_string "65537"
-  (* this is the corrected d, not the one in the pem file *)
-  and sd = Z.of_string "14478488456493997022050901254933187283477471093730790501398788655730567398785569687606371375833982881640341621750217365889195783772533872059213352159991519189252958281611111674194879268059270441114992706457776068423799377349279105810697994588771736756653040288343674720701103312293833268317569088656494668685468231474583321288404898183773189583378716851384814309675472367486143664598456832085685494812222081088113517604012395897413142572181545766173226135421363439763543055673991957871436777026724320844849270331575138060361110954859703148073754901925506317313296044480539229720254636858871012875313416588048255023749"
-  and sp = Z.of_string "153903575880038685371306078431309624429262243098160628077155385424784731704538502041682563231842507936315834999272165353754081206847521073697105321898935865522941018859502063500927758809727634595752231111149172755709224739427971151799944749671230555614514021717987321482212474581192462617805386071920647746527"
-  and sq = Z.of_string "147755586168842154977618773600930512327712333912540690382962931855233965897097814139102488669702400832893695675498969512696944576662243412004204531041931249551207758395795244675585651830739018019197553505240463928167645984560980989768623533294470387237934457819888352229242173694504296968786124698140038767907"
-  in
-  (match Private_key.decode_pem ~sloppy:true data with
-   | Ok (`RSA { Mirage_crypto_pk.Rsa.p ; q ; e ; d ; _ }) ->
-     if se = e && sd = d && sp = p && sq = q then
-       ()
-     else
-       Alcotest.failf "private key %s, wrong e, d, p, q" file
+  match Private_key.decode_pem data with
+   | Ok _ -> ()
    | Error (`Msg _) ->
-     Alcotest.failf "private key %s, expected sloppy decoding" file)
+       Alcotest.failf "private key %s failed to be verified" file
 
 let regression_tests = [
   "RSA: key too small (jc_jc)", `Quick, test_jc_jc ;
@@ -158,7 +145,7 @@ let regression_tests = [
   "distinguished name pp", `Quick, test_distinguished_name_pp ;
   "algorithm without null", `Quick, test_yubico ;
   "valid until generalized_time with fractional seconds", `Quick, test_frac_s ;
-  "sloppy private key parsing", `Quick, test_gcloud_key ;
+  "parse valid key where d * e mod (p - 1) * (q - 1) ≠ 1", `Quick, test_gcloud_key ;
 ]
 
 let host_set_test =

x509.opam

@@ -18,7 +18,7 @@ depends: [
   "asn1-combinators" {>= "0.2.0"}
   "ptime"
   "base64" {>= "3.0.0"}
-  "mirage-crypto"
+  "mirage-crypto" {> "0.8.8"}
   "mirage-crypto-pk"
   "rresult"
   "fmt" {>= "0.8.7"}