provide ciphers with {de,en}crypt_into functionality (#231) · anil.recoil.org/ocaml-crypto@ba299d8

+99 -17

bench/speed.ml

··· 45 45 Printf.printf " % 5d: %04f MB/s (%d iters in %.03f s)\n%!" 46 46 size (bw /. mb) iters time 47 47 48 + let throughput_into ?(add = 0) title f = 49 + Printf.printf "\n* [%s]\n%!" title ; 50 + sizes |> List.iter @@ fun size -> 51 + Gc.full_major () ; 52 + let dst = Bytes.create (size + add) in 53 + let (iters, time, bw) = burn (f dst) size in 54 + Printf.printf " % 5d: %04f MB/s (%d iters in %.03f s)\n%!" 55 + size (bw /. mb) iters time 56 + 48 57 let count_period = 10. 49 58 50 59 let count f n = ··· 347 356 fst ecdh_shares); 348 357 349 358 bm "chacha20-poly1305" (fun name -> 350 - let key = Mirage_crypto.Chacha20.of_secret (Mirage_crypto_rng.generate 32) 359 + let key = Chacha20.of_secret (Mirage_crypto_rng.generate 32) 351 360 and nonce = Mirage_crypto_rng.generate 8 in 352 - throughput name (Mirage_crypto.Chacha20.authenticate_encrypt ~key ~nonce)) ; 361 + throughput_into ~add:Chacha20.tag_size name 362 + (fun dst cs -> Chacha20.authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))) ; 363 + 364 + bm "chacha20-poly1305-unsafe" (fun name -> 365 + let key = Chacha20.of_secret (Mirage_crypto_rng.generate 32) 366 + and nonce = Mirage_crypto_rng.generate 8 in 367 + throughput_into ~add:Chacha20.tag_size name 368 + (fun dst cs -> Chacha20.unsafe_authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))) ; 353 369 354 370 bm "aes-128-ecb" (fun name -> 355 371 let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 16) in 356 - throughput name (fun cs -> AES.ECB.encrypt ~key cs)) ; 372 + throughput_into name 373 + (fun dst cs -> AES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 374 + 375 + bm "aes-192-ecb" (fun name -> 376 + let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 24) in 377 + throughput_into name (fun dst cs -> AES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 378 + 379 + bm "aes-192-ecb-unsafe" (fun name -> 380 + let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 24) in 381 + throughput_into name (fun dst cs -> AES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 382 + 383 + bm "aes-256-ecb" (fun name -> 384 + let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 32) in 385 + throughput_into name (fun dst cs -> AES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 386 + 387 + bm "aes-256-ecb-unsafe" (fun name -> 388 + let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 32) in 389 + throughput_into name (fun dst cs -> AES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 390 + 391 + bm "aes-128-ecb-unsafe" (fun name -> 392 + let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 16) in 393 + throughput_into name 394 + (fun dst cs -> AES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 357 395 358 396 bm "aes-128-cbc-e" (fun name -> 359 397 let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16) 360 398 and iv = Mirage_crypto_rng.generate 16 in 361 - throughput name (fun cs -> AES.CBC.encrypt ~key ~iv cs)) ; 399 + throughput_into name 400 + (fun dst cs -> AES.CBC.encrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 401 + 402 + bm "aes-128-cbc-e-unsafe" (fun name -> 403 + let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16) 404 + and iv = Mirage_crypto_rng.generate 16 in 405 + throughput_into name 406 + (fun dst cs -> AES.CBC.unsafe_encrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 407 + 408 + bm "aes-128-cbc-e-unsafe-inplace" (fun name -> 409 + let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16) 410 + and iv = Mirage_crypto_rng.generate 16 in 411 + throughput name 412 + (fun cs -> 413 + let b = Bytes.unsafe_of_string cs in 414 + AES.CBC.unsafe_encrypt_into_inplace ~key ~iv b ~dst_off:0 (String.length cs))) ; 362 415 363 416 bm "aes-128-cbc-d" (fun name -> 364 417 let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16) 365 418 and iv = Mirage_crypto_rng.generate 16 in 366 - throughput name (fun cs -> AES.CBC.decrypt ~key ~iv cs)) ; 419 + throughput_into name 420 + (fun dst cs -> AES.CBC.decrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 421 + 422 + bm "aes-128-cbc-d-unsafe" (fun name -> 423 + let key = AES.CBC.of_secret (Mirage_crypto_rng.generate 16) 424 + and iv = Mirage_crypto_rng.generate 16 in 425 + throughput_into name 426 + (fun dst cs -> AES.CBC.unsafe_decrypt_into ~key ~iv cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 367 427 368 428 bm "aes-128-ctr" (fun name -> 369 429 let key = Mirage_crypto_rng.generate 16 |> AES.CTR.of_secret 370 430 and ctr = Mirage_crypto_rng.generate 16 |> AES.CTR.ctr_of_octets in 371 - throughput name (fun cs -> AES.CTR.encrypt ~key ~ctr cs)) ; 431 + throughput_into name (fun dst cs -> AES.CTR.encrypt_into ~key ~ctr cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 432 + 433 + bm "aes-128-ctr-unsafe" (fun name -> 434 + let key = Mirage_crypto_rng.generate 16 |> AES.CTR.of_secret 435 + and ctr = Mirage_crypto_rng.generate 16 |> AES.CTR.ctr_of_octets in 436 + throughput_into name (fun dst cs -> AES.CTR.unsafe_encrypt_into ~key ~ctr cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 372 437 373 438 bm "aes-128-gcm" (fun name -> 374 439 let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16) 375 440 and nonce = Mirage_crypto_rng.generate 12 in 376 - throughput name (fun cs -> AES.GCM.authenticate_encrypt ~key ~nonce cs)); 441 + throughput_into ~add:AES.GCM.tag_size name 442 + (fun dst cs -> AES.GCM.authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))); 443 + 444 + bm "aes-128-gcm-unsafe" (fun name -> 445 + let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16) 446 + and nonce = Mirage_crypto_rng.generate 12 in 447 + throughput_into ~add:AES.GCM.tag_size name 448 + (fun dst cs -> AES.GCM.unsafe_authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))); 377 449 378 450 bm "aes-128-ghash" (fun name -> 379 451 let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16) 380 452 and nonce = Mirage_crypto_rng.generate 12 in 381 - throughput name (fun cs -> AES.GCM.authenticate_encrypt ~key ~nonce ~adata:cs "")); 453 + throughput_into ~add:AES.GCM.tag_size name 454 + (fun dst cs -> AES.GCM.authenticate_encrypt_into ~key ~nonce ~adata:cs "" ~src_off:0 dst ~dst_off:0 ~tag_off:0 0)); 455 + 456 + bm "aes-128-ghash-unsafe" (fun name -> 457 + let key = AES.GCM.of_secret (Mirage_crypto_rng.generate 16) 458 + and nonce = Mirage_crypto_rng.generate 12 in 459 + throughput_into ~add:AES.GCM.tag_size name 460 + (fun dst cs -> AES.GCM.unsafe_authenticate_encrypt_into ~key ~nonce ~adata:cs "" ~src_off:0 dst ~dst_off:0 ~tag_off:0 0)); 382 461 383 462 bm "aes-128-ccm" (fun name -> 384 463 let key = AES.CCM16.of_secret (Mirage_crypto_rng.generate 16) 385 464 and nonce = Mirage_crypto_rng.generate 10 in 386 - throughput name (fun cs -> AES.CCM16.authenticate_encrypt ~key ~nonce cs)); 465 + throughput_into ~add:AES.CCM16.tag_size name 466 + (fun dst cs -> AES.CCM16.authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))); 387 467 388 - bm "aes-192-ecb" (fun name -> 389 - let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 24) in 390 - throughput name (fun cs -> AES.ECB.encrypt ~key cs)) ; 391 - 392 - bm "aes-256-ecb" (fun name -> 393 - let key = AES.ECB.of_secret (Mirage_crypto_rng.generate 32) in 394 - throughput name (fun cs -> AES.ECB.encrypt ~key cs)) ; 468 + bm "aes-128-ccm-unsafe" (fun name -> 469 + let key = AES.CCM16.of_secret (Mirage_crypto_rng.generate 16) 470 + and nonce = Mirage_crypto_rng.generate 10 in 471 + throughput_into ~add:AES.CCM16.tag_size name 472 + (fun dst cs -> AES.CCM16.unsafe_authenticate_encrypt_into ~key ~nonce cs ~src_off:0 dst ~dst_off:0 ~tag_off:(String.length cs) (String.length cs))); 395 473 396 474 bm "d3des-ecb" (fun name -> 397 475 let key = DES.ECB.of_secret (Mirage_crypto_rng.generate 24) in 398 - throughput name (fun cs -> DES.ECB.encrypt ~key cs)) ; 476 + throughput_into name (fun dst cs -> DES.ECB.encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 477 + 478 + bm "d3des-ecb-unsafe" (fun name -> 479 + let key = DES.ECB.of_secret (Mirage_crypto_rng.generate 24) in 480 + throughput_into name (fun dst cs -> DES.ECB.unsafe_encrypt_into ~key cs ~src_off:0 dst ~dst_off:0 (String.length cs))) ; 399 481 400 482 bm "fortuna" (fun name -> 401 483 let open Mirage_crypto_rng.Fortuna in

+12

src/aead.ml

··· 10 10 string -> string * string 11 11 val authenticate_decrypt_tag : key:key -> nonce:string -> ?adata:string -> 12 12 tag:string -> string -> string option 13 + val authenticate_encrypt_into : key:key -> nonce:string -> 14 + ?adata:string -> string -> src_off:int -> bytes -> dst_off:int -> 15 + tag_off:int -> int -> unit 16 + val authenticate_decrypt_into : key:key -> nonce:string -> 17 + ?adata:string -> string -> src_off:int -> tag_off:int -> bytes -> 18 + dst_off:int -> int -> bool 19 + val unsafe_authenticate_encrypt_into : key:key -> nonce:string -> 20 + ?adata:string -> string -> src_off:int -> bytes -> dst_off:int -> 21 + tag_off:int -> int -> unit 22 + val unsafe_authenticate_decrypt_into : key:key -> nonce:string -> 23 + ?adata:string -> string -> src_off:int -> tag_off:int -> bytes -> 24 + dst_off:int -> int -> bool 13 25 end

+33 -38

src/ccm.ml

··· 10 10 | 0 -> Bytes.set_uint8 buf off num 11 11 | m -> 12 12 Bytes.set_uint8 buf (off + m) (num land 0xff); 13 - ass (num lsr 8) (pred m) 13 + (ass [@tailcall]) (num lsr 8) (pred m) 14 14 in 15 15 ass value (pred size) 16 16 ··· 74 74 75 75 type mode = Encrypt | Decrypt 76 76 77 - let crypto_core ~cipher ~mode ~key ~nonce ~maclen ~adata data = 78 - let datalen = String.length data in 79 - let cbcheader = prepare_header nonce adata datalen maclen in 80 - let dst = Bytes.create datalen in 77 + let crypto_core_into ~cipher ~mode ~key ~nonce ~adata src ~src_off dst ~dst_off len = 78 + let cbcheader = prepare_header nonce adata len block_size in 81 79 82 80 let small_q = 15 - String.length nonce in 83 81 let ctr_flag_val = flags 0 0 (small_q - 1) in ··· 93 91 cipher ~key (Bytes.unsafe_to_string block) ~src_off:dst_off block ~dst_off 94 92 in 95 93 96 - let cbcprep = 94 + let iv = 97 95 let rec doit iv iv_off block block_off = 98 96 match Bytes.length block - block_off with 99 97 | 0 -> Bytes.sub iv iv_off block_size 100 98 | _ -> 101 99 cbc (Bytes.unsafe_to_string iv) iv_off block block_off; 102 - doit block block_off block (block_off + block_size) 100 + (doit [@tailcall]) block block_off block (block_off + block_size) 103 101 in 104 102 doit (Bytes.make block_size '\x00') 0 cbcheader 0 105 103 in 106 104 107 - let rec loop iv ctr src src_off dst dst_off= 105 + let rec loop ctr src src_off dst dst_off len = 108 106 let cbcblock, cbc_off = 109 107 match mode with 110 108 | Encrypt -> src, src_off 111 109 | Decrypt -> Bytes.unsafe_to_string dst, dst_off 112 110 in 113 - match String.length src - src_off with 114 - | 0 -> iv 115 - | x when x < block_size -> 111 + if len = 0 then 112 + () 113 + else if len < block_size then begin 116 114 let buf = Bytes.make block_size '\x00' in 117 - Bytes.unsafe_blit dst dst_off buf 0 x; 115 + Bytes.unsafe_blit dst dst_off buf 0 len ; 118 116 ctrblock ctr buf ; 119 - Bytes.unsafe_blit buf 0 dst dst_off x ; 120 - unsafe_xor_into src ~src_off dst ~dst_off x ; 121 - Bytes.unsafe_blit_string cbcblock cbc_off buf 0 x; 122 - Bytes.unsafe_fill buf x (block_size - x) '\x00'; 123 - cbc (Bytes.unsafe_to_string buf) cbc_off iv 0 ; 124 - iv 125 - | _ -> 117 + Bytes.unsafe_blit buf 0 dst dst_off len ; 118 + unsafe_xor_into src ~src_off dst ~dst_off len ; 119 + Bytes.unsafe_blit_string cbcblock cbc_off buf 0 len ; 120 + Bytes.unsafe_fill buf len (block_size - len) '\x00'; 121 + cbc (Bytes.unsafe_to_string buf) cbc_off iv 0 122 + end else begin 126 123 ctrblock ctr dst ; 127 124 unsafe_xor_into src ~src_off dst ~dst_off block_size ; 128 125 cbc cbcblock cbc_off iv 0 ; 129 - loop iv (succ ctr) src (src_off + block_size) dst (dst_off + block_size) 126 + (loop [@tailcall]) (succ ctr) src (src_off + block_size) dst (dst_off + block_size) (len - block_size) 127 + end 130 128 in 131 - let last = loop cbcprep 1 data 0 dst 0 in 132 - let t = Bytes.sub last 0 maclen in 133 - (dst, t) 129 + loop 1 src src_off dst dst_off len; 130 + iv 131 + 132 + let crypto_core ~cipher ~mode ~key ~nonce ~adata data = 133 + let datalen = String.length data in 134 + let dst = Bytes.create datalen in 135 + let t = crypto_core_into ~cipher ~mode ~key ~nonce ~adata data ~src_off:0 dst ~dst_off:0 datalen in 136 + dst, t 134 137 135 138 let crypto_t t nonce cipher key = 136 139 let ctr = gen_ctr nonce 0 in 137 140 cipher ~key (Bytes.unsafe_to_string ctr) ~src_off:0 ctr ~dst_off:0 ; 138 141 unsafe_xor_into (Bytes.unsafe_to_string ctr) ~src_off:0 t ~dst_off:0 (Bytes.length t) 139 142 140 - let valid_nonce nonce = 141 - let nsize = String.length nonce in 142 - if nsize < 7 || nsize > 13 then 143 - invalid_arg "CCM: nonce length not between 7 and 13: %u" nsize 144 - 145 - let generation_encryption ~cipher ~key ~nonce ~maclen ~adata data = 146 - valid_nonce nonce; 147 - let cdata, t = crypto_core ~cipher ~mode:Encrypt ~key ~nonce ~maclen ~adata data in 143 + let unsafe_generation_encryption_into ~cipher ~key ~nonce ~adata src ~src_off dst ~dst_off ~tag_off len = 144 + let t = crypto_core_into ~cipher ~mode:Encrypt ~key ~nonce ~adata src ~src_off dst ~dst_off len in 148 145 crypto_t t nonce cipher key ; 149 - Bytes.unsafe_to_string cdata, Bytes.unsafe_to_string t 146 + Bytes.unsafe_blit t 0 dst tag_off block_size 150 147 151 - let decryption_verification ~cipher ~key ~nonce ~maclen ~adata ~tag data = 152 - valid_nonce nonce; 153 - let cdata, t = crypto_core ~cipher ~mode:Decrypt ~key ~nonce ~maclen ~adata data in 148 + let unsafe_decryption_verification_into ~cipher ~key ~nonce ~adata src ~src_off ~tag_off dst ~dst_off len = 149 + let tag = String.sub src tag_off block_size in 150 + let t = crypto_core_into ~cipher ~mode:Decrypt ~key ~nonce ~adata src ~src_off dst ~dst_off len in 154 151 crypto_t t nonce cipher key ; 155 - match Eqaf.equal tag (Bytes.unsafe_to_string t) with 156 - | true -> Some (Bytes.unsafe_to_string cdata) 157 - | false -> None 152 + Eqaf.equal tag (Bytes.unsafe_to_string t)

+80 -36

src/chacha20.ml

··· 42 42 Bytes.unsafe_blit_string nonce 0 state nonce_off (String.length nonce) ; 43 43 state, inc 44 44 45 - let crypt ~key ~nonce ?(ctr = 0L) data = 45 + let crypt_into ~key ~nonce ~ctr src ~src_off dst ~dst_off len = 46 46 let state, inc = init ctr ~key ~nonce in 47 - let l = String.length data in 48 - let block_count = l // block in 47 + let block_count = len // block in 49 48 let last_len = 50 - let last = l mod block in 49 + let last = len mod block in 51 50 if last = 0 then block else last 52 51 in 53 - let res = Bytes.create l in 54 52 let rec loop i = function 55 53 | 0 -> () 56 54 | 1 -> 57 55 if last_len = block then begin 58 - chacha20_block state i res ; 59 - Native.xor_into_bytes data i res i block 56 + chacha20_block state (dst_off + i) dst ; 57 + Native.xor_into_bytes src (src_off + i) dst (dst_off + i) block 60 58 end else begin 61 59 let buf = Bytes.create block in 62 60 chacha20_block state 0 buf ; 63 - Native.xor_into_bytes data i buf 0 last_len ; 64 - Bytes.unsafe_blit buf 0 res i last_len 61 + Native.xor_into_bytes src (src_off + i) buf 0 last_len ; 62 + Bytes.unsafe_blit buf 0 dst (dst_off + i) last_len 65 63 end 66 64 | n -> 67 - chacha20_block state i res ; 68 - Native.xor_into_bytes data i res i block ; 65 + chacha20_block state (dst_off + i) dst ; 66 + Native.xor_into_bytes src (src_off + i) dst (dst_off + i) block ; 69 67 inc state; 70 - loop (i + block) (n - 1) 68 + (loop [@tailcall]) (i + block) (n - 1) 71 69 in 72 - loop 0 block_count ; 70 + loop 0 block_count 71 + 72 + let crypt ~key ~nonce ?(ctr = 0L) data = 73 + let l = String.length data in 74 + let res = Bytes.create l in 75 + crypt_into ~key ~nonce ~ctr data ~src_off:0 res ~dst_off:0 l; 73 76 Bytes.unsafe_to_string res 74 77 75 78 module P = Poly1305.It 76 79 80 + let tag_size = P.mac_size 81 + 77 82 let generate_poly1305_key ~key ~nonce = 78 83 crypt ~key ~nonce (String.make 32 '\000') 79 84 80 - let mac ~key ~adata ciphertext = 81 - let pad16 b = 82 - let len = String.length b mod 16 in 85 + let mac_into ~key ~adata src ~src_off len dst ~dst_off = 86 + let pad16 l = 87 + let len = l mod 16 in 83 88 if len = 0 then "" else String.make (16 - len) '\000' 84 - and len = 89 + and len_buf = 85 90 let data = Bytes.create 16 in 86 91 Bytes.set_int64_le data 0 (Int64.of_int (String.length adata)); 87 - Bytes.set_int64_le data 8 (Int64.of_int (String.length ciphertext)); 92 + Bytes.set_int64_le data 8 (Int64.of_int len); 88 93 Bytes.unsafe_to_string data 89 94 in 90 - P.macl ~key [ adata ; pad16 adata ; ciphertext ; pad16 ciphertext ; len ] 95 + let p1 = pad16 (String.length adata) and p2 = pad16 len in 96 + P.unsafe_mac_into ~key [ adata, 0, String.length adata ; 97 + p1, 0, String.length p1 ; 98 + src, src_off, len ; 99 + p2, 0, String.length p2 ; 100 + len_buf, 0, String.length len_buf ] 101 + dst ~dst_off 91 102 92 - let authenticate_encrypt_tag ~key ~nonce ?(adata = "") data = 103 + let unsafe_authenticate_encrypt_into ~key ~nonce ?(adata = "") src ~src_off dst ~dst_off ~tag_off len = 93 104 let poly1305_key = generate_poly1305_key ~key ~nonce in 94 - let ciphertext = crypt ~key ~nonce ~ctr:1L data in 95 - let mac = mac ~key:poly1305_key ~adata ciphertext in 96 - ciphertext, mac 105 + crypt_into ~key ~nonce ~ctr:1L src ~src_off dst ~dst_off len; 106 + mac_into ~key:poly1305_key ~adata (Bytes.unsafe_to_string dst) ~src_off:dst_off len dst ~dst_off:tag_off 107 + 108 + let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len = 109 + if String.length src - src_off < len then 110 + invalid_arg "Chacha20: src length %u - src_off %u < len %u" 111 + (String.length src) src_off len; 112 + if Bytes.length dst - dst_off < len then 113 + invalid_arg "Chacha20: dst length %u - dst_off %u < len %u" 114 + (Bytes.length dst) dst_off len; 115 + if Bytes.length dst - tag_off < tag_size then 116 + invalid_arg "Chacha20: dst length %u - tag_off %u < tag_size %u" 117 + (Bytes.length dst) tag_off tag_size; 118 + unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len 97 119 98 120 let authenticate_encrypt ~key ~nonce ?adata data = 99 - let cdata, ctag = authenticate_encrypt_tag ~key ~nonce ?adata data in 100 - cdata ^ ctag 121 + let l = String.length data in 122 + let dst = Bytes.create (l + tag_size) in 123 + unsafe_authenticate_encrypt_into ~key ~nonce ?adata data ~src_off:0 dst ~dst_off:0 ~tag_off:l l; 124 + Bytes.unsafe_to_string dst 125 + 126 + let authenticate_encrypt_tag ~key ~nonce ?adata data = 127 + let r = authenticate_encrypt ~key ~nonce ?adata data in 128 + String.sub r 0 (String.length data), String.sub r (String.length data) tag_size 101 129 102 - let authenticate_decrypt_tag ~key ~nonce ?(adata = "") ~tag data = 130 + let unsafe_authenticate_decrypt_into ~key ~nonce ?(adata = "") src ~src_off ~tag_off dst ~dst_off len = 103 131 let poly1305_key = generate_poly1305_key ~key ~nonce in 104 - let ctag = mac ~key:poly1305_key ~adata data in 105 - let plain = crypt ~key ~nonce ~ctr:1L data in 106 - if Eqaf.equal tag ctag then Some plain else None 132 + let ctag = Bytes.create tag_size in 133 + mac_into ~key:poly1305_key ~adata src ~src_off len ctag ~dst_off:0; 134 + crypt_into ~key ~nonce ~ctr:1L src ~src_off dst ~dst_off len; 135 + Eqaf.equal (String.sub src tag_off tag_size) (Bytes.unsafe_to_string ctag) 136 + 137 + let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len = 138 + if String.length src - src_off < len then 139 + invalid_arg "Chacha20: src length %u - src_off %u < len %u" 140 + (String.length src) src_off len; 141 + if Bytes.length dst - dst_off < len then 142 + invalid_arg "Chacha20: dst length %u - dst_off %u < len %u" 143 + (Bytes.length dst) dst_off len; 144 + if String.length src - tag_off < tag_size then 145 + invalid_arg "Chacha20: src length %u - tag_off %u < tag_size %u" 146 + (String.length src) tag_off tag_size; 147 + unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len 107 148 108 149 let authenticate_decrypt ~key ~nonce ?adata data = 109 - if String.length data < P.mac_size then 150 + if String.length data < tag_size then 110 151 None 111 152 else 112 - let cipher, tag = 113 - let p = String.length data - P.mac_size in 114 - String.sub data 0 p, String.sub data p P.mac_size 115 - in 116 - authenticate_decrypt_tag ~key ~nonce ?adata ~tag cipher 153 + let l = String.length data - tag_size in 154 + let r = Bytes.create l in 155 + if unsafe_authenticate_decrypt_into ~key ~nonce ?adata data ~src_off:0 ~tag_off:l r ~dst_off:0 l then 156 + Some (Bytes.unsafe_to_string r) 157 + else 158 + None 117 159 118 - let tag_size = P.mac_size 160 + let authenticate_decrypt_tag ~key ~nonce ?adata ~tag data = 161 + let cdata = data ^ tag in 162 + authenticate_decrypt ~key ~nonce ?adata cdata

+269 -104

src/cipher_block.ml

··· 28 28 val block_size : int 29 29 val encrypt : key:key -> string -> string 30 30 val decrypt : key:key -> string -> string 31 + val encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 32 + val decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 33 + val unsafe_encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 34 + val unsafe_decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 31 35 end 32 36 33 37 module type CBC = sig ··· 40 44 41 45 val encrypt : key:key -> iv:string -> string -> string 42 46 val decrypt : key:key -> iv:string -> string -> string 43 - val next_iv : iv:string -> string -> string 47 + val next_iv : ?off:int -> string -> iv:string -> string 48 + 49 + val encrypt_into : key:key -> iv:string -> string -> src_off:int -> 50 + bytes -> dst_off:int -> int -> unit 51 + val decrypt_into : key:key -> iv:string -> string -> src_off:int -> 52 + bytes -> dst_off:int -> int -> unit 53 + 54 + val unsafe_encrypt_into : key:key -> iv:string -> string -> src_off:int -> 55 + bytes -> dst_off:int -> int -> unit 56 + val unsafe_decrypt_into : key:key -> iv:string -> string -> src_off:int -> 57 + bytes -> dst_off:int -> int -> unit 58 + val unsafe_encrypt_into_inplace : key:key -> iv:string -> 59 + bytes -> dst_off:int -> int -> unit 44 60 end 45 61 46 62 module type CTR = sig ··· 48 64 type key 49 65 val of_secret : string -> key 50 66 51 - type ctr 52 - 53 67 val key_sizes : int array 54 68 val block_size : int 55 69 70 + type ctr 71 + val add_ctr : ctr -> int64 -> ctr 72 + val next_ctr : ?off:int -> string -> ctr:ctr -> ctr 73 + val ctr_of_octets : string -> ctr 74 + 56 75 val stream : key:key -> ctr:ctr -> int -> string 57 76 val encrypt : key:key -> ctr:ctr -> string -> string 58 77 val decrypt : key:key -> ctr:ctr -> string -> string 59 78 60 - val add_ctr : ctr -> int64 -> ctr 61 - val next_ctr : ctr:ctr -> string -> ctr 62 - val ctr_of_octets : string -> ctr 79 + val stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit 80 + val encrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 81 + bytes -> dst_off:int -> int -> unit 82 + val decrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 83 + bytes -> dst_off:int -> int -> unit 84 + 85 + val unsafe_stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit 86 + val unsafe_encrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 87 + bytes -> dst_off:int -> int -> unit 88 + val unsafe_decrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 89 + bytes -> dst_off:int -> int -> unit 63 90 end 64 91 65 92 module type GCM = sig ··· 83 110 val size : int 84 111 val add : ctr -> int64 -> ctr 85 112 val of_octets : string -> ctr 86 - val unsafe_count_into : ctr -> bytes -> blocks:int -> unit 113 + val unsafe_count_into : ctr -> bytes -> off:int -> blocks:int -> unit 87 114 end 88 115 89 116 module C64be = struct ··· 91 118 let size = 8 92 119 let of_octets cs = String.get_int64_be cs 0 93 120 let add = Int64.add 94 - let unsafe_count_into t buf ~blocks = 95 - let tmp = Bytes.create 8 in 96 - Bytes.set_int64_be tmp 0 t; 97 - Native.count8be tmp buf ~blocks 121 + let unsafe_count_into t buf ~off ~blocks = 122 + let ctr = Bytes.create 8 in 123 + Bytes.set_int64_be ctr 0 t; 124 + Native.count8be ~ctr buf ~off ~blocks 98 125 end 99 126 100 127 module C128be = struct ··· 107 134 let w0' = Int64.add w0 n in 108 135 let flip = if Int64.logxor w0 w0' < 0L then w0' > w0 else w0' < w0 in 109 136 ((if flip then Int64.succ w1 else w1), w0') 110 - let unsafe_count_into (w1, w0) buf ~blocks = 111 - let tmp = Bytes.create 16 in 112 - Bytes.set_int64_be tmp 0 w1; Bytes.set_int64_be tmp 8 w0; 113 - Native.count16be tmp buf ~blocks 137 + let unsafe_count_into (w1, w0) buf ~off ~blocks = 138 + let ctr = Bytes.create 16 in 139 + Bytes.set_int64_be ctr 0 w1; Bytes.set_int64_be ctr 8 w0; 140 + Native.count16be ~ctr buf ~off ~blocks 114 141 end 115 142 116 143 module C128be32 = struct ··· 118 145 let add (w1, w0) n = 119 146 let hi = 0xffffffff00000000L and lo = 0x00000000ffffffffL in 120 147 (w1, Int64.(logor (logand hi w0) (add n w0 |> logand lo))) 121 - let unsafe_count_into (w1, w0) buf ~blocks = 122 - let tmp = Bytes.create 16 in 123 - Bytes.set_int64_be tmp 0 w1; Bytes.set_int64_be tmp 8 w0; 124 - Native.count16be4 tmp buf ~blocks 148 + let unsafe_count_into (w1, w0) buf ~off ~blocks = 149 + let ctr = Bytes.create 16 in 150 + Bytes.set_int64_be ctr 0 w1; Bytes.set_int64_be ctr 8 w0; 151 + Native.count16be4 ~ctr buf ~off ~blocks 125 152 end 126 153 end 127 154 155 + let check_offset ~tag ~buf ~off ~len actual_len = 156 + if off < 0 then 157 + invalid_arg "%s: %s off %u < 0" 158 + tag buf off; 159 + if actual_len - off < len then 160 + invalid_arg "%s: %s length %u - off %u < len %u" 161 + tag buf actual_len off len 162 + [@@inline] 163 + 128 164 module Modes = struct 129 165 module ECB_of (Core : Block.Core) : Block.ECB = struct 130 166 ··· 134 170 135 171 let of_secret = Core.of_secret 136 172 137 - let (encrypt, decrypt) = 138 - let ecb xform key src = 139 - let n = String.length src in 140 - if n mod block_size <> 0 then invalid_arg "ECB: length %u" n; 141 - let dst = Bytes.create n in 142 - xform ~key ~blocks:(n / block_size) src 0 dst 0 ; 143 - Bytes.unsafe_to_string dst 144 - in 145 - (fun ~key:(key, _) src -> ecb Core.encrypt key src), 146 - (fun ~key:(_, key) src -> ecb Core.decrypt key src) 173 + let unsafe_ecb xform key src src_off dst dst_off len = 174 + xform ~key ~blocks:(len / block_size) src src_off dst dst_off 175 + 176 + let ecb xform key src src_off dst dst_off len = 177 + if len mod block_size <> 0 then 178 + invalid_arg "ECB: length %u not of block size" len; 179 + check_offset ~tag:"ECB" ~buf:"src" ~off:src_off ~len (String.length src); 180 + check_offset ~tag:"ECB" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 181 + unsafe_ecb xform key src src_off dst dst_off len 182 + 183 + let encrypt_into ~key:(key, _) src ~src_off dst ~dst_off len = 184 + ecb Core.encrypt key src src_off dst dst_off len 185 + 186 + let unsafe_encrypt_into ~key:(key, _) src ~src_off dst ~dst_off len = 187 + unsafe_ecb Core.encrypt key src src_off dst dst_off len 188 + 189 + let decrypt_into ~key:(_, key) src ~src_off dst ~dst_off len = 190 + ecb Core.decrypt key src src_off dst dst_off len 191 + 192 + let unsafe_decrypt_into ~key:(_, key) src ~src_off dst ~dst_off len = 193 + unsafe_ecb Core.decrypt key src src_off dst dst_off len 147 194 195 + let encrypt ~key src = 196 + let len = String.length src in 197 + let dst = Bytes.create len in 198 + encrypt_into ~key src ~src_off:0 dst ~dst_off:0 len; 199 + Bytes.unsafe_to_string dst 200 + 201 + let decrypt ~key src = 202 + let len = String.length src in 203 + let dst = Bytes.create len in 204 + decrypt_into ~key src ~src_off:0 dst ~dst_off:0 len; 205 + Bytes.unsafe_to_string dst 148 206 end 149 207 150 208 module CBC_of (Core : Block.Core) : Block.CBC = struct ··· 156 214 157 215 let of_secret = Core.of_secret 158 216 159 - let bounds_check ~iv cs = 160 - if String.length iv <> block then invalid_arg "CBC: IV length %u" (String.length iv); 161 - if String.length cs mod block <> 0 then 162 - invalid_arg "CBC: argument length %u" (String.length cs) 217 + let check_block_size ~iv len = 218 + if String.length iv <> block then 219 + invalid_arg "CBC: IV length %u not of block size" (String.length iv); 220 + if len mod block <> 0 then 221 + invalid_arg "CBC: argument length %u not of block size" 222 + len 223 + [@@inline] 163 224 164 - let next_iv ~iv cs = 165 - bounds_check ~iv cs ; 166 - if String.length cs > 0 then 225 + let next_iv ?(off = 0) cs ~iv = 226 + check_block_size ~iv (String.length cs - off) ; 227 + if String.length cs > off then 167 228 String.sub cs (String.length cs - block_size) block_size 168 229 else iv 169 230 170 - let encrypt ~key:(key, _) ~iv src = 171 - bounds_check ~iv src ; 172 - let dst = Bytes.of_string src in 231 + let unsafe_encrypt_into_inplace ~key:(key, _) ~iv dst ~dst_off len = 173 232 let rec loop iv iv_i dst_i = function 174 - 0 -> () 175 - | b -> Native.xor_into_bytes iv iv_i dst dst_i block ; 176 - Core.encrypt ~key ~blocks:1 (Bytes.unsafe_to_string dst) dst_i dst dst_i ; 177 - loop (Bytes.unsafe_to_string dst) dst_i (dst_i + block) (b - 1) 233 + | 0 -> () 234 + | b -> 235 + Native.xor_into_bytes iv iv_i dst dst_i block ; 236 + Core.encrypt ~key ~blocks:1 (Bytes.unsafe_to_string dst) dst_i dst dst_i ; 237 + (loop [@tailcall]) (Bytes.unsafe_to_string dst) dst_i (dst_i + block) (b - 1) 178 238 in 179 - loop iv 0 0 (Bytes.length dst / block) ; 239 + loop iv 0 dst_off (len / block) 240 + 241 + let unsafe_encrypt_into ~key ~iv src ~src_off dst ~dst_off len = 242 + Bytes.unsafe_blit_string src src_off dst dst_off len; 243 + unsafe_encrypt_into_inplace ~key ~iv dst ~dst_off len 244 + 245 + let encrypt_into ~key ~iv src ~src_off dst ~dst_off len = 246 + check_block_size ~iv len; 247 + check_offset ~tag:"CBC" ~buf:"src" ~off:src_off ~len (String.length src); 248 + check_offset ~tag:"CBC" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 249 + unsafe_encrypt_into ~key ~iv src ~src_off dst ~dst_off len 250 + 251 + let encrypt ~key ~iv src = 252 + let dst = Bytes.create (String.length src) in 253 + encrypt_into ~key ~iv src ~src_off:0 dst ~dst_off:0 (String.length src); 180 254 Bytes.unsafe_to_string dst 181 255 182 - let decrypt ~key:(_, key) ~iv src = 183 - bounds_check ~iv src ; 184 - let msg = Bytes.create (String.length src) 185 - and b = String.length src / block in 256 + let unsafe_decrypt_into ~key:(_, key) ~iv src ~src_off dst ~dst_off len = 257 + let b = len / block in 186 258 if b > 0 then begin 187 - Core.decrypt ~key ~blocks:b src 0 msg 0 ; 188 - Native.xor_into_bytes iv 0 msg 0 block ; 189 - Native.xor_into_bytes src 0 msg block ((b - 1) * block) ; 190 - end ; 259 + Core.decrypt ~key ~blocks:b src src_off dst dst_off ; 260 + Native.xor_into_bytes iv 0 dst dst_off block ; 261 + Native.xor_into_bytes src src_off dst (dst_off + block) ((b - 1) * block) ; 262 + end 263 + 264 + let decrypt_into ~key ~iv src ~src_off dst ~dst_off len = 265 + check_block_size ~iv len; 266 + check_offset ~tag:"CBC" ~buf:"src" ~off:src_off ~len (String.length src); 267 + check_offset ~tag:"CBC" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 268 + unsafe_decrypt_into ~key ~iv src ~src_off dst ~dst_off len 269 + 270 + let decrypt ~key ~iv src = 271 + let len = String.length src in 272 + let msg = Bytes.create len in 273 + decrypt_into ~key ~iv src ~src_off:0 msg ~dst_off:0 len; 191 274 Bytes.unsafe_to_string msg 192 - 193 275 end 194 276 195 277 module CTR_of (Core : Block.Core) (Ctr : Counters.S) : ··· 204 286 let (key_sizes, block_size) = Core.(key, block) 205 287 let of_secret = Core.e_of_secret 206 288 207 - let stream ~key ~ctr n = 208 - let blocks = imax 0 n / block_size in 209 - let buf = Bytes.create n in 210 - Ctr.unsafe_count_into ctr ~blocks buf ; 211 - Core.encrypt ~key ~blocks (Bytes.unsafe_to_string buf) 0 buf 0 ; 212 - let slack = imax 0 n mod block_size in 289 + let unsafe_stream_into ~key ~ctr buf ~off len = 290 + let blocks = imax 0 len / block_size in 291 + Ctr.unsafe_count_into ctr buf ~off ~blocks ; 292 + Core.encrypt ~key ~blocks (Bytes.unsafe_to_string buf) off buf off ; 293 + let slack = imax 0 len mod block_size in 213 294 if slack <> 0 then begin 214 295 let buf' = Bytes.create block_size in 215 296 let ctr = Ctr.add ctr (Int64.of_int blocks) in 216 - Ctr.unsafe_count_into ctr ~blocks:1 buf' ; 297 + Ctr.unsafe_count_into ctr buf' ~off:0 ~blocks:1 ; 217 298 Core.encrypt ~key ~blocks:1 (Bytes.unsafe_to_string buf') 0 buf' 0 ; 218 - Bytes.unsafe_blit buf' 0 buf (blocks * block_size) slack 219 - end; 299 + Bytes.unsafe_blit buf' 0 buf (off + blocks * block_size) slack 300 + end 301 + 302 + let stream_into ~key ~ctr buf ~off len = 303 + check_offset ~tag:"CTR" ~buf:"buf" ~off ~len (Bytes.length buf); 304 + unsafe_stream_into ~key ~ctr buf ~off len 305 + 306 + let stream ~key ~ctr n = 307 + let buf = Bytes.create n in 308 + unsafe_stream_into ~key ~ctr buf ~off:0 n; 220 309 Bytes.unsafe_to_string buf 221 310 311 + let unsafe_encrypt_into ~key ~ctr src ~src_off dst ~dst_off len = 312 + unsafe_stream_into ~key ~ctr dst ~off:dst_off len; 313 + Uncommon.unsafe_xor_into src ~src_off dst ~dst_off len 314 + 315 + let encrypt_into ~key ~ctr src ~src_off dst ~dst_off len = 316 + check_offset ~tag:"CTR" ~buf:"src" ~off:src_off ~len (String.length src); 317 + check_offset ~tag:"CTR" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 318 + unsafe_encrypt_into ~key ~ctr src ~src_off dst ~dst_off len 319 + 222 320 let encrypt ~key ~ctr src = 223 - let res = Bytes.unsafe_of_string (stream ~key ~ctr (String.length src)) in 224 - Native.xor_into_bytes src 0 res 0 (String.length src) ; 225 - Bytes.unsafe_to_string res 321 + let len = String.length src in 322 + let dst = Bytes.create len in 323 + encrypt_into ~key ~ctr src ~src_off:0 dst ~dst_off:0 len; 324 + Bytes.unsafe_to_string dst 226 325 227 326 let decrypt = encrypt 228 327 328 + let decrypt_into = encrypt_into 329 + 330 + let unsafe_decrypt_into = unsafe_encrypt_into 331 + 229 332 let add_ctr = Ctr.add 230 - let next_ctr ~ctr msg = add_ctr ctr (Int64.of_int @@ String.length msg // block_size) 333 + let next_ctr ?(off = 0) msg ~ctr = 334 + add_ctr ctr (Int64.of_int @@ (String.length msg - off) // block_size) 231 335 let ctr_of_octets = Ctr.of_octets 232 336 end 233 337 ··· 235 339 type key 236 340 val derive : string -> key 237 341 val digesti : key:key -> (string Uncommon.iter) -> string 342 + val digesti_off_len : key:key -> (string * int * int) Uncommon.iter -> string 238 343 val tagsize : int 239 344 end = struct 240 345 type key = string ··· 245 350 let k = Bytes.create keysize in 246 351 Native.GHASH.keyinit cs k; 247 352 Bytes.unsafe_to_string k 353 + let digesti_off_len ~key i = 354 + let res = Bytes.make tagsize '\x00' in 355 + i (fun (cs, off, len) -> Native.GHASH.ghash key res cs off len); 356 + Bytes.unsafe_to_string res 248 357 let digesti ~key i = 249 358 let res = Bytes.make tagsize '\x00' in 250 - i (fun cs -> Native.GHASH.ghash key res cs (String.length cs)); 359 + i (fun cs -> Native.GHASH.ghash key res cs 0 (String.length cs)); 251 360 Bytes.unsafe_to_string res 361 + 252 362 end 253 363 254 364 module GCM_of (C : Block.Core) : Block.GCM = struct 255 365 256 - let _ = assert (C.block = 16) 366 + assert (C.block = 16) 257 367 module CTR = CTR_of (C) (Counters.C128be32) 258 368 259 369 type key = { key : C.ekey ; hkey : GHASH.key } ··· 285 395 CTR.ctr_of_octets @@ 286 396 GHASH.digesti ~key:hkey @@ iter2 nonce (pack64s 0L (bits64 nonce)) 287 397 288 - let tag ~key ~hkey ~ctr ?(adata = "") cdata = 289 - CTR.encrypt ~key ~ctr @@ 290 - GHASH.digesti ~key:hkey @@ 291 - iter3 adata cdata (pack64s (bits64 adata) (bits64 cdata)) 398 + let unsafe_tag_into ~key ~hkey ~ctr ?(adata = "") cdata ~off ~len dst ~tag_off = 399 + CTR.unsafe_encrypt_into ~key ~ctr 400 + (GHASH.digesti_off_len ~key:hkey 401 + (iter3 (adata, 0, String.length adata) (cdata, off, len) 402 + (pack64s (bits64 adata) (Int64.of_int (len * 8)), 0, 16))) 403 + ~src_off:0 dst ~dst_off:tag_off tag_size 292 404 293 - let authenticate_encrypt_tag ~key:{ key; hkey } ~nonce ?adata data = 294 - let ctr = counter ~hkey nonce in 295 - let cdata = CTR.(encrypt ~key ~ctr:(add_ctr ctr 1L) data) in 296 - let ctag = tag ~key ~hkey ~ctr ?adata cdata in 297 - cdata, ctag 405 + let unsafe_authenticate_encrypt_into ~key:{ key; hkey } ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len = 406 + let ctr = counter ~hkey nonce in 407 + CTR.(unsafe_encrypt_into ~key ~ctr:(add_ctr ctr 1L) src ~src_off dst ~dst_off len); 408 + unsafe_tag_into ~key ~hkey ~ctr ?adata (Bytes.unsafe_to_string dst) ~off:dst_off ~len dst ~tag_off 409 + 410 + let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len = 411 + check_offset ~tag:"GCM" ~buf:"src" ~off:src_off ~len (String.length src); 412 + check_offset ~tag:"GCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 413 + check_offset ~tag:"GCM" ~buf:"dst tag" ~off:tag_off ~len:tag_size (Bytes.length dst); 414 + unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len 298 415 299 416 let authenticate_encrypt ~key ~nonce ?adata data = 300 - let cdata, ctag = authenticate_encrypt_tag ~key ~nonce ?adata data in 301 - cdata ^ ctag 417 + let l = String.length data in 418 + let dst = Bytes.create (l + tag_size) in 419 + unsafe_authenticate_encrypt_into ~key ~nonce ?adata data ~src_off:0 dst ~dst_off:0 ~tag_off:l l; 420 + Bytes.unsafe_to_string dst 302 421 303 - let authenticate_decrypt_tag ~key:{ key; hkey } ~nonce ?adata ~tag:tag_data cipher = 304 - let ctr = counter ~hkey nonce in 305 - let data = CTR.(encrypt ~key ~ctr:(add_ctr ctr 1L) cipher) in 306 - let ctag = tag ~key ~hkey ~ctr ?adata cipher in 307 - if Eqaf.equal tag_data ctag then Some data else None 422 + let authenticate_encrypt_tag ~key ~nonce ?adata data = 423 + let r = authenticate_encrypt ~key ~nonce ?adata data in 424 + String.sub r 0 (String.length data), 425 + String.sub r (String.length data) tag_size 426 + 427 + let unsafe_authenticate_decrypt_into ~key:{ key; hkey } ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len = 428 + let ctr = counter ~hkey nonce in 429 + CTR.(unsafe_encrypt_into ~key ~ctr:(add_ctr ctr 1L) src ~src_off dst ~dst_off len); 430 + let ctag = Bytes.create tag_size in 431 + unsafe_tag_into ~key ~hkey ~ctr ?adata src ~off:src_off ~len ctag ~tag_off:0; 432 + Eqaf.equal (String.sub src tag_off tag_size) (Bytes.unsafe_to_string ctag) 433 + 434 + let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len = 435 + check_offset ~tag:"GCM" ~buf:"src" ~off:src_off ~len (String.length src); 436 + check_offset ~tag:"GCM" ~buf:"src tag" ~off:tag_off ~len:tag_size (String.length src); 437 + check_offset ~tag:"GCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 438 + unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len 308 439 309 440 let authenticate_decrypt ~key ~nonce ?adata cdata = 310 441 if String.length cdata < tag_size then 311 442 None 312 443 else 313 - let cipher, tag = 314 - String.sub cdata 0 (String.length cdata - tag_size), 315 - String.sub cdata (String.length cdata - tag_size) tag_size 316 - in 317 - authenticate_decrypt_tag ~key ~nonce ?adata ~tag cipher 444 + let l = String.length cdata - tag_size in 445 + let data = Bytes.create l in 446 + if unsafe_authenticate_decrypt_into ~key ~nonce ?adata cdata ~src_off:0 ~tag_off:l data ~dst_off:0 l then 447 + Some (Bytes.unsafe_to_string data) 448 + else 449 + None 450 + 451 + let authenticate_decrypt_tag ~key ~nonce ?adata ~tag:tag_data cipher = 452 + let cdata = cipher ^ tag_data in 453 + authenticate_decrypt ~key ~nonce ?adata cdata 318 454 end 319 455 320 456 module CCM16_of (C : Block.Core) : Block.CCM16 = struct 321 457 322 - let _ = assert (C.block = 16) 458 + assert (C.block = 16) 323 459 324 - let tag_size = 16 460 + let tag_size = C.block 325 461 326 462 type key = C.ekey 327 463 ··· 330 466 let (key_sizes, block_size) = C.(key, block) 331 467 332 468 let cipher ~key src ~src_off dst ~dst_off = 333 - if String.length src - src_off < block_size || Bytes.length dst - dst_off < block_size then 334 - invalid_arg "src len %u, dst len %u" (String.length src - src_off) (Bytes.length dst - dst_off); 335 469 C.encrypt ~key ~blocks:1 src src_off dst dst_off 336 470 337 - let authenticate_encrypt_tag ~key ~nonce ?(adata = "") cs = 338 - Ccm.generation_encryption ~cipher ~key ~nonce ~maclen:tag_size ~adata cs 471 + let unsafe_authenticate_encrypt_into ~key ~nonce ?(adata = "") src ~src_off dst ~dst_off ~tag_off len = 472 + Ccm.unsafe_generation_encryption_into ~cipher ~key ~nonce ~adata 473 + src ~src_off dst ~dst_off ~tag_off len 474 + 475 + let valid_nonce nonce = 476 + let nsize = String.length nonce in 477 + if nsize < 7 || nsize > 13 then 478 + invalid_arg "CCM: nonce length not between 7 and 13: %u" nsize 479 + 480 + let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len = 481 + check_offset ~tag:"CCM" ~buf:"src" ~off:src_off ~len (String.length src); 482 + check_offset ~tag:"CCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 483 + check_offset ~tag:"CCM" ~buf:"dst tag" ~off:tag_off ~len:tag_size (Bytes.length dst); 484 + valid_nonce nonce; 485 + unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off ~tag_off len 339 486 340 487 let authenticate_encrypt ~key ~nonce ?adata cs = 341 - let cdata, ctag = authenticate_encrypt_tag ~key ~nonce ?adata cs in 342 - cdata ^ ctag 488 + valid_nonce nonce; 489 + let l = String.length cs in 490 + let dst = Bytes.create (l + tag_size) in 491 + unsafe_authenticate_encrypt_into ~key ~nonce ?adata cs ~src_off:0 dst ~dst_off:0 ~tag_off:l l; 492 + Bytes.unsafe_to_string dst 343 493 344 - let authenticate_decrypt_tag ~key ~nonce ?(adata = "") ~tag cs = 345 - Ccm.decryption_verification ~cipher ~key ~nonce ~maclen:tag_size ~adata ~tag cs 494 + let authenticate_encrypt_tag ~key ~nonce ?adata cs = 495 + let res = authenticate_encrypt ~key ~nonce ?adata cs in 496 + String.sub res 0 (String.length cs), String.sub res (String.length cs) tag_size 497 + 498 + let unsafe_authenticate_decrypt_into ~key ~nonce ?(adata = "") src ~src_off ~tag_off dst ~dst_off len = 499 + Ccm.unsafe_decryption_verification_into ~cipher ~key ~nonce ~adata src ~src_off ~tag_off dst ~dst_off len 500 + 501 + let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len = 502 + check_offset ~tag:"CCM" ~buf:"src" ~off:src_off ~len (String.length src); 503 + check_offset ~tag:"CCM" ~buf:"src tag" ~off:tag_off ~len:tag_size (String.length src); 504 + check_offset ~tag:"CCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst); 505 + valid_nonce nonce; 506 + unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst ~dst_off len 346 507 347 508 let authenticate_decrypt ~key ~nonce ?adata data = 348 509 if String.length data < tag_size then 349 510 None 350 511 else 351 - let data, tag = 352 - String.sub data 0 (String.length data - tag_size), 353 - String.sub data (String.length data - tag_size) tag_size 354 - in 355 - authenticate_decrypt_tag ~key ~nonce ?adata ~tag data 512 + let dlen = String.length data - tag_size in 513 + let dst = Bytes.create dlen in 514 + if authenticate_decrypt_into ~key ~nonce ?adata data ~src_off:0 ~tag_off:dlen dst ~dst_off:0 dlen then 515 + Some (Bytes.unsafe_to_string dst) 516 + else 517 + None 518 + 519 + let authenticate_decrypt_tag ~key ~nonce ?adata ~tag cs = 520 + authenticate_decrypt ~key ~nonce ?adata (cs ^ tag) 356 521 end 357 522 end 358 523

+2 -2

src/cipher_stream.ml

··· 26 26 let j = (j + si + x) land 0xff in 27 27 let sj = s.(j) in 28 28 s.(i) <- sj ; s.(j) <- si ; 29 - loop j (succ i) 29 + (loop [@tailcall]) j (succ i) 30 30 in 31 31 ( loop 0 0 ; (0, 0, s) ) 32 32 ··· 44 44 s.(i) <- sj ; s.(j) <- si ; 45 45 let k = s.((si + sj) land 0xff) in 46 46 Bytes.set_uint8 res n (k lxor String.get_uint8 buf n); 47 - mix i j (succ n) 47 + (mix [@tailcall]) i j (succ n) 48 48 in 49 49 let key' = mix i j 0 in 50 50 { key = key' ; message = Bytes.unsafe_to_string res }

+242 -24

src/mirage_crypto.mli

··· 74 74 (** [maci ~key iter] is the all-in-one mac computation: 75 75 [get (feedi (empty ~key) iter)]. *) 76 76 77 - val macl : key:string -> string list -> string 78 - (** [macl ~key datas] computes the [mac] of [datas]. *) 77 + val mac_into : key:string -> (string * int * int) list -> bytes -> dst_off:int -> unit 78 + (** [mac_into ~key datas dst dst_off] computes the [mac] of [datas]. *) 79 + 80 + (**/**) 81 + val unsafe_mac_into : key:string -> (string * int * int) list -> bytes -> dst_off:int -> unit 82 + (** [unsafe_mac_into ~key datas dst dst_off] is {!mac_into} without bounds checks. *) 83 + (**/**) 79 84 end 80 85 81 86 (** {1 Symmetric-key cryptography} *) ··· 141 146 returned. 142 147 143 148 @raise Invalid_argument if [nonce] is not of the right size. *) 149 + 150 + (** {1 Authenticated encryption and decryption into existing buffers} *) 151 + 152 + val authenticate_encrypt_into : key:key -> nonce:string -> 153 + ?adata:string -> string -> src_off:int -> bytes -> dst_off:int -> 154 + tag_off:int -> int -> unit 155 + (** [authenticate_encrypt_into ~key ~nonce ~adata msg ~src_off dst ~dst_off ~tag_off len] 156 + encrypts [len] bytes of [msg] starting at [src_off] with [key] and [nonce]. The output 157 + is put into [dst] at [dst_off], the tag into [dst] at [tag_off]. 158 + 159 + @raise Invalid_argument if [nonce] is not of the right size. 160 + @raise Invalid_argument if [String.length msg - src_off < len]. 161 + @raise Invalid_argument if [Bytes.length dst - dst_off < len]. 162 + @raise Invalid_argument if [Bytes.length dst - tag_off < tag_size]. 163 + *) 164 + 165 + val authenticate_decrypt_into : key:key -> nonce:string -> 166 + ?adata:string -> string -> src_off:int -> tag_off:int -> bytes -> 167 + dst_off:int -> int -> bool 168 + (** [authenticate_decrypt_into ~key ~nonce ~adata msg ~src_off ~tag_off dst ~dst_off len] 169 + computes the authentication tag using [key], [nonce], and [adata], and 170 + decrypts the [len] bytes encrypted data from [msg] starting at [src_off] into [dst] 171 + starting at [dst_off]. If the authentication tags match, [true] is 172 + returned, and the decrypted data is in [dst]. 173 + 174 + @raise Invalid_argument if [nonce] is not of the right size. 175 + @raise Invalid_argument if [String.length msg - src_off < len]. 176 + @raise Invalid_argument if [Bytes.length dst - dst_off < len]. 177 + @raise Invalid_argument if [String.length msg - tag_off < tag_size]. *) 178 + 179 + (**/**) 180 + val unsafe_authenticate_encrypt_into : key:key -> nonce:string -> 181 + ?adata:string -> string -> src_off:int -> bytes -> dst_off:int -> 182 + tag_off:int -> int -> unit 183 + (** [unsafe_authenticate_encrypt_into] is {!authenticate_encrypt_into}, but 184 + without bounds checks. 185 + 186 + @raise Invalid_argument if [nonce] is not of the right size. 187 + 188 + This may cause memory issues if an invariant is violated: 189 + {ul 190 + {- [String.length msg - src_off >= len].} 191 + {- [Bytes.length dst - dst_off >= len].} 192 + {- [Bytes.length dst - tag_off >= tag_size].}} *) 193 + 194 + val unsafe_authenticate_decrypt_into : key:key -> nonce:string -> 195 + ?adata:string -> string -> src_off:int -> tag_off:int -> bytes -> 196 + dst_off:int -> int -> bool 197 + (** [unsafe_authenticate_decrypt_into] is {!authenticate_decrypt_into}, but 198 + without bounds checks. 199 + 200 + @raise Invalid_argument if [nonce] is not of the right size. 201 + 202 + This may cause memory issues if an invariant is violated: 203 + {ul 204 + {- [String.length msg - src_off >= len].} 205 + {- [Bytes.length dst - dst_off >= len].} 206 + {- [String.length msg - tag_off >= tag_size].}} *) 207 + (**/**) 144 208 end 145 209 146 210 (** Block ciphers. ··· 157 221 module type ECB = sig 158 222 159 223 type key 224 + 160 225 val of_secret : string -> key 226 + (** Construct the encryption key corresponding to [secret]. 227 + 228 + @raise Invalid_argument if the length of [secret] is not in 229 + {{!key_sizes}[key_sizes]}. *) 161 230 162 231 val key_sizes : int array 232 + (** Key sizes allowed with this cipher. *) 233 + 163 234 val block_size : int 235 + (** The size of a single block. *) 236 + 164 237 val encrypt : key:key -> string -> string 238 + (** [encrypt ~key src] encrypts [src] into a freshly allocated buffer of the 239 + same size using [key]. 240 + 241 + @raise Invalid_argument if the length of [src] is not a multiple of 242 + {!block_size}. *) 243 + 165 244 val decrypt : key:key -> string -> string 245 + (** [decrypt ~key src] decrypts [src] into a freshly allocated buffer of the 246 + same size using [key]. 247 + 248 + @raise Invalid_argument if the length of [src] is not a multiple of 249 + {!block_size}. *) 250 + 251 + val encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 252 + (** [encrypt_into ~key src ~src_off dst dst_off len] encrypts [len] octets 253 + from [src] starting at [src_off] into [dst] starting at [dst_off]. 254 + 255 + @raise Invalid_argument if [len] is not a multiple of {!block_size}. 256 + @raise Invalid_argument if [src_off < 0 || String.length src - src_off < len]. 257 + @raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *) 258 + 259 + val decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 260 + (** [decrypt_into ~key src ~src_off dst dst_off len] decrypts [len] octets 261 + from [src] starting at [src_off] into [dst] starting at [dst_off]. 262 + 263 + @raise Invalid_argument if [len] is not a multiple of {!block_size}. 264 + @raise Invalid_argument if [src_off < 0 || String.length src - src_off < len]. 265 + @raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *) 266 + 267 + (**/**) 268 + val unsafe_encrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 269 + (** [unsafe_encrypt_into] is {!encrypt_into}, but without bounds checks. 270 + 271 + This may cause memory issues if an invariant is violated: 272 + {ul 273 + {- [len] must be a multiple of {!block_size},} 274 + {- [src_off >= 0 && String.length src - src_off >= len],} 275 + {- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *) 276 + 277 + val unsafe_decrypt_into : key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit 278 + (** [unsafe_decrypt_into] is {!decrypt_into}, but without bounds checks. 279 + 280 + This may cause memory issues if an invariant is violated: 281 + {ul 282 + {- [len] must be a multiple of {!block_size},} 283 + {- [src_off >= 0 && String.length src - src_off >= len],} 284 + {- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *) 285 + (**/**) 166 286 end 167 287 168 288 (** {e Cipher-block chaining} mode. *) ··· 195 315 @raise Invalid_argument if [iv] is not [block_size], or [msg] is not 196 316 [k * block_size] long. *) 197 317 198 - val next_iv : iv:string -> string -> string 199 - (** [next_iv ~iv ciphertext] is the first [iv] {e following} the 318 + val next_iv : ?off:int -> string -> iv:string -> string 319 + (** [next_iv ~iv ciphertext ~off] is the first [iv] {e following} the 200 320 encryption that used [iv] to produce [ciphertext]. 201 321 202 322 For protocols which perform inter-message chaining, this is the [iv] 203 323 for the next message. 204 324 205 - It is either [iv], when [len ciphertext = 0], or the last block of 206 - [ciphertext]. Note that 325 + It is either [iv], when [String.length ciphertext - off = 0], or the 326 + last block of [ciphertext]. Note that 207 327 208 328 {[encrypt ~iv msg1 || encrypt ~iv:(next_iv ~iv (encrypt ~iv msg1)) msg2 209 329 == encrypt ~iv (msg1 || msg2)]} 210 330 211 - @raise Invalid_argument if the length of [iv] is not [block_size], or 212 - the length of [ciphertext] is not [k * block_size] for some [k]. *) 213 - end 331 + @raise Invalid_argument if the length of [iv] is not [block_size]. 332 + @raise Invalid_argument if the length of [ciphertext] is not a multiple 333 + of [block_size]. *) 334 + 335 + val encrypt_into : key:key -> iv:string -> string -> src_off:int -> 336 + bytes -> dst_off:int -> int -> unit 337 + (** [encrypt_into ~key ~iv src ~src_off dst dst_off len] encrypts [len] 338 + octets from [src] starting at [src_off] into [dst] starting at [dst_off]. 339 + 340 + @raise Invalid_argument if the length of [iv] is not {!block_size}. 341 + @raise Invalid_argument if [len] is not a multiple of {!block_size}. 342 + @raise Invalid_argument if [src_off < 0 || String.length src - src_off < len]. 343 + @raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *) 344 + 345 + val decrypt_into : key:key -> iv:string -> string -> src_off:int -> 346 + bytes -> dst_off:int -> int -> unit 347 + (** [decrypt_into ~key ~iv src ~src_off dst dst_off len] decrypts [len] 348 + octets from [src] starting at [src_off] into [dst] starting at [dst_off]. 349 + 350 + @raise Invalid_argument if the length of [iv] is not {!block_size}. 351 + @raise Invalid_argument if [len] is not a multiple of {!block_size}. 352 + @raise Invalid_argument if [src_off < 0 || String.length src - src_off < len]. 353 + @raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. *) 354 + 355 + (**/**) 356 + val unsafe_encrypt_into : key:key -> iv:string -> string -> src_off:int -> 357 + bytes -> dst_off:int -> int -> unit 358 + (** [unsafe_encrypt_into] is {!encrypt_into}, but without bounds checks. 359 + 360 + This may casue memory issues if an invariant is violated: 361 + {ul 362 + {- the length of [iv] must be {!block_size},} 363 + {- [len] must be a multiple of {!block_size},} 364 + {- [src_off >= 0 && String.length src - src_off >= len],} 365 + {- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *) 366 + 367 + val unsafe_decrypt_into : key:key -> iv:string -> string -> src_off:int -> 368 + bytes -> dst_off:int -> int -> unit 369 + (** [unsafe_decrypt_into] is {!decrypt_into}, but without bounds checks. 370 + 371 + This may casue memory issues if an invariant is violated: 372 + {ul 373 + {- the length of [iv] must be {!block_size},} 374 + {- [len] must be a multiple of {!block_size},} 375 + {- [src_off >= 0 && String.length src - src_off >= len],} 376 + {- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *) 377 + 378 + val unsafe_encrypt_into_inplace : key:key -> iv:string -> 379 + bytes -> dst_off:int -> int -> unit 380 + (** [unsafe_encrypt_into_inplace] is {!unsafe_encrypt_into}, but assumes 381 + that [dst] already contains the mesage to be encrypted. 382 + 383 + This may casue memory issues if an invariant is violated: 384 + {ul 385 + {- the length of [iv] must be {!block_size},} 386 + {- [len] must be a multiple of {!block_size},} 387 + {- [src_off >= 0 && String.length src - src_off >= len],} 388 + {- [dst_off >= 0 && Bytes.length dst - dst_off >= len].}} *) 389 + (**/**) 390 + end 214 391 215 392 (** {e Counter} mode. *) 216 393 module type CTR = sig ··· 231 408 232 409 type ctr 233 410 411 + val add_ctr : ctr -> int64 -> ctr 412 + (** [add_ctr ctr n] adds [n] to [ctr]. *) 413 + 414 + val next_ctr : ?off:int -> string -> ctr:ctr -> ctr 415 + (** [next_ctr ~off msg ~ctr] is the state of the counter after encrypting or 416 + decrypting [msg] at offset [off] with the counter [ctr]. 417 + 418 + For protocols which perform inter-message chaining, this is the 419 + counter for the next message. 420 + 421 + It is computed as [C.add ctr (ceil (len msg / block_size))]. Note that 422 + if [len msg1 = k * block_size], 423 + 424 + {[encrypt ~ctr msg1 || encrypt ~ctr:(next_ctr ~ctr msg1) msg2 425 + == encrypt ~ctr (msg1 || msg2)]} 426 + 427 + *) 428 + 429 + val ctr_of_octets : string -> ctr 430 + (** [ctr_of_octets buf] converts the value of [buf] into a counter. *) 431 + 234 432 val stream : key:key -> ctr:ctr -> int -> string 235 433 (** [stream ~key ~ctr n] is the raw keystream. 236 434 ··· 249 447 250 448 val encrypt : key:key -> ctr:ctr -> string -> string 251 449 (** [encrypt ~key ~ctr msg] is 252 - [stream ~key ~ctr ~off (len msg) lxor msg]. *) 450 + [stream ~key ~ctr (len msg) lxor msg]. *) 253 451 254 452 val decrypt : key:key -> ctr:ctr -> string -> string 255 453 (** [decrypt] is [encrypt]. *) 256 454 257 - val add_ctr : ctr -> int64 -> ctr 258 - (** [add_ctr ctr n] adds [n] to [ctr]. *) 455 + val stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit 456 + (** [stream_into ~key ~ctr dst ~off len] is the raw key stream put into 457 + [dst] starting at [off]. 259 458 260 - val next_ctr : ctr:ctr -> string -> ctr 261 - (** [next_ctr ~ctr msg] is the state of the counter after encrypting or 262 - decrypting [msg] with the counter [ctr]. 459 + @raise Invalid_argument if [Bytes.length dst - off < len]. *) 263 460 264 - For protocols which perform inter-message chaining, this is the 265 - counter for the next message. 461 + val encrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 462 + bytes -> dst_off:int -> int -> unit 463 + (** [encrypt_into ~key ~ctr src ~src_off dst ~dst_off len] produces the 464 + key stream into [dst] at [dst_off], and then xors it with [src] at 465 + [src_off]. 266 466 267 - It is computed as [C.add ctr (ceil (len msg / block_size))]. Note that 268 - if [len msg1 = k * block_size], 467 + @raise Invalid_argument if [dst_off < 0 || Bytes.length dst - dst_off < len]. 468 + @raise Invalid_argument if [src_off < 0 || String.length src - src_off < len]. *) 469 + 470 + val decrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 471 + bytes -> dst_off:int -> int -> unit 472 + (** [decrypt_into] is {!encrypt_into}. *) 473 + 474 + (**/**) 475 + val unsafe_stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit 476 + (** [unsafe_stream_into] is {!stream_into}, but without bounds checks. 477 + 478 + This may cause memory issues if the invariant is violated: 479 + {ul 480 + {- [off >= 0 && Bytes.length buf - off >= len].}} *) 269 481 270 - {[encrypt ~ctr msg1 || encrypt ~ctr:(next_ctr ~ctr msg1) msg2 271 - == encrypt ~ctr (msg1 || msg2)]} 482 + val unsafe_encrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 483 + bytes -> dst_off:int -> int -> unit 484 + (** [unsafe_encrypt_into] is {!encrypt_into}, but without bounds checks. 272 485 273 - *) 486 + This may cause memory issues if an invariant is violated: 487 + {ul 488 + {- [dst_off >= 0 && Bytes.length dst - dst_off >= len],} 489 + {- [src_off >= 0 && String.length src - src_off >= len].}} *) 274 490 275 - val ctr_of_octets : string -> ctr 276 - (** [ctr_of_octets buf] converts the value of [buf] into a counter. *) 491 + val unsafe_decrypt_into : key:key -> ctr:ctr -> string -> src_off:int -> 492 + bytes -> dst_off:int -> int -> unit 493 + (** [unsafe_decrypt_into] is {!unsafe_encrypt_into}. *) 494 + (**/**) 277 495 end 278 496 279 497 (** {e Galois/Counter Mode}. *)

+6 -6

src/native.ml

··· 20 20 21 21 module Poly1305 = struct 22 22 external init : bytes -> string -> unit = "mc_poly1305_init" [@@noalloc] 23 - external update : bytes -> string -> int -> unit = "mc_poly1305_update" [@@noalloc] 24 - external finalize : bytes -> bytes -> unit = "mc_poly1305_finalize" [@@noalloc] 23 + external update : bytes -> string -> int -> int -> unit = "mc_poly1305_update" [@@noalloc] 24 + external finalize : bytes -> bytes -> int -> unit = "mc_poly1305_finalize" [@@noalloc] 25 25 external ctx_size : unit -> int = "mc_poly1305_ctx_size" [@@noalloc] 26 26 external mac_size : unit -> int = "mc_poly1305_mac_size" [@@noalloc] 27 27 end ··· 29 29 module GHASH = struct 30 30 external keysize : unit -> int = "mc_ghash_key_size" [@@noalloc] 31 31 external keyinit : string -> bytes -> unit = "mc_ghash_init_key" [@@noalloc] 32 - external ghash : string -> bytes -> string -> int -> unit = "mc_ghash" [@@noalloc] 32 + external ghash : string -> bytes -> string -> int -> int -> unit = "mc_ghash" [@@noalloc] 33 33 external mode : unit -> int = "mc_ghash_mode" [@@noalloc] 34 34 end 35 35 ··· 37 37 * Unsolved: bounds-checked XORs are slowing things down considerably... *) 38 38 external xor_into_bytes : string -> int -> bytes -> int -> int -> unit = "mc_xor_into_bytes" [@@noalloc] 39 39 40 - external count8be : bytes -> bytes -> blocks:int -> unit = "mc_count_8_be" [@@noalloc] 41 - external count16be : bytes -> bytes -> blocks:int -> unit = "mc_count_16_be" [@@noalloc] 42 - external count16be4 : bytes -> bytes -> blocks:int -> unit = "mc_count_16_be_4" [@@noalloc] 40 + external count8be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit = "mc_count_8_be" [@@noalloc] 41 + external count16be : ctr:bytes -> bytes -> off:int -> blocks:int -> unit = "mc_count_16_be" [@@noalloc] 42 + external count16be4 : ctr:bytes -> bytes -> off:int -> blocks:int -> unit = "mc_count_16_be_4" [@@noalloc] 43 43 44 44 external misc_mode : unit -> int = "mc_misc_mode" [@@noalloc] 45 45

+2 -2

src/native/ghash_ctmul.c

··· 290 290 return Val_unit; 291 291 } 292 292 293 - CAMLprim value mc_ghash_generic (value m, value hash, value src, value len) { 294 - br_ghash_ctmul(Bp_val(hash), Bp_val(m), _st_uint8(src), Int_val(len)); 293 + CAMLprim value mc_ghash_generic (value m, value hash, value src, value off, value len) { 294 + br_ghash_ctmul(Bp_val(hash), Bp_val(m), _st_uint8_off(src, off), Int_val(len)); 295 295 return Val_unit; 296 296 } 297 297

+2 -2

src/native/ghash_generic.c

··· 101 101 } 102 102 103 103 CAMLprim value 104 - mc_ghash_generic (value m, value hash, value src, value len) { 104 + mc_ghash_generic (value m, value hash, value src, value off, value len) { 105 105 __ghash ((__uint128_t *) Bp_val (m), (uint64_t *) Bp_val (hash), 106 - _st_uint8 (src), Int_val (len) ); 106 + _st_uint8_off (src, off), Int_val (len) ); 107 107 return Val_unit; 108 108 } 109 109

+3 -3

src/native/ghash_pclmul.c

··· 204 204 } 205 205 206 206 CAMLprim value 207 - mc_ghash (value k, value hash, value src, value len) { 207 + mc_ghash (value k, value hash, value src, value off, value len) { 208 208 _mc_switch_accel(pclmul, 209 - mc_ghash_generic(k, hash, src, len), 209 + mc_ghash_generic(k, hash, src, off, len), 210 210 __ghash ( (__m128i *) Bp_val (k), (__m128i *) Bp_val (hash), 211 - (__m128i *) _st_uint8 (src), Int_val (len) )) 211 + (__m128i *) _st_uint8_off (src, off), Int_val (len) )) 212 212 return Val_unit; 213 213 } 214 214

+2 -2

src/native/mirage_crypto.h

··· 105 105 CAMLprim value mc_ghash_init_key_generic (value key, value m); 106 106 107 107 CAMLprim value 108 - mc_ghash_generic (value m, value hash, value src, value len); 108 + mc_ghash_generic (value m, value hash, value src, value off, value len); 109 109 110 110 CAMLprim value 111 111 mc_xor_into_generic (value b1, value off1, value b2, value off2, value n); ··· 114 114 mc_xor_into_bytes_generic (value b1, value off1, value b2, value off2, value n); 115 115 116 116 CAMLprim value 117 - mc_count_16_be_4_generic (value ctr, value dst, value blocks); 117 + mc_count_16_be_4_generic (value ctr, value dst, value off, value blocks); 118 118 119 119 #endif /* H__MIRAGE_CRYPTO */

+2 -2

src/native/misc.c

··· 60 60 } 61 61 62 62 #define __export_counter(name, f) \ 63 - CAMLprim value name (value ctr, value dst, value blocks) { \ 63 + CAMLprim value name (value ctr, value dst, value off, value blocks) { \ 64 64 f ( (uint64_t*) Bp_val (ctr), \ 65 - (uint64_t*) _bp_uint8 (dst), Long_val (blocks) ); \ 65 + (uint64_t*) _bp_uint8_off (dst, off), Long_val (blocks) ); \ 66 66 return Val_unit; \ 67 67 } 68 68

