anil.recoil.org
forked from
gazagnaire.org/ocaml-crypto
upstream: https://github.com/mirage/mirage-crypto
Require OCaml 4.13 and remove local overrides
+1
-1
.github/workflows/test.yml
+1
-1
.github/workflows/test.yml
+1
-1
.github/workflows/windows.yml
+1
-1
.github/workflows/windows.yml
+6
-10
ec/mirage_crypto_ec.ml
+6
-10
ec/mirage_crypto_ec.ml
···
28
29
exception Message_too_long
30
31
-
let string_get_uint8 buf idx =
32
-
(* TODO: use String.get_uint8 when mirage-crypto-ec requires OCaml >= 4.13 *)
33
-
Bytes.get_uint8 (Bytes.unsafe_of_string buf) idx
34
-
35
let bit_at buf i =
36
let byte_num = i / 8 in
37
let bit_num = i mod 8 in
38
-
let byte = string_get_uint8 buf byte_num in
39
byte land (1 lsl bit_num) <> 0
40
41
module type Dh = sig
···
320
if compress then
321
let out = Bytes.create (P.byte_length + 1) in
322
let ident =
323
-
2 + (string_get_uint8 buf ((P.byte_length * 2) - 1)) land 1
324
in
325
Bytes.unsafe_blit_string buf 1 out 1 P.byte_length;
326
Bytes.set_uint8 out 0 ident;
···
389
let y' = Fe.from_montgomery y' in
390
let y_struct2 = Fe.to_octets y' in (* number must not be in montgomery domain*)
391
let y_struct2 = rev_string y_struct2 in
392
-
let ident = string_get_uint8 pk 0 in
393
let signY =
394
-
2 + (string_get_uint8 y_struct (P.byte_length - 2)) land 1
395
in
396
let res = if Int.equal signY ident then y_struct else y_struct2 in
397
let out = Bytes.create ((P.byte_length * 2) + 1) in
···
410
let y = String.sub buf (1 + len) len in
411
validate_finite_point ~x ~y
412
in
413
-
match string_get_uint8 buf 0 with
414
| 0x00 when String.length buf = 1 ->
415
Ok (at_infinity ())
416
| 0x02 | 0x03 when String.length P.pident > 0 ->
···
614
let first_byte_ok () =
615
match Param.first_byte_bits with
616
| None -> true
617
-
| Some m -> (string_get_uint8 msg 0) land (0xFF land (lnot m)) = 0
618
in
619
if l > bl || (l = bl && not (first_byte_ok ())) then
620
raise Message_too_long
···
28
29
exception Message_too_long
30
31
let bit_at buf i =
32
let byte_num = i / 8 in
33
let bit_num = i mod 8 in
34
+
let byte = String.get_uint8 buf byte_num in
35
byte land (1 lsl bit_num) <> 0
36
37
module type Dh = sig
···
316
if compress then
317
let out = Bytes.create (P.byte_length + 1) in
318
let ident =
319
+
2 + (String.get_uint8 buf ((P.byte_length * 2) - 1)) land 1
320
in
321
Bytes.unsafe_blit_string buf 1 out 1 P.byte_length;
322
Bytes.set_uint8 out 0 ident;
···
385
let y' = Fe.from_montgomery y' in
386
let y_struct2 = Fe.to_octets y' in (* number must not be in montgomery domain*)
387
let y_struct2 = rev_string y_struct2 in
388
+
let ident = String.get_uint8 pk 0 in
389
let signY =
390
+
2 + (String.get_uint8 y_struct (P.byte_length - 2)) land 1
391
in
392
let res = if Int.equal signY ident then y_struct else y_struct2 in
393
let out = Bytes.create ((P.byte_length * 2) + 1) in
···
406
let y = String.sub buf (1 + len) len in
407
validate_finite_point ~x ~y
408
in
409
+
match String.get_uint8 buf 0 with
410
| 0x00 when String.length buf = 1 ->
411
Ok (at_infinity ())
412
| 0x02 | 0x03 when String.length P.pident > 0 ->
···
610
let first_byte_ok () =
611
match Param.first_byte_bits with
612
| None -> true
613
+
| Some m -> (String.get_uint8 msg 0) land (0xFF land (lnot m)) = 0
614
in
615
if l > bl || (l = bl && not (first_byte_ok ())) then
616
raise Message_too_long
+1
-1
mirage-crypto-ec.opam
+1
-1
mirage-crypto-ec.opam
+1
-1
mirage-crypto-pk.opam
+1
-1
mirage-crypto-pk.opam
+1
-1
mirage-crypto-rng-async.opam
+1
-1
mirage-crypto-rng-async.opam
+1
-1
mirage-crypto-rng-lwt.opam
+1
-1
mirage-crypto-rng-lwt.opam
+1
-1
mirage-crypto-rng-mirage.opam
+1
-1
mirage-crypto-rng-mirage.opam
+1
-1
mirage-crypto-rng.opam
+1
-1
mirage-crypto-rng.opam
+1
-1
mirage-crypto.opam
+1
-1
mirage-crypto.opam
+10
-19
pk/rsa.ml
+10
-19
pk/rsa.ml
···
197
let decrypt ?(crt_hardening=false) ?(mask=`Yes) ~key =
198
reformat (priv_bits key) (decrypt_z ~crt_hardening ~mask ~key)
199
200
-
(* OCaml 4.13 *)
201
-
let string_get_uint8 buf idx =
202
-
Bytes.get_uint8 (Bytes.unsafe_of_string buf) idx
203
-
204
let bx00, bx01 = "\x00", "\x01"
205
206
module PKCS1 = struct
···
214
let rec go nonce i j =
215
if i = n then Bytes.unsafe_to_string buf else
216
if j = k then go Mirage_crypto_rng.(generate ?g k) i 0 else
217
-
match string_get_uint8 nonce j with
218
| b when f b -> Bytes.set_uint8 buf i b ; go nonce (succ i) (succ j)
219
| _ -> go nonce i (succ j) in
220
go Mirage_crypto_rng.(generate ?g k) 0 0
···
226
let unpad ~mark ~is_pad buf =
227
let f = not &. is_pad in
228
let i = ct_find_uint8 ~default:2 ~off:2 ~f buf in
229
-
let c1 = string_get_uint8 buf 0 = 0x00
230
-
and c2 = string_get_uint8 buf 1 = mark
231
-
and c3 = string_get_uint8 buf i = 0x00
232
and c4 = min_pad <= i - 2 in
233
if c1 && c2 && c3 && c4 then
234
Some (String.sub buf (i + 1) (String.length buf - i - 1))
···
264
let decrypt ?(crt_hardening = false) ?mask ~key msg =
265
unpadded unpad_02 (decrypt ~crt_hardening ?mask ~key) (priv_bits key) msg
266
267
-
(* OCaml 4.13 contains starts_with *)
268
-
let is_prefix asn msg =
269
-
String.length msg >= String.length asn &&
270
-
String.equal asn (String.sub msg 0 (String.length asn))
271
-
272
let asn_of_hash, detect =
273
let map = [
274
`MD5, "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" ;
···
280
]
281
in
282
(fun h -> List.assoc h map),
283
-
(fun buf -> List.find_opt (fun (_, d) -> is_prefix d buf) map)
284
285
let sign ?(crt_hardening = true) ?mask ~hash ~key msg =
286
let module H = (val Digestif.module_of_hash' (hash :> Digestif.hash')) in
···
353
let db = Bytes.unsafe_to_string (MGF.mask ~seed:(Bytes.unsafe_to_string (MGF.mask ~seed:mdb ms)) mdb) in
354
let i = ct_find_uint8 ~default:0 ~off:hlen ~f:((<>) 0x00) db in
355
let c1 = Eqaf.equal (String.sub db 0 hlen) H.(digest_string label |> to_raw_string)
356
-
and c2 = string_get_uint8 b0 0 = 0x00
357
-
and c3 = string_get_uint8 db i = 0x01 in
358
if c1 && c2 && c3 then Some (String.sub db (i + 1) (String.length db - i - 1)) else None
359
360
let encrypt ?g ?label ~key msg =
···
402
let emsa_pss_verify slen emlen em msg =
403
let mdb = String.sub em 0 (String.length em - hlen - 1)
404
and h = String.sub em (String.length em - hlen - 1) hlen
405
-
and bxx = string_get_uint8 em (String.length em - 1)
406
in
407
let db = MGF.mask ~seed:h mdb in
408
Bytes.set_uint8 db 0 (Bytes.get_uint8 db 0 land b0mask emlen) ;
···
410
let salt = String.sub db (String.length db - slen) slen in
411
let h' = digest ~salt:salt msg
412
and i = ct_find_uint8 ~default:0 ~f:((<>) 0x00) db in
413
-
let c1 = lnot (b0mask emlen) land string_get_uint8 mdb 0 = 0x00
414
and c2 = i = String.length em - hlen - slen - 2
415
-
and c3 = string_get_uint8 db i = 0x01
416
and c4 = bxx = 0xbc
417
and c5 = Eqaf.equal h h' in
418
c1 && c2 && c3 && c4 && c5
···
197
let decrypt ?(crt_hardening=false) ?(mask=`Yes) ~key =
198
reformat (priv_bits key) (decrypt_z ~crt_hardening ~mask ~key)
199
200
let bx00, bx01 = "\x00", "\x01"
201
202
module PKCS1 = struct
···
210
let rec go nonce i j =
211
if i = n then Bytes.unsafe_to_string buf else
212
if j = k then go Mirage_crypto_rng.(generate ?g k) i 0 else
213
+
match String.get_uint8 nonce j with
214
| b when f b -> Bytes.set_uint8 buf i b ; go nonce (succ i) (succ j)
215
| _ -> go nonce i (succ j) in
216
go Mirage_crypto_rng.(generate ?g k) 0 0
···
222
let unpad ~mark ~is_pad buf =
223
let f = not &. is_pad in
224
let i = ct_find_uint8 ~default:2 ~off:2 ~f buf in
225
+
let c1 = String.get_uint8 buf 0 = 0x00
226
+
and c2 = String.get_uint8 buf 1 = mark
227
+
and c3 = String.get_uint8 buf i = 0x00
228
and c4 = min_pad <= i - 2 in
229
if c1 && c2 && c3 && c4 then
230
Some (String.sub buf (i + 1) (String.length buf - i - 1))
···
260
let decrypt ?(crt_hardening = false) ?mask ~key msg =
261
unpadded unpad_02 (decrypt ~crt_hardening ?mask ~key) (priv_bits key) msg
262
263
let asn_of_hash, detect =
264
let map = [
265
`MD5, "\x30\x20\x30\x0c\x06\x08\x2a\x86\x48\x86\xf7\x0d\x02\x05\x05\x00\x04\x10" ;
···
271
]
272
in
273
(fun h -> List.assoc h map),
274
+
(fun buf -> List.find_opt (fun (_, d) -> String.starts_with ~prefix:d buf) map)
275
276
let sign ?(crt_hardening = true) ?mask ~hash ~key msg =
277
let module H = (val Digestif.module_of_hash' (hash :> Digestif.hash')) in
···
344
let db = Bytes.unsafe_to_string (MGF.mask ~seed:(Bytes.unsafe_to_string (MGF.mask ~seed:mdb ms)) mdb) in
345
let i = ct_find_uint8 ~default:0 ~off:hlen ~f:((<>) 0x00) db in
346
let c1 = Eqaf.equal (String.sub db 0 hlen) H.(digest_string label |> to_raw_string)
347
+
and c2 = String.get_uint8 b0 0 = 0x00
348
+
and c3 = String.get_uint8 db i = 0x01 in
349
if c1 && c2 && c3 then Some (String.sub db (i + 1) (String.length db - i - 1)) else None
350
351
let encrypt ?g ?label ~key msg =
···
393
let emsa_pss_verify slen emlen em msg =
394
let mdb = String.sub em 0 (String.length em - hlen - 1)
395
and h = String.sub em (String.length em - hlen - 1) hlen
396
+
and bxx = String.get_uint8 em (String.length em - 1)
397
in
398
let db = MGF.mask ~seed:h mdb in
399
Bytes.set_uint8 db 0 (Bytes.get_uint8 db 0 land b0mask emlen) ;
···
401
let salt = String.sub db (String.length db - slen) slen in
402
let h' = digest ~salt:salt msg
403
and i = ct_find_uint8 ~default:0 ~f:((<>) 0x00) db in
404
+
let c1 = lnot (b0mask emlen) land String.get_uint8 mdb 0 = 0x00
405
and c2 = i = String.length em - hlen - slen - 2
406
+
and c3 = String.get_uint8 db i = 0x01
407
and c4 = bxx = 0xbc
408
and c5 = Eqaf.equal h h' in
409
c1 && c2 && c3 && c4 && c5
+5
-18
pk/z_extra.ml
+5
-18
pk/z_extra.ml
···
2
3
let bit_bound z = Z.size z * 64
4
5
-
(* revise once OCaml 4.13 is the lower bound *)
6
-
let string_get_int64_be buf idx =
7
-
Bytes.get_int64_be (Bytes.unsafe_of_string buf) idx
8
-
9
-
let string_get_int32_be buf idx =
10
-
Bytes.get_int32_be (Bytes.unsafe_of_string buf) idx
11
-
12
-
let string_get_uint16_be buf idx =
13
-
Bytes.get_uint16_be (Bytes.unsafe_of_string buf) idx
14
-
15
-
let string_get_uint8 buf idx =
16
-
Bytes.get_uint8 (Bytes.unsafe_of_string buf) idx
17
-
18
let of_octets_be ?bits buf =
19
let rec loop acc i = function
20
| b when b >= 64 ->
21
-
let x = string_get_int64_be buf i in
22
let x = Z.of_int64_unsigned Int64.(shift_right_logical x 8) in
23
loop Z.(x + acc lsl 56) (i + 7) (b - 56)
24
| b when b >= 32 ->
25
-
let x = string_get_int32_be buf i in
26
let x = Z.of_int32_unsigned Int32.(shift_right_logical x 8) in
27
loop Z.(x + acc lsl 24) (i + 3) (b - 24)
28
| b when b >= 16 ->
29
-
let x = Z.of_int (string_get_uint16_be buf i) in
30
loop Z.(x + acc lsl 16) (i + 2) (b - 16)
31
| b when b >= 8 ->
32
-
let x = Z.of_int (string_get_uint8 buf i) in
33
loop Z.(x + acc lsl 8 ) (i + 1) (b - 8 )
34
| b when b > 0 ->
35
-
let x = string_get_uint8 buf i and b' = 8 - b in
36
Z.(of_int x asr b' + acc lsl b)
37
| _ -> acc in
38
loop Z.zero 0 @@ match bits with
···
2
3
let bit_bound z = Z.size z * 64
4
5
let of_octets_be ?bits buf =
6
let rec loop acc i = function
7
| b when b >= 64 ->
8
+
let x = String.get_int64_be buf i in
9
let x = Z.of_int64_unsigned Int64.(shift_right_logical x 8) in
10
loop Z.(x + acc lsl 56) (i + 7) (b - 56)
11
| b when b >= 32 ->
12
+
let x = String.get_int32_be buf i in
13
let x = Z.of_int32_unsigned Int32.(shift_right_logical x 8) in
14
loop Z.(x + acc lsl 24) (i + 3) (b - 24)
15
| b when b >= 16 ->
16
+
let x = Z.of_int (String.get_uint16_be buf i) in
17
loop Z.(x + acc lsl 16) (i + 2) (b - 16)
18
| b when b >= 8 ->
19
+
let x = Z.of_int (String.get_uint8 buf i) in
20
loop Z.(x + acc lsl 8 ) (i + 1) (b - 8 )
21
| b when b > 0 ->
22
+
let x = String.get_uint8 buf i and b' = 8 - b in
23
Z.(of_int x asr b' + acc lsl b)
24
| _ -> acc in
25
loop Z.zero 0 @@ match bits with
+2
-9
src/cipher_block.ml
+2
-9
src/cipher_block.ml
···
89
module C64be = struct
90
type ctr = int64
91
let size = 8
92
-
(* Until OCaml 4.13 is lower bound*)
93
-
let of_octets cs = Bytes.get_int64_be (Bytes.unsafe_of_string cs) 0
94
let add = Int64.add
95
let unsafe_count_into t buf ~blocks =
96
let tmp = Bytes.create 8 in
···
277
Bytes.set_int64_be cs 8 b;
278
Bytes.unsafe_to_string cs
279
280
-
(* OCaml 4.13 *)
281
-
let string_get_int64 s idx =
282
-
Bytes.get_int64_be (Bytes.unsafe_of_string s) idx
283
-
let string_get_int32 s idx =
284
-
Bytes.get_int32_be (Bytes.unsafe_of_string s) idx
285
-
286
let counter ~hkey nonce = match String.length nonce with
287
| 0 -> invalid_arg "GCM: invalid nonce of length 0"
288
| 12 ->
289
-
let (w1, w2) = string_get_int64 nonce 0, string_get_int32 nonce 8 in
290
(w1, Int64.(shift_left (of_int32 w2) 32 |> add 1L))
291
| _ ->
292
CTR.ctr_of_octets @@
···
89
module C64be = struct
90
type ctr = int64
91
let size = 8
92
+
let of_octets cs = String.get_int64_be cs 0
93
let add = Int64.add
94
let unsafe_count_into t buf ~blocks =
95
let tmp = Bytes.create 8 in
···
276
Bytes.set_int64_be cs 8 b;
277
Bytes.unsafe_to_string cs
278
279
let counter ~hkey nonce = match String.length nonce with
280
| 0 -> invalid_arg "GCM: invalid nonce of length 0"
281
| 12 ->
282
+
let (w1, w2) = String.get_int64_be nonce 0, String.get_int32_be nonce 8 in
283
(w1, Int64.(shift_left (of_int32 w2) 32 |> add 1L))
284
| _ ->
285
CTR.ctr_of_octets @@
+2
-2
src/cipher_stream.ml
+2
-2
src/cipher_stream.ml
···
21
let rec loop j = function
22
| 256 -> ()
23
| i ->
24
-
let x = string_get_uint8 buf (i mod len) in
25
let si = s.(i) in
26
let j = (j + si + x) land 0xff in
27
let sj = s.(j) in
···
43
let sj = s.(j) in
44
s.(i) <- sj ; s.(j) <- si ;
45
let k = s.((si + sj) land 0xff) in
46
-
Bytes.set_uint8 res n (k lxor string_get_uint8 buf n);
47
mix i j (succ n)
48
in
49
let key' = mix i j 0 in
···
21
let rec loop j = function
22
| 256 -> ()
23
| i ->
24
+
let x = String.get_uint8 buf (i mod len) in
25
let si = s.(i) in
26
let j = (j + si + x) land 0xff in
27
let sj = s.(j) in
···
43
let sj = s.(j) in
44
s.(i) <- sj ; s.(j) <- si ;
45
let k = s.((si + sj) land 0xff) in
46
+
Bytes.set_uint8 res n (k lxor String.get_uint8 buf n);
47
mix i j (succ n)
48
in
49
let key' = mix i j 0 in
-4
src/uncommon.ml
-4
src/uncommon.ml
+5
-13
tests/test_ec_wycheproof.ml
+5
-13
tests/test_ec_wycheproof.ml
···
4
5
let ( let* ) = Result.bind
6
7
-
let concat_map f l =
8
-
(* adapt once OCaml 4.10 is lower bound *)
9
-
List.map f l |> List.concat
10
-
11
-
let string_get_uint8 d off =
12
-
(* adapt once OCaml 4.13 is lower bound *)
13
-
Bytes.get_uint8 (Bytes.unsafe_of_string d) off
14
-
15
let hex = Alcotest.testable Wycheproof.pp_hex Wycheproof.equal_hex
16
17
module Asn = struct
···
155
let groups : ecdh_test_group list =
156
List.map ecdh_test_group_exn data.testGroups
157
in
158
-
concat_map (fun (group : ecdh_test_group) ->
159
-
concat_map (to_ecdh_tests group.curve) group.tests)
160
groups
161
162
let make_ecdsa_test curve key hash (tst : dsa_test) =
···
219
let groups : ecdsa_test_group list =
220
List.map ecdsa_test_group_exn data.testGroups
221
in
222
-
concat_map to_ecdsa_tests groups
223
224
let to_x25519_test (x : ecdh_test) =
225
let name = Printf.sprintf "%d - %s" x.tcId x.comment
···
262
let groups : ecdh_test_group list =
263
List.map ecdh_test_group_exn data.testGroups
264
in
265
-
concat_map (fun (group : ecdh_test_group) ->
266
List.map to_x25519_test group.tests)
267
groups
268
···
297
let groups : eddsa_test_group list =
298
List.map eddsa_test_group_exn data.testGroups
299
in
300
-
concat_map (fun (group : eddsa_test_group) ->
301
let keys = to_ed25519_keys group.key in
302
List.map (to_ed25519_test keys) group.tests)
303
groups
···
4
5
let ( let* ) = Result.bind
6
7
let hex = Alcotest.testable Wycheproof.pp_hex Wycheproof.equal_hex
8
9
module Asn = struct
···
147
let groups : ecdh_test_group list =
148
List.map ecdh_test_group_exn data.testGroups
149
in
150
+
List.concat_map (fun (group : ecdh_test_group) ->
151
+
List.concat_map (to_ecdh_tests group.curve) group.tests)
152
groups
153
154
let make_ecdsa_test curve key hash (tst : dsa_test) =
···
211
let groups : ecdsa_test_group list =
212
List.map ecdsa_test_group_exn data.testGroups
213
in
214
+
List.concat_map to_ecdsa_tests groups
215
216
let to_x25519_test (x : ecdh_test) =
217
let name = Printf.sprintf "%d - %s" x.tcId x.comment
···
254
let groups : ecdh_test_group list =
255
List.map ecdh_test_group_exn data.testGroups
256
in
257
+
List.concat_map (fun (group : ecdh_test_group) ->
258
List.map to_x25519_test group.tests)
259
groups
260
···
289
let groups : eddsa_test_group list =
290
List.map eddsa_test_group_exn data.testGroups
291
in
292
+
List.concat_map (fun (group : eddsa_test_group) ->
293
let keys = to_ed25519_keys group.key in
294
List.map (to_ed25519_test keys) group.tests)
295
groups