anil.recoil.org / ocaml-crypto
forked from gazagnaire.org/ocaml-crypto
upstream: https://github.com/mirage/mirage-crypto
fork atom

Merge pull request #242 from hannesm/fix-ccm

fix CCM, as discovered when porting TLS to string

authored by

Hannes Mehnert and committed by
GitHub 74fd16b6 4204d9d2

+161 -9
unified split
+8 -8
src/ccm.ml
··· 79 79 80 80 let small_q = 15 - String.length nonce in 81 81 let ctr_flag_val = flags 0 0 (small_q - 1) in 82 - let ctrblock i block = 83 - Bytes.set_uint8 block 0 ctr_flag_val; 84 - Bytes.unsafe_blit_string nonce 0 block 1 (String.length nonce); 85 - encode_len block ~off:(String.length nonce + 1) small_q i; 86 - cipher ~key (Bytes.unsafe_to_string block) ~src_off:0 block ~dst_off:0 82 + let ctrblock i block dst_off = 83 + Bytes.set_uint8 block dst_off ctr_flag_val; 84 + Bytes.unsafe_blit_string nonce 0 block (dst_off + 1) (String.length nonce); 85 + encode_len block ~off:(dst_off + String.length nonce + 1) small_q i; 86 + cipher ~key (Bytes.unsafe_to_string block) ~src_off:dst_off block ~dst_off 87 87 in 88 88 89 89 let cbc iv src_off block dst_off = ··· 113 113 else if len < block_size then begin 114 114 let buf = Bytes.make block_size '\x00' in 115 115 Bytes.unsafe_blit dst dst_off buf 0 len ; 116 - ctrblock ctr buf ; 116 + ctrblock ctr buf 0 ; 117 117 Bytes.unsafe_blit buf 0 dst dst_off len ; 118 118 unsafe_xor_into src ~src_off dst ~dst_off len ; 119 119 Bytes.unsafe_blit_string cbcblock cbc_off buf 0 len ; 120 120 Bytes.unsafe_fill buf len (block_size - len) '\x00'; 121 - cbc (Bytes.unsafe_to_string buf) cbc_off iv 0 121 + cbc (Bytes.unsafe_to_string buf) 0 iv 0 122 122 end else begin 123 - ctrblock ctr dst ; 123 + ctrblock ctr dst dst_off ; 124 124 unsafe_xor_into src ~src_off dst ~dst_off block_size ; 125 125 cbc cbcblock cbc_off iv 0 ; 126 126 (loop [@tailcall]) (succ ctr) src (src_off + block_size) dst (dst_off + block_size) (len - block_size)
+153 -1
tests/test_cipher.ml
··· 470 470 let cipher = authenticate_encrypt ~adata ~key ~nonce plaintext in 471 471 assert_oct_equal ~msg:"CCM encrypt of >=65280 adata" expected cipher 472 472 in 473 + let regr_tls = 474 + let key = of_secret (vx "063a 96fd 15f9 82d5 5aad 5bf9 d098 7546") in 475 + (* discovered while moving ocaml-tls to string *) 476 + let nonce = vx "81cd 4758 1880 9de0 c655 7c31" 477 + and adata = vx "1703 0300 17" 478 + and data = vx "0800 0002 0000 16" 479 + and expected = vx "94ca 065a c948 c5d6 92fd 5fab c850 0611 a07c 4f6e 0710 90" 480 + in 481 + let a _ = 482 + let cipher = authenticate_encrypt ~adata ~key ~nonce data in 483 + assert_oct_equal ~msg:"TLS regression 0" expected cipher 484 + and b _ = 485 + match authenticate_decrypt ~key ~nonce ~adata expected with 486 + | None -> assert_failure "TLS regression 0, decrypt broken" 487 + | Some x -> assert_oct_equal ~msg:"TLS regression 0 decrypt" x data 488 + in 489 + let nonce = vx "81cd 4758 1880 9de0 c655 7c30" 490 + and adata = vx "1703 0302 85" 491 + and data = vx {| 492 + 0b00 0270 0000 026c 0002 6730 8202 6330 493 + 8201 cc02 0900 cb6c 4e84 4b58 a1d4 300d 494 + |} 495 + and expected = vx {| 496 + 1e59 904e e6d5 c2ac e538 78d7 e24f 6e46 497 + 6169 f8e2 d3dd 8b5d 788c 78ff ea9f e1d0 498 + 9885 ac1a c6d9 fb88 b66a 3a11 5ba5 6e7c 499 + |} 500 + in 501 + let c _ = 502 + let cipher = authenticate_encrypt ~adata ~key ~nonce data in 503 + assert_oct_equal ~msg:"TLS regression 1" expected cipher 504 + and d _ = 505 + match authenticate_decrypt ~key ~nonce ~adata expected with 506 + | None -> assert_failure "TLS regression 1, decrypt broken" 507 + | Some x -> assert_oct_equal ~msg:"TLS regression 1 decrypt" x data 508 + in 509 + let data = vx {| 510 + 0b00 0270 0000 026c 0002 6730 8202 6330 511 + 8201 cc02 0900 cb6c 4e84 4b58 a1d4 300d 512 + 8201 cc02 0900 513 + |} 514 + and expected = vx {| 515 + 1e59 904e e6d5 c2ac e538 78d7 e24f 6e46 516 + 6169 f8e2 d3dd 8b5d 788c 78ff ea9f e1d0 517 + 7c8d 9993 6bfd cf76 9799 473b 58f4 ed69 518 + d7a4 df7a 2d6b 519 + |} 520 + in 521 + let e _ = 522 + let cipher = authenticate_encrypt ~adata ~key ~nonce data in 523 + assert_oct_equal ~msg:"TLS regression 2" expected cipher 524 + and f _ = 525 + match authenticate_decrypt ~key ~nonce ~adata expected with 526 + | None -> assert_failure "TLS regression 2, decrypt broken" 527 + | Some x -> assert_oct_equal ~msg:"TLS regression 2 decrypt" x data 528 + in 529 + let data = vx {| 530 + 0b00 0270 0000 026c 0002 6730 8202 6330 531 + 8201 cc02 0900 cb6c 4e84 4b58 a1d4 300d 532 + 0609 2a86 4886 f70d 0101 0505 0030 7631 533 + 0b30 0906 0355 0406 1302 4155 3113 3011 534 + 0603 5504 080c 0a53 6f6d 652d 5374 6174 535 + 6531 2130 1f06 0355 040a 0c18 496e 7465 536 + 726e 6574 2057 6964 6769 7473 2050 7479 537 + 204c 7464 3115 3013 0603 5504 030c 0c59 538 + 4f55 5220 4e41 4d45 2121 2131 1830 1606 539 + 092a 8648 86f7 0d01 0901 1609 6d65 4062 540 + 6172 2e64 6530 1e17 0d31 3430 3231 3732 541 + 3230 3834 355a 170d 3135 3032 3137 3232 542 + 3038 3435 5a30 7631 0b30 0906 0355 0406 543 + 1302 4155 3113 3011 0603 5504 080c 0a53 544 + 6f6d 652d 5374 6174 6531 2130 1f06 0355 545 + 040a 0c18 496e 7465 726e 6574 2057 6964 546 + 6769 7473 2050 7479 204c 7464 3115 3013 547 + 0603 5504 030c 0c59 4f55 5220 4e41 4d45 548 + 2121 2131 1830 1606 092a 8648 86f7 0d01 549 + 0901 1609 6d65 4062 6172 2e64 6530 819f 550 + 300d 0609 2a86 4886 f70d 0101 0105 0003 551 + 818d 0030 8189 0281 8100 b640 48de e6bc 552 + 2194 3da2 ab5e b6f8 d837 007f 417c 0fe3 553 + 3492 c3aa 2f55 3e4d 5e31 4346 89c2 6f2b 554 + e68e 00d2 88b0 e3ab f6fe 1188 45d9 4989 555 + 8512 f192 cbe4 9fd5 b083 1f01 cb2d 274d 556 + b3a6 38f5 befb 3ce8 1ab6 b559 3934 4404 557 + 4fed d6ca 154f 76bf bd52 5608 bb55 0a39 558 + bbd2 ed12 e6d7 1f9f 84ba 21aa 5e21 8015 559 + 0267 1aab 049a f864 0da1 0203 0100 0130 560 + 0d06 092a 8648 86f7 0d01 0105 0500 0381 561 + 8100 8a38 669a 4896 9dc9 4729 6d44 2d7f 562 + 0320 82d2 db21 e537 4cdd 6ef6 e7cc 1da0 563 + fde5 11ed 3c52 52f0 a673 dc68 9fdc 5fca 564 + cc1b 85df e22b 7bef 2adb 56b5 3732 e981 565 + 1063 794d 6e23 9f8f a267 215b a7a4 d3dc 566 + e505 e799 ec5c 38cd 1c16 ee75 e0d5 a46b 567 + 8f4c 8e82 6505 6153 9a84 305d f19a 5a24 568 + 1be5 55f8 7083 4e09 4d41 cf9f 74b3 342e 569 + 8345 0000 16 570 + |} 571 + and expected = vx {| 572 + 1e59 904e e6d5 c2ac e538 78d7 e24f 6e46 573 + 6169 f8e2 d3dd 8b5d 788c 78ff ea9f e1d0 574 + f885 7f17 2a7b f163 d29e 0a8e 8636 418f 575 + a9da 651b f2ba 36aa a1a4 14d0 6a9a f991 576 + 0836 eb93 80b9 bbe2 1f20 98d9 be0b c16f 577 + d58c c98d 4082 dadd f575 57a4 43f7 af31 578 + c1b7 1eeb 2590 a887 e31c 590a 7e56 798c 579 + 69aa 4576 fde6 63d2 1b62 d00d 98f6 4015 580 + dae7 8454 b96a f7f9 774f f539 24bf efe6 581 + 4629 ee35 4c81 32d4 43df ffa9 17a2 6306 582 + fd07 f9ab b462 2bcd bb0a 3750 af1a 3525 583 + 66ad 6c67 b647 2ca7 d6b5 b13e ea34 d90d 584 + 5731 a599 e608 d037 bc77 40aa b305 84ad 585 + 8d78 43fc 7f55 70a2 fbbb 1b30 a14a 2f5f 586 + b3c3 2584 1f9e 7f3f 3dfa 19e2 9539 a1be 587 + ead8 e051 d847 915b ed23 87ab 7082 7df4 588 + 71a0 e0a6 46db a780 1e7b fb98 dac4 0af1 589 + c3eb 42d4 3a6c 3c71 f55a b377 e4de ff20 590 + 14d7 b47c 8743 f291 56f3 6d8c 45d1 7cb3 591 + 0321 e2cf 8ffd babf a129 ea0d cc1b 7a0d 592 + b1ec 448d 0e3b 4386 9cc2 2b5a 5569 2930 593 + ea33 080e 9168 3696 b224 6238 34fc 3e25 594 + 7895 6af3 cd60 f3c8 6643 3d6f 5736 4e78 595 + 6aca 8b2d 1575 2d34 4533 79bd e27e 9c46 596 + f9f4 be4a 2fe3 f377 3acf 7b6e e4f0 3eb0 597 + ec85 95a6 ed04 2316 fe4e 2a54 25aa c40a 598 + c464 4128 0e35 1003 9f5d abfa e8e9 dc73 599 + f709 f29b f930 0bdc d941 981b c5b3 8295 600 + 97a5 c7e9 481d ce99 c6b6 5dfb 672d 3fdb 601 + 38bb a6be d7f8 9863 345d c3a8 77f3 6b77 602 + f309 5c3b b9df fa40 8d42 ff79 6724 23da 603 + 8f24 c9b0 e02d 4794 581f e185 32e6 94bb 604 + 5b6a 6d5c 3b80 4c83 a0d8 0b42 d575 4fc3 605 + 4353 a78d fdb5 003c 4f0b 437d 75fb 5886 606 + a76a 35f5 892d a10b ce33 3ce6 ffd9 f09c 607 + 7264 5b09 c50a 7013 344c 11a1 ab92 5728 608 + 43e1 bc8c 8c1b 3fad 4a02 25a9 cb96 5fd2 609 + 1962 4b0c b46b 9f8f 1225 b18c 2572 6297 610 + c890 238f 22d6 2bb0 7678 568a 3c9b 75e5 611 + b8fc 10f3 13c7 aa16 8165 a29c 67f1 46f4 612 + 6e44 8e84 f5 613 + |} 614 + in 615 + let g _ = 616 + let cipher = authenticate_encrypt ~adata ~key ~nonce data in 617 + assert_oct_equal ~msg:"TLS regression 3" expected cipher 618 + and h _ = 619 + match authenticate_decrypt ~key ~nonce ~adata expected with 620 + | None -> assert_failure "TLS regression 3, decrypt broken" 621 + | Some x -> assert_oct_equal ~msg:"TLS regression 3 decrypt" x data 622 + in 623 + [ a ; b ; c ; d ; e ; f ; g ; h ] 624 + in 473 625 [ 474 626 test_case no_vs_empty_ad ; 475 627 test_case short_nonce_enc ; ··· 478 630 test_case long_nonce_enc ; 479 631 test_case enc_dec_empty_message ; 480 632 test_case long_adata ; 481 - ] 633 + ] @ List.map test_case regr_tls 482 634 483 635 let gcm_regressions = 484 636 let open AES.GCM in