forked from
gazagnaire.org/ocaml-crypto
upstream: https://github.com/mirage/mirage-crypto
Merge pull request #208 from hannesm/pk-no-sexp
mirage-crypto-pk: remove s-expression converters and sexplib0 dependency
authored by
Hannes Mehnert
and committed by
GitHub
ec3e5ba7
9cb2ebd6
+26
-185
-1
mirage-crypto-pk.opam
-1
mirage-crypto-pk.opam
-4
pk/common.ml
-4
pk/common.ml
-50
pk/dh.ml
-50
pk/dh.ml
···
1
1
open Mirage_crypto.Uncommon
2
-
open Sexplib0.Sexp_conv
3
2
4
3
open Common
5
4
···
11
10
q : Z.t option ; (* `gg`'s order, maybe *)
12
11
}
13
12
14
-
let sexp_of_group g =
15
-
Sexplib0.Sexp.List
16
-
[
17
-
sexp_of_pair sexp_of_string sexp_of_z ("p", g.p) ;
18
-
sexp_of_pair sexp_of_string sexp_of_z ("gg", g.gg) ;
19
-
sexp_of_pair sexp_of_string (sexp_of_option sexp_of_z) ("q", g.q)
20
-
]
21
-
22
-
let group_of_sexp = function
23
-
| Sexplib0.Sexp.List [ p ; gg ; q ] as s ->
24
-
let p_str, p = pair_of_sexp string_of_sexp z_of_sexp p in
25
-
let gg_str, gg = pair_of_sexp string_of_sexp z_of_sexp gg in
26
-
let q_str, q = pair_of_sexp string_of_sexp (option_of_sexp z_of_sexp) q in
27
-
if p_str = "p" && gg_str = "gg" && q_str = "q" then
28
-
{ p ; gg ; q }
29
-
else
30
-
raise (Of_sexp_error (Failure "expected p, gg, and q", s))
31
-
| s -> raise (Of_sexp_error (Failure "expected a list with 3 elements", s))
32
-
33
13
let group ~p ~gg ?q () =
34
14
let* () =
35
15
guard (Z.(p > zero && is_odd p) && Z_extra.pseudoprime p)
···
40
20
in
41
21
Ok { p ; gg ; q }
42
22
43
-
let group_of_sexp s =
44
-
let g = group_of_sexp s in
45
-
match group ~p:g.p ~gg:g.gg ?q:g.q () with
46
-
| Error (`Msg m) -> invalid_arg "bad group: %s" m
47
-
| Ok g -> g
48
-
49
23
type secret = { group : group ; x : Z.t }
50
-
51
-
let sexp_of_secret s =
52
-
Sexplib0.Sexp.List
53
-
[
54
-
sexp_of_pair sexp_of_string sexp_of_group ("group", s.group) ;
55
-
sexp_of_pair sexp_of_string sexp_of_z ("x", s.x) ;
56
-
]
57
-
58
-
let secret_of_sexp = function
59
-
| Sexplib0.Sexp.List [ group ; x ] as s ->
60
-
let group_str, group = pair_of_sexp string_of_sexp group_of_sexp group in
61
-
let x_str, x = pair_of_sexp string_of_sexp z_of_sexp x in
62
-
if group_str = "group" && x_str = "x" then
63
-
{ group ; x }
64
-
else
65
-
raise (Of_sexp_error (Failure "expected group and x", s))
66
-
| s -> raise (Of_sexp_error (Failure "expected a list with 2 elements", s))
67
-
68
-
let secret_of_sexp sexp =
69
-
let s = secret_of_sexp sexp in
70
-
if Z.(one < s.x && s.x < s.group.p) then
71
-
s
72
-
else
73
-
invalid_arg "bad secret"
74
24
75
25
(*
76
26
* Estimates of equivalent-strength exponent sizes for the moduli sizes.
-31
pk/dsa.ml
-31
pk/dsa.ml
···
1
1
open Mirage_crypto.Uncommon
2
-
open Sexplib0.Sexp_conv
3
2
4
3
open Common
5
4
6
5
type pub = { p : Z.t ; q : Z.t ; gg : Z.t ; y : Z.t }
7
6
8
-
let sexp_of_pub { p ; q ; gg ; y } =
9
-
sexp_of_list (sexp_of_pair sexp_of_string sexp_of_z)
10
-
[ "p", p; "q", q; "gg", gg; "y", y ]
11
-
12
-
let pub_of_sexp s =
13
-
match list_of_sexp (pair_of_sexp string_of_sexp z_of_sexp) s with
14
-
| [ "p", p; "q", q; "gg", gg; "y", y ] -> { p ; q ; gg ; y }
15
-
| _ -> raise (Of_sexp_error (Failure "expected p, q, gg, and y'", s))
16
-
17
7
let pub ?(fips = false) ~p ~q ~gg ~y () =
18
8
let* () = guard Z.(one < gg && gg < p) (`Msg "bad generator") in
19
9
let* () = guard (Z_extra.pseudoprime q) (`Msg "q is not prime") in
···
30
20
Ok ()
31
21
in
32
22
Ok { p ; q ; gg ; y }
33
-
34
-
let pub_of_sexp s =
35
-
let p = pub_of_sexp s in
36
-
match pub ?fips:None ~p:p.p ~q:p.q ~gg:p.gg ~y:p.y () with
37
-
| Ok p -> p
38
-
| Error (`Msg m) -> invalid_arg "bad public %s" m
39
23
40
24
type priv =
41
25
{ p : Z.t ; q : Z.t ; gg : Z.t ; x : Z.t ; y : Z.t }
42
26
43
-
let sexp_of_priv { p ; q ; gg ; x ; y } =
44
-
sexp_of_list (sexp_of_pair sexp_of_string sexp_of_z)
45
-
[ "p", p; "q", q; "gg", gg; "x", x; "y", y ]
46
-
47
-
let priv_of_sexp s =
48
-
match list_of_sexp (pair_of_sexp string_of_sexp z_of_sexp) s with
49
-
| [ "p", p; "q", q; "gg", gg; "x", x; "y", y ] -> { p ; q ; gg ; x ; y }
50
-
| _ -> raise (Of_sexp_error (Failure "expected p, q, gg, x, and y'", s))
51
-
52
27
let priv ?fips ~p ~q ~gg ~x ~y () =
53
28
let* _ = pub ?fips ~p ~q ~gg ~y () in
54
29
let* () = guard Z.(zero < x && x < q) (`Msg "x not in 1..q-1") in
55
30
let* () = guard Z.(y = powm gg x p) (`Msg "y <> g ^ x mod p") in
56
31
Ok { p ; q ; gg ; x ; y }
57
-
58
-
let priv_of_sexp s =
59
-
let p = priv_of_sexp s in
60
-
match priv ?fips:None ~p:p.p ~q:p.q ~gg:p.gg ~x:p.x ~y:p.y () with
61
-
| Ok p -> p
62
-
| Error (`Msg m) -> invalid_arg "bad private %s" m
63
32
64
33
let pub_of_priv { p; q; gg; y; _ } = { p; q; gg; y }
65
34
+1
-1
pk/dune
+1
-1
pk/dune
+6
-45
pk/mirage_crypto_pk.mli
+6
-45
pk/mirage_crypto_pk.mli
···
30
30
e : Z.t ; (** Public exponent *)
31
31
n : Z.t ; (** Modulus *)
32
32
}
33
-
(** The public portion of the key.
34
-
35
-
{e [Sexplib] convertible}. *)
33
+
(** The public portion of the key. *)
36
34
37
35
val pub : e:Z.t -> n:Z.t -> (pub, [> `Msg of string ]) result
38
36
(** [pub ~e ~n] validates the public key: [1 < e < n], [n > 0],
···
55
53
Some systems assume otherwise. When using keys produced by a system that
56
54
computes [u = p^(-1) mod q], either exchange [p] with [q] and [dp] with
57
55
[dq], or re-generate the full private key using
58
-
{{!priv_of_primes}[priv_of_primes]}.
59
-
60
-
{e [Sexplib] convertible}. *)
56
+
{{!priv_of_primes}[priv_of_primes]}. *)
61
57
62
58
val priv : e:Z.t -> d:Z.t -> n:Z.t -> p:Z.t -> q:Z.t -> dp:Z.t -> dq:Z.t ->
63
59
q':Z.t -> (priv, [> `Msg of string ]) result
···
282
278
283
279
@raise Invalid_argument if message is a [`Digest] of the wrong size. *)
284
280
end
285
-
286
-
(**/**)
287
-
val pub_of_sexp : Sexplib0.Sexp.t -> pub
288
-
val sexp_of_pub : pub -> Sexplib0.Sexp.t
289
-
290
-
val priv_of_sexp : Sexplib0.Sexp.t -> priv
291
-
val sexp_of_priv : priv -> Sexplib0.Sexp.t
292
-
(**/**)
293
-
294
281
end
295
282
296
283
···
306
293
x : Z.t ; (** Private key proper *)
307
294
y : Z.t ; (** Public component *)
308
295
}
309
-
(** Private key. [p], [q] and [gg] comprise {i domain parameters}.
310
-
311
-
{e [Sexplib] convertible}. *)
296
+
(** Private key. [p], [q] and [gg] comprise {i domain parameters}. *)
312
297
313
298
val priv : ?fips:bool -> p:Z.t -> q:Z.t -> gg:Z.t -> x:Z.t -> y:Z.t -> unit ->
314
299
(priv, [> `Msg of string ]) result
···
323
308
gg : Z.t ;
324
309
y : Z.t ;
325
310
}
326
-
(** Public key, a subset of {{!type-priv}private key}.
327
-
328
-
{e [Sexplib] convertible}. *)
311
+
(** Public key, a subset of {{!type-priv}private key}. *)
329
312
330
313
val pub : ?fips:bool -> p:Z.t -> q:Z.t -> gg:Z.t -> y:Z.t -> unit ->
331
314
(pub, [> `Msg of string ]) result
···
396
379
(** [generate key digest] deterministically takes the given private key and
397
380
message digest to a [k] suitable for seeding the signing process. *)
398
381
end
399
-
400
-
(**/**)
401
-
val pub_of_sexp : Sexplib0.Sexp.t -> pub
402
-
val sexp_of_pub : pub -> Sexplib0.Sexp.t
403
-
404
-
val priv_of_sexp : Sexplib0.Sexp.t -> priv
405
-
val sexp_of_priv : priv -> Sexplib0.Sexp.t
406
-
(**/**)
407
-
408
382
end
409
383
410
384
···
425
399
gg : Z.t ; (** generator *)
426
400
q : Z.t option ; (** subgroup order; potentially unknown *)
427
401
}
428
-
(** A DH group.
429
-
430
-
{e [Sexplib] convertible}. *)
402
+
(** A DH group. *)
431
403
432
404
val group : p:Z.t -> gg:Z.t -> ?q:Z.t -> unit ->
433
405
(group, [> `Msg of string ]) result
···
435
407
and greater than [zero]. [gg] must be in the range [1 < gg < p]. *)
436
408
437
409
type secret = private { group : group ; x : Z.t }
438
-
(** A private key.
439
-
440
-
{e [Sexplib] convertible.} *)
410
+
(** A private key. *)
441
411
442
412
val modulus_size : group -> bits
443
413
(** Bit size of the modulus. *)
···
505
475
val ffdhe8192 : group
506
476
507
477
end
508
-
509
-
(**/**)
510
-
val group_of_sexp : Sexplib0.Sexp.t -> group
511
-
val sexp_of_group : group -> Sexplib0.Sexp.t
512
-
513
-
val secret_of_sexp : Sexplib0.Sexp.t -> secret
514
-
val sexp_of_secret : secret -> Sexplib0.Sexp.t
515
-
(**/**)
516
-
517
478
end
518
479
519
480
(** {b Z} Convert Z to big endian Cstruct.t and generate random Z values. *)
-33
pk/rsa.ml
-33
pk/rsa.ml
···
1
1
open Mirage_crypto.Uncommon
2
-
open Sexplib0.Sexp_conv
3
2
4
3
open Common
5
4
···
35
34
36
35
type pub = { e : Z.t ; n : Z.t }
37
36
38
-
let sexp_of_pub { e ; n } =
39
-
sexp_of_list (sexp_of_pair sexp_of_string sexp_of_z)
40
-
[ "e", e ; "n" , n ]
41
-
42
-
let pub_of_sexp s =
43
-
match list_of_sexp (pair_of_sexp string_of_sexp z_of_sexp) s with
44
-
| [ "e", e ; "n", n ] -> { e ; n }
45
-
| _ -> raise (Of_sexp_error (Failure "expected e and n", s))
46
-
47
37
(* due to PKCS1 *)
48
38
let minimum_octets = 12
49
39
let minimum_bits = 8 * minimum_octets - 7
···
65
55
these are not requirements, neither for RSA nor for powm_sec *)
66
56
Ok { e ; n }
67
57
68
-
let pub_of_sexp s =
69
-
let p = pub_of_sexp s in
70
-
match pub ~e:p.e ~n:p.n with
71
-
| Ok p -> p
72
-
| Error (`Msg m) -> failwith "bad public key: %s" m
73
-
74
58
type priv = {
75
59
e : Z.t ; d : Z.t ; n : Z.t ;
76
60
p : Z.t ; q : Z.t ; dp : Z.t ; dq : Z.t ; q' : Z.t
77
61
}
78
62
79
-
let sexp_of_priv { e ; d ; n ; p ; q ; dp ; dq ; q' } =
80
-
sexp_of_list (sexp_of_pair sexp_of_string sexp_of_z)
81
-
[ "e", e; "d", d; "n", n; "p", p; "q", q; "dp", dp; "dq", dq; "q'", q' ]
82
-
83
-
let priv_of_sexp s =
84
-
match list_of_sexp (pair_of_sexp string_of_sexp z_of_sexp) s with
85
-
| [ "e", e; "d", d; "n", n; "p", p; "q", q; "dp", dp; "dq", dq; "q'", q' ] ->
86
-
{ e ; d ; n ; p ; q ; dp ; dq ; q' }
87
-
| _ ->
88
-
raise (Of_sexp_error (Failure "expected e, d, n, p, q, dp, dq, and q'", s))
89
-
90
63
let valid_prime name p =
91
64
guard Z.(p > zero && is_odd p && Z_extra.pseudoprime p)
92
65
(`Msg ("invalid prime " ^ name))
···
119
92
(`Msg "1 <> d * e mod lcm (p - 1) (q - 1)")
120
93
in
121
94
Ok { e ; d ; n ; p ; q ; dp ; dq ; q' }
122
-
123
-
let priv_of_sexp s =
124
-
let p = priv_of_sexp s in
125
-
match priv ~e:p.e ~d:p.d ~n:p.n ~p:p.p ~q:p.q ~dp:p.dp ~dq:p.dq ~q':p.q' with
126
-
| Error (`Msg m) -> failwith "invalid private key %s" m
127
-
| Ok p -> p
128
95
129
96
let priv_of_primes ~e ~p ~q =
130
97
let* () = valid_prime "p" p in
+19
-20
tests/test_rsa.ml
+19
-20
tests/test_rsa.ml
···
37
37
let gen_rsa ~bits =
38
38
let e = Z.(if bits < 24 then ~$3 else ~$0x10001) in
39
39
let key = Rsa.(generate ~e ~bits ()) in
40
-
let key_s = Sexplib0.Sexp.to_string_hum Rsa.(sexp_of_priv key) in
41
40
assert_equal
42
-
~msg:Printf.(sprintf "key size not %d bits:\n%s" bits key_s)
41
+
~msg:Printf.(sprintf "key size not %d bits" bits)
43
42
bits Rsa.(priv_bits key);
44
-
(key, key_s)
43
+
key
45
44
46
45
let rsa_priv_of_primes_regression _ =
47
46
let e = Z.of_string "65537"
···
89
88
Cstruct.set_uint8 cs 0 0;
90
89
Cstruct.(set_uint8 cs i (get_uint8 cs i lor 2));
91
90
cs in
92
-
let (key, key_s) = gen_rsa ~bits in
91
+
let key = gen_rsa ~bits in
93
92
let enc = Rsa.(encrypt ~key:(pub_of_priv key) msg) in
94
93
let dec = Rsa.(decrypt ~key enc) in
95
94
96
95
assert_cs_equal
97
-
~msg:Printf.(sprintf "failed decryption with:\n%s" key_s)
96
+
~msg:Printf.(sprintf "failed decryption with")
98
97
msg dec
99
98
100
99
let show_key_size key =
···
107
106
108
107
let rsa_pkcs1_encode_selftest ~bits n =
109
108
"selftest" >:: times ~n @@ fun _ ->
110
-
let (key, _) = gen_rsa ~bits
111
-
and msg = pkcs_message_for_bits bits in
112
-
let sgn = Rsa.PKCS1.sig_encode ~key msg in
109
+
let key = gen_rsa ~bits
110
+
and msg = pkcs_message_for_bits bits in
111
+
let sgn = Rsa.PKCS1.sig_encode ~key msg in
113
112
match Rsa.(PKCS1.sig_decode ~key:(pub_of_priv key) sgn) with
114
113
| None -> assert_failure ("unpad failure " ^ show_key_size key)
115
114
| Some dec -> assert_cs_equal msg dec
···
118
117
let rsa_pkcs1_sign_selftest n =
119
118
let open Hash.SHA1 in
120
119
"selftest" >:: times ~n @@ fun _ ->
121
-
let (key, _) = gen_rsa ~bits:(Rsa.PKCS1.min_key `SHA1)
122
-
and msg = Mirage_crypto_rng.generate 47 in
123
-
let pkey = Rsa.pub_of_priv key in
120
+
let key = gen_rsa ~bits:(Rsa.PKCS1.min_key `SHA1)
121
+
and msg = Mirage_crypto_rng.generate 47 in
122
+
let pkey = Rsa.pub_of_priv key in
124
123
assert_bool "invert 1" Rsa.PKCS1.(
125
124
verify ~key:pkey ~hashp:any (`Message msg)
126
125
~signature:(sign ~hash:`SHA1 ~key (`Digest (digest msg))) );
···
130
129
131
130
let rsa_pkcs1_encrypt_selftest ~bits n =
132
131
"selftest" >:: times ~n @@ fun _ ->
133
-
let (key, _) = gen_rsa ~bits
134
-
and msg = pkcs_message_for_bits bits in
135
-
let enc = Rsa.(PKCS1.encrypt ~key:(pub_of_priv key) msg) in
132
+
let key = gen_rsa ~bits
133
+
and msg = pkcs_message_for_bits bits in
134
+
let enc = Rsa.(PKCS1.encrypt ~key:(pub_of_priv key) msg) in
136
135
match Rsa.PKCS1.decrypt ~key enc with
137
136
| None -> assert_failure ("unpad failure " ^ show_key_size key)
138
137
| Some dec -> assert_cs_equal msg dec
···
143
142
"selftest" >:: times ~n @@ fun _ ->
144
143
let module H = (val (Hash.module_of (sample hashes))) in
145
144
let module OAEP = Rsa.OAEP (H) in
146
-
let (key, _) = gen_rsa ~bits
147
-
and msg = Mirage_crypto_rng.generate (bits // 8 - 2 * H.digest_size - 2) in
148
-
let enc = OAEP.encrypt ~key:(Rsa.pub_of_priv key) msg in
145
+
let key = gen_rsa ~bits
146
+
and msg = Mirage_crypto_rng.generate (bits // 8 - 2 * H.digest_size - 2) in
147
+
let enc = OAEP.encrypt ~key:(Rsa.pub_of_priv key) msg in
149
148
match OAEP.decrypt ~key enc with
150
149
| None -> assert_failure "unpad failure"
151
150
| Some dec -> assert_cs_equal msg dec ~msg:"recovery failure"
···
154
153
let module Pss_sha1 = Rsa.PSS (Hash.SHA1) in
155
154
let open Hash.SHA1 in
156
155
"selftest" >:: times ~n @@ fun _ ->
157
-
let (key, _) = gen_rsa ~bits
158
-
and msg = Mirage_crypto_rng.generate 1024 in
159
-
let pkey = Rsa.pub_of_priv key in
156
+
let key = gen_rsa ~bits
157
+
and msg = Mirage_crypto_rng.generate 1024 in
158
+
let pkey = Rsa.pub_of_priv key in
160
159
Pss_sha1.(verify ~key:pkey (`Message msg)
161
160
~signature:(sign ~key (`Digest (digest msg))))
162
161
|> assert_bool "invert 1" ;