+93 -70

ec/mirage_crypto_ec.ml

reviewed

··· 15 15 let pp_error fmt e = 16 16 Format.fprintf fmt "Cannot parse point: %s" (error_to_string e) 17 17 18 18 + exception Message_too_long 19 19 + 18 20 module type Dh = sig 19 21 type secret 20 22 ··· 64 66 val n : Cstruct.t 65 67 val byte_length : int 66 68 val fe_length : int 69 69 + val first_byte_bits : int option 67 70 end 68 71 69 72 type field_element = Cstruct.buffer ··· 166 169 167 170 val to_cstruct : point -> Cstruct.t 168 171 172 172 + val to_affine_raw : point -> (field_element * field_element) option 173 173 + 169 174 val x_of_finite_point : point -> Cstruct.t 170 175 171 176 val params_g : point ··· 236 241 | 0x00 | 0x04 -> Error `Invalid_length 237 242 | _ -> Error `Invalid_format 238 243 239 239 - let to_affine p = 240 240 - if is_infinity p then None 244 244 + let to_affine_raw p = 245 245 + if is_infinity p then 246 246 + None 241 247 else 242 242 - let out_x = Cstruct.create P.byte_length in 243 243 - let out_y = Cstruct.create P.byte_length in 244 248 let z1 = Fe.create () in 245 249 let z2 = Fe.create () in 246 250 Fe.copy z1 p.f_z; ··· 251 255 let x = Fe.create () in 252 256 Fe.copy x p.f_x; 253 257 Fe.mul x x z1; 254 254 - Fe.to_bytes out_x x; 255 258 let y = Fe.create () in 256 259 Fe.copy y p.f_y; 257 260 Fe.mul z1 z1 z2; 258 261 Fe.mul y y z1; 262 262 + Some (x, y) 263 263 + 264 264 + let to_affine p = 265 265 + match to_affine_raw p with 266 266 + | None -> None 267 267 + | Some (x, y) -> 268 268 + let out_x = Cstruct.create P.byte_length in 269 269 + let out_y = Cstruct.create P.byte_length in 270 270 + Fe.to_bytes out_x x; 259 271 Fe.to_bytes out_y y; 260 272 Some (out_x, out_y) 261 273 ··· 295 307 end 296 308 297 309 module type Scalar = sig 310 310 + val not_zero : Cstruct.t -> bool 311 311 + 312 312 + val is_in_range : Cstruct.t -> bool 313 313 + 298 314 val of_cstruct : Cstruct.t -> (scalar, error) result 299 315 300 316 val to_cstruct : scalar -> Cstruct.t ··· 303 319 end 304 320 305 321 module Make_scalar (Param : Parameters) (P : Point) : Scalar = struct 322 322 + let not_zero = 323 323 + let zero = Cstruct.create Param.byte_length in 324 324 + fun cs -> Eqaf_cstruct.compare_be_with_len ~len:Param.byte_length cs zero > 0 325 325 + 306 326 let is_in_range cs = 307 307 - let zero = Cstruct.create Param.byte_length in 308 308 - Eqaf_cstruct.compare_be_with_len ~len:Param.byte_length cs zero > 0 327 327 + not_zero cs 309 328 && Eqaf_cstruct.compare_be_with_len ~len:Param.byte_length Param.n cs > 0 310 329 311 330 let of_cstruct cs = ··· 392 411 let padded msg = 393 412 let l = Cstruct.len msg in 394 413 let bl = Param.byte_length in 395 395 - if l >= bl then 396 396 - Cstruct.sub msg 0 (min l bl) 414 414 + let first_byte_ok () = 415 415 + match Param.first_byte_bits with 416 416 + | None -> true 417 417 + | Some m -> (Cstruct.get_uint8 msg 0) land (0xFF land (lnot m)) = 0 418 418 + in 419 419 + if l > bl || (l = bl && not (first_byte_ok ())) then 420 420 + raise Message_too_long 421 421 + else if l = bl then 422 422 + msg 397 423 else 398 424 Cstruct.append (Cstruct.create (bl - l)) msg 399 425 ··· 407 433 F.to_bytes (Cstruct.to_bigarray cs) v; 408 434 Cstruct.rev cs 409 435 410 410 - let not_zero = 411 411 - let zero = Cstruct.create Param.byte_length in 412 412 - fun n -> not (Cstruct.equal zero n) 413 413 - 414 414 - let mod_n v = 415 415 - let v' = from_be_cstruct v in 416 416 - F.to_montgomery v' v'; 417 417 - let o = create () in 418 418 - F.one o; 419 419 - F.mul v' v' o; 420 420 - F.from_montgomery v' v'; 421 421 - to_be_cstruct v' 422 422 - 423 423 - let smaller_n v = 424 424 - Cstruct.equal v (mod_n v) 425 425 - 426 436 (* RFC 6979: compute a deterministic k *) 427 437 module K_gen (H : Mirage_crypto.Hash.S) = struct 428 438 ··· 439 449 let gen g = 440 450 let rec go () = 441 451 let r = Mirage_crypto_rng.generate ~g Param.byte_length in 442 442 - if not_zero r && smaller_n r then r else go () 452 452 + if S.is_in_range r then r else go () 443 453 in 444 454 go () 445 455 ··· 466 476 let q = S.scalar_mult d P.params_g in 467 477 (d, q) 468 478 479 479 + let x_of_finite_point_mod_n p = 480 480 + match P.to_affine_raw p with 481 481 + | None -> None 482 482 + | Some (x, _) -> 483 483 + F.to_montgomery x x; 484 484 + let o = create () in 485 485 + F.one o; 486 486 + F.mul x x o; 487 487 + F.from_montgomery x x; 488 488 + Some (to_be_cstruct x) 489 489 + 469 490 let sign ~key ?k msg = 470 470 - (* blinding: literature: s = k^-1 * (m + r * priv_key) mod n 471 471 - we blind, similar to OpenSSL (https://github.com/openssl/openssl/commit/a3e9d5aa980f238805970f420adf5e903d35bf09): 472 472 - s = k^-1 * blind^-1 (blind * m + blind * r * priv_key) mod n 473 473 - *) 474 491 let msg = padded msg in 475 492 let e = from_be_cstruct msg in 476 493 let g = K_gen_default.g ~key msg in ··· 486 503 | Error _ -> invalid_arg "k not in range" (* if no k is provided, this cannot happen since K_gen_*.gen already preserves the Scalar invariants *) 487 504 in 488 505 let point = S.scalar_mult ksc P.params_g in 489 489 - if P.is_infinity point then 490 490 - again () 491 491 - else 492 492 - let x1 = P.x_of_finite_point point in 493 493 - let r = mod_n x1 in 506 506 + match x_of_finite_point_mod_n point with 507 507 + | None -> again () 508 508 + | Some r -> 494 509 let r_mon = from_be_cstruct r in 495 510 F.to_montgomery r_mon r_mon; 496 511 let kinv = create () in ··· 511 526 let s = create () in 512 527 F.from_montgomery s smon; 513 528 let s = to_be_cstruct s in 514 514 - if not_zero s && not_zero r then 529 529 + if S.not_zero s && S.not_zero r then 515 530 r, s 516 531 else 517 532 again () ··· 521 536 let pub_of_priv priv = S.scalar_mult priv P.params_g 522 537 523 538 let verify ~key (r, s) msg = 524 524 - if not (smaller_n r && not_zero r && smaller_n s && not_zero s) then 539 539 + if not (S.is_in_range r && S.is_in_range s) then 525 540 false 526 541 else 527 527 - (* take the Ln leftmost bits (with Ln bitsize of group order n = 256) *) 528 528 - let msg = padded msg in 529 529 - let z = from_be_cstruct msg in 530 530 - let s_inv = create () in 531 531 - let s_mon = from_be_cstruct s in 532 532 - F.to_montgomery s_mon s_mon; 533 533 - F.inv s_inv s_mon; 534 534 - let u1 = create () in 535 535 - let s_inv_mon = create () in 536 536 - F.to_montgomery s_inv_mon s_inv; 537 537 - let z_mon = create () in 538 538 - F.to_montgomery z_mon z; 539 539 - F.mul u1 z_mon s_inv_mon; 540 540 - let u2 = create () in 541 541 - let r_mon = from_be_cstruct r in 542 542 - F.to_montgomery r_mon r_mon; 543 543 - F.mul u2 r_mon s_inv_mon; 544 544 - let u1_out = create () in 545 545 - F.from_montgomery u1_out u1; 546 546 - let u2_out = create () in 547 547 - F.from_montgomery u2_out u2; 548 548 - match 549 549 - S.of_cstruct (to_be_cstruct u1_out), 550 550 - S.of_cstruct (to_be_cstruct u2_out) 542 542 + try 543 543 + let msg = padded msg in 544 544 + let z = from_be_cstruct msg in 545 545 + let s_inv = create () in 546 546 + let s_mon = from_be_cstruct s in 547 547 + F.to_montgomery s_mon s_mon; 548 548 + F.inv s_inv s_mon; 549 549 + let u1 = create () in 550 550 + let s_inv_mon = create () in 551 551 + F.to_montgomery s_inv_mon s_inv; 552 552 + let z_mon = create () in 553 553 + F.to_montgomery z_mon z; 554 554 + F.mul u1 z_mon s_inv_mon; 555 555 + let u2 = create () in 556 556 + let r_mon = from_be_cstruct r in 557 557 + F.to_montgomery r_mon r_mon; 558 558 + F.mul u2 r_mon s_inv_mon; 559 559 + let u1_out = create () in 560 560 + F.from_montgomery u1_out u1; 561 561 + let u2_out = create () in 562 562 + F.from_montgomery u2_out u2; 563 563 + match 564 564 + S.of_cstruct (to_be_cstruct u1_out), 565 565 + S.of_cstruct (to_be_cstruct u2_out) 566 566 + with 567 567 + | Ok u1, Ok u2 -> 568 568 + let point = 569 569 + P.add 570 570 + (S.scalar_mult u1 P.params_g) 571 571 + (S.scalar_mult u2 key) 572 572 + in 573 573 + begin match x_of_finite_point_mod_n point with 574 574 + | None -> false (* point is infinity *) 575 575 + | Some r' -> Cstruct.equal r r' 576 576 + end 577 577 + | Error _, _ | _, Error _ -> false 551 578 with 552 552 - | Ok u1, Ok u2 -> 553 553 - let point = 554 554 - P.add 555 555 - (S.scalar_mult u1 P.params_g) 556 556 - (S.scalar_mult u2 key) 557 557 - in 558 558 - not (P.is_infinity point) && 559 559 - Cstruct.equal (mod_n (P.x_of_finite_point point)) r 560 560 - | _ -> false 579 579 + | Message_too_long -> false 561 580 end 562 581 563 582 module P224 : Dh_dsa = struct ··· 570 589 let n = Cstruct.of_hex "FFFFFFFFFFFFFFFFFFFFFFFFFFFF16A2E0B8F03E13DD29455C5C2A3D" 571 590 let byte_length = 28 572 591 let fe_length = if Sys.word_size == 64 then 32 else 28 (* TODO: is this congruent with C code? *) 592 592 + let first_byte_bits = None 573 593 end 574 594 575 595 module Foreign = struct ··· 619 639 let n = Cstruct.of_hex "FFFFFFFF00000000FFFFFFFFFFFFFFFFBCE6FAADA7179E84F3B9CAC2FC632551" 620 640 let byte_length = 32 621 641 let fe_length = 32 642 642 + let first_byte_bits = None 622 643 end 623 644 624 645 module Foreign = struct ··· 668 689 let n = Cstruct.of_hex "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFC7634D81F4372DDF581A0DB248B0A77AECEC196ACCC52973" 669 690 let byte_length = 48 670 691 let fe_length = 48 692 692 + let first_byte_bits = None 671 693 end 672 694 673 695 module Foreign = struct ··· 717 739 let n = Cstruct.of_hex "01FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFA51868783BF2F966B7FCC0148F709A5D03BB5C9B8899C47AEBB6FB71E91386409" 718 740 let byte_length = 66 719 741 let fe_length = if Sys.word_size == 64 then 72 else 68 (* TODO: is this congruent with C code? *) 742 742 + let first_byte_bits = Some 0x01 720 743 end 721 744 722 745 module Foreign = struct

+10 -4

ec/mirage_crypto_ec.mli

reviewed

··· 20 20 val pp_error : Format.formatter -> error -> unit 21 21 (** Pretty printer for errors *) 22 22 23 23 + exception Message_too_long 24 24 + (** Raised if the provided message is too long for the curve. *) 25 25 + 23 26 (** Diffie-Hellman key exchange. *) 24 27 module type Dh = sig 25 28 ··· 102 105 103 106 val sign : key:priv -> ?k:Cstruct.t -> Cstruct.t -> Cstruct.t * Cstruct.t 104 107 (** [sign ~key ~k digest] signs the message [digest] using the private 105 105 - [key]. Only the leftmost bits within the curve order are considered. 106 106 - If [k] is not provided, it is computed using the deterministic 107 107 - construction from RFC 6979. The result is a pair of [r] and [s]. *) 108 108 + [key]. If [k] is not provided, it is computed using the deterministic 109 109 + construction from RFC 6979. The result is a pair of [r] and [s]. 110 110 + 111 111 + @raise Invalid_argument if [k] is not suitable or not in range. 112 112 + @raise Message_too_long if [msg] is too long for the curve. *) 108 113 109 114 val verify : key:pub -> Cstruct.t * Cstruct.t -> Cstruct.t -> bool 110 115 (** [verify ~key (r, s) digest] verifies the signature [r, s] on the message 111 116 [digest] with the public [key]. The return value is [true] if verification 112 112 - was successful, [false] otherwise. *) 117 117 + was successful, [false] otherwise. If the message has more bits than the 118 118 + group order, the result is false. *) 113 119 114 120 (** [K_gen] can be instantiated over a hashing module to obtain an RFC6979 115 121 compliant [k]-generator for that hash. *)