+4 -4

src/native/misc_sse.c

··· 48 48 } 49 49 50 50 #define __export_counter(name, f) \ 51 - CAMLprim value name (value ctr, value dst, value blocks) { \ 52 - _mc_switch_accel(ssse3, \ 53 - name##_generic (ctr, dst, blocks), \ 51 + CAMLprim value name (value ctr, value dst, value off, value blocks) { \ 52 + _mc_switch_accel(ssse3, \ 53 + name##_generic (ctr, dst, off, blocks), \ 54 54 f ( (uint64_t*) Bp_val (ctr), \ 55 - (uint64_t*) _bp_uint8 (dst), Long_val (blocks) )) \ 55 + (uint64_t*) _bp_uint8_off (dst, off), Long_val (blocks) )) \ 56 56 return Val_unit; \ 57 57 } 58 58

+4 -4

src/native/poly1305-donna.c

··· 59 59 return Val_unit; 60 60 } 61 61 62 - CAMLprim value mc_poly1305_update (value ctx, value buf, value len) { 63 - poly1305_update ((poly1305_context *) Bytes_val(ctx), _st_uint8(buf), Int_val(len)); 62 + CAMLprim value mc_poly1305_update (value ctx, value buf, value off, value len) { 63 + poly1305_update ((poly1305_context *) Bytes_val(ctx), _st_uint8_off(buf, off), Int_val(len)); 64 64 return Val_unit; 65 65 } 66 66 67 - CAMLprim value mc_poly1305_finalize (value ctx, value mac) { 68 - poly1305_finish ((poly1305_context *) Bytes_val(ctx), Bytes_val(mac)); 67 + CAMLprim value mc_poly1305_finalize (value ctx, value mac, value off) { 68 + poly1305_finish ((poly1305_context *) Bytes_val(ctx), _bp_uint8_off(mac, off)); 69 69 return Val_unit; 70 70 } 71 71

+24 -6

src/poly1305.ml

··· 11 11 12 12 val mac : key:string -> string -> string 13 13 val maci : key:string -> string iter -> string 14 - val macl : key:string -> string list -> string 14 + val mac_into : key:string -> (string * int * int) list -> bytes -> dst_off:int -> unit 15 + val unsafe_mac_into : key:string -> (string * int * int) list -> bytes -> dst_off:int -> unit 15 16 end 16 17 17 18 module It : S = struct ··· 31 32 ctx 32 33 33 34 let update ctx data = 34 - P.update ctx data (String.length data) 35 + P.update ctx data 0 (String.length data) 35 36 36 37 let feed ctx cs = 37 38 let t = dup ctx in ··· 45 46 46 47 let final ctx = 47 48 let res = Bytes.create mac_size in 48 - P.finalize ctx res; 49 + P.finalize ctx res 0; 49 50 Bytes.unsafe_to_string res 50 51 51 52 let get ctx = final (dup ctx) ··· 54 55 55 56 let maci ~key iter = feedi (empty ~key) iter |> final 56 57 57 - let macl ~key datas = 58 + let unsafe_mac_into ~key datas dst ~dst_off = 58 59 let ctx = empty ~key in 59 - List.iter (update ctx) datas; 60 - final ctx 60 + List.iter (fun (d, off, len) -> P.update ctx d off len) datas; 61 + P.finalize ctx dst dst_off 62 + 63 + let mac_into ~key datas dst ~dst_off = 64 + if Bytes.length dst - dst_off < mac_size then 65 + Uncommon.invalid_arg "Poly1305: dst length %u - off %u < len %u" 66 + (Bytes.length dst) dst_off mac_size; 67 + if dst_off < 0 then 68 + Uncommon.invalid_arg "Poly1305: dst_off %u < 0" dst_off; 69 + let ctx = empty ~key in 70 + List.iter (fun (d, off, len) -> 71 + if off < 0 then 72 + Uncommon.invalid_arg "Poly1305: d off %u < 0" off; 73 + if String.length d - off < len then 74 + Uncommon.invalid_arg "Poly1305: d length %u - off %u < len %u" 75 + (String.length d) off len; 76 + P.update ctx d off len) 77 + datas; 78 + P.finalize ctx dst dst_off 61 79 end