+9 -3

tests/test_ec.ml

reviewed

··· 289 289 | Error _ -> Alcotest.fail "bad public key" 290 290 in 291 291 let case hash ~message ~k ~r ~s () = 292 292 - let msg = Mirage_crypto.Hash.digest hash (Cstruct.of_string message) 292 292 + let msg = 293 293 + let h = Mirage_crypto.Hash.digest hash (Cstruct.of_string message) in 294 294 + Cstruct.sub h 0 (min (Cstruct.len h) 28) 293 295 and k = Cstruct.of_hex k 294 296 in 295 297 let k' = ··· 383 385 | Error _ -> Alcotest.fail "bad public key" 384 386 in 385 387 let case hash ~message ~k ~r ~s () = 386 386 - let msg = Mirage_crypto.Hash.digest hash (Cstruct.of_string message) 388 388 + let msg = 389 389 + let h = Mirage_crypto.Hash.digest hash (Cstruct.of_string message) in 390 390 + Cstruct.sub h 0 (min (Cstruct.len h) 32) 387 391 and k = Cstruct.of_hex k 388 392 in 389 393 let k' = ··· 466 470 | Error _ -> Alcotest.fail "bad public key" 467 471 in 468 472 let case hash ~message ~k ~r ~s () = 469 469 - let msg = Mirage_crypto.Hash.digest hash (Cstruct.of_string message) 473 473 + let msg = 474 474 + let h = Mirage_crypto.Hash.digest hash (Cstruct.of_string message) in 475 475 + Cstruct.sub h 0 (min (Cstruct.len h) 48) 470 476 and k = Cstruct.of_hex k 471 477 in 472 478 let k' =

+4 -1

tests/test_ec_wycheproof.ml

reviewed

··· 158 158 159 159 let make_ecdsa_test curve key hash (tst : ecdsa_test) = 160 160 let name = Printf.sprintf "%d - %s" tst.tcId tst.comment in 161 161 - let msg = Mirage_crypto.Hash.digest hash (Cstruct.of_string tst.msg) in 162 161 let size = len curve in 162 162 + let msg = 163 163 + let h = Mirage_crypto.Hash.digest hash (Cstruct.of_string tst.msg) in 164 164 + Cstruct.sub h 0 (min size (Cstruct.len h)) 165 165 + in 163 166 let verified (r,s) = 164 167 match curve with 165 168 | "secp224r1" ->