upstream: https://github.com/mirage/mirage-crypto
at main 177 lines 6.4 kB view raw
1(* Based on https://github.com/abeaumont/ocaml-chacha.git *) 2 3open Uncommon 4 5let block = 64 6 7type key = string 8 9let of_secret a = a 10 11let chacha20_block state idx key_stream = 12 Native.Chacha.round 10 state key_stream idx 13 14let init ctr ~key ~nonce = 15 let ctr_off = 48 in 16 let set_ctr32 b v = Bytes.set_int32_le b ctr_off v 17 and set_ctr64 b v = Bytes.set_int64_le b ctr_off v in 18 let inc32 b = set_ctr32 b (Int32.add (Bytes.get_int32_le b ctr_off) 1l) 19 and inc64 b = set_ctr64 b (Int64.add (Bytes.get_int64_le b ctr_off) 1L) in 20 let s, key, init_ctr, nonce_off, inc = 21 match 22 (String.length key, String.length nonce, Int64.shift_right ctr 32 = 0L) 23 with 24 | 32, 12, true -> 25 let ctr = Int64.to_int32 ctr in 26 ("expand 32-byte k", key, (fun b -> set_ctr32 b ctr), 52, inc32) 27 | 32, 12, false -> 28 invalid_arg "Counter too big for IETF mode (32 bit counter)" 29 | 32, 8, _ -> 30 ("expand 32-byte k", key, (fun b -> set_ctr64 b ctr), 56, inc64) 31 | 16, 8, _ -> 32 let k = key ^ key in 33 ("expand 16-byte k", k, (fun b -> set_ctr64 b ctr), 56, inc64) 34 | _ -> 35 invalid_arg 36 "Valid parameters are nonce 12 bytes and key 32 bytes (counter 32 \ 37 bit), or nonce 8 byte and key 16 or 32 bytes (counter 64 bit)." 38 in 39 let state = Bytes.create block in 40 Bytes.unsafe_blit_string s 0 state 0 16; 41 Bytes.unsafe_blit_string key 0 state 16 32; 42 init_ctr state; 43 Bytes.unsafe_blit_string nonce 0 state nonce_off (String.length nonce); 44 (state, inc) 45 46let crypt_into ~key ~nonce ~ctr src ~src_off dst ~dst_off len = 47 let state, inc = init ctr ~key ~nonce in 48 let block_count = len // block in 49 let last_len = 50 let last = len mod block in 51 if last = 0 then block else last 52 in 53 let rec loop i = function 54 | 0 -> () 55 | 1 -> 56 if last_len = block then begin 57 chacha20_block state (dst_off + i) dst; 58 Native.xor_into_bytes src (src_off + i) dst (dst_off + i) block 59 end 60 else begin 61 let buf = Bytes.create block in 62 chacha20_block state 0 buf; 63 Native.xor_into_bytes src (src_off + i) buf 0 last_len; 64 Bytes.unsafe_blit buf 0 dst (dst_off + i) last_len 65 end 66 | n -> 67 chacha20_block state (dst_off + i) dst; 68 Native.xor_into_bytes src (src_off + i) dst (dst_off + i) block; 69 inc state; 70 (loop [@tailcall]) (i + block) (n - 1) 71 in 72 loop 0 block_count 73 74let crypt ~key ~nonce ?(ctr = 0L) data = 75 let l = String.length data in 76 let res = Bytes.create l in 77 crypt_into ~key ~nonce ~ctr data ~src_off:0 res ~dst_off:0 l; 78 Bytes.unsafe_to_string res 79 80module P = Poly1305.It 81 82let tag_size = P.mac_size 83 84let generate_poly1305_key ~key ~nonce = 85 crypt ~key ~nonce (String.make 32 '\000') 86 87let mac_into ~key ~adata src ~src_off len dst ~dst_off = 88 let pad16 l = 89 let len = l mod 16 in 90 if len = 0 then "" else String.make (16 - len) '\000' 91 and len_buf = 92 let data = Bytes.create 16 in 93 Bytes.set_int64_le data 0 (Int64.of_int (String.length adata)); 94 Bytes.set_int64_le data 8 (Int64.of_int len); 95 Bytes.unsafe_to_string data 96 in 97 let p1 = pad16 (String.length adata) and p2 = pad16 len in 98 P.unsafe_mac_into ~key 99 [ 100 (adata, 0, String.length adata); 101 (p1, 0, String.length p1); 102 (src, src_off, len); 103 (p2, 0, String.length p2); 104 (len_buf, 0, String.length len_buf); 105 ] 106 dst ~dst_off 107 108let unsafe_authenticate_encrypt_into ~key ~nonce ?(adata = "") src ~src_off dst 109 ~dst_off ~tag_off len = 110 let poly1305_key = generate_poly1305_key ~key ~nonce in 111 crypt_into ~key ~nonce ~ctr:1L src ~src_off dst ~dst_off len; 112 mac_into ~key:poly1305_key ~adata 113 (Bytes.unsafe_to_string dst) 114 ~src_off:dst_off len dst ~dst_off:tag_off 115 116let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off 117 ~tag_off len = 118 if String.length src - src_off < len then 119 invalid_arg "Chacha20: src length %u - src_off %u < len %u" 120 (String.length src) src_off len; 121 if Bytes.length dst - dst_off < len then 122 invalid_arg "Chacha20: dst length %u - dst_off %u < len %u" 123 (Bytes.length dst) dst_off len; 124 if Bytes.length dst - tag_off < tag_size then 125 invalid_arg "Chacha20: dst length %u - tag_off %u < tag_size %u" 126 (Bytes.length dst) tag_off tag_size; 127 unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off 128 ~tag_off len 129 130let authenticate_encrypt ~key ~nonce ?adata data = 131 let l = String.length data in 132 let dst = Bytes.create (l + tag_size) in 133 unsafe_authenticate_encrypt_into ~key ~nonce ?adata data ~src_off:0 dst 134 ~dst_off:0 ~tag_off:l l; 135 Bytes.unsafe_to_string dst 136 137let authenticate_encrypt_tag ~key ~nonce ?adata data = 138 let r = authenticate_encrypt ~key ~nonce ?adata data in 139 ( String.sub r 0 (String.length data), 140 String.sub r (String.length data) tag_size ) 141 142let unsafe_authenticate_decrypt_into ~key ~nonce ?(adata = "") src ~src_off 143 ~tag_off dst ~dst_off len = 144 let poly1305_key = generate_poly1305_key ~key ~nonce in 145 let ctag = Bytes.create tag_size in 146 mac_into ~key:poly1305_key ~adata src ~src_off len ctag ~dst_off:0; 147 crypt_into ~key ~nonce ~ctr:1L src ~src_off dst ~dst_off len; 148 Eqaf.equal (String.sub src tag_off tag_size) (Bytes.unsafe_to_string ctag) 149 150let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst 151 ~dst_off len = 152 if String.length src - src_off < len then 153 invalid_arg "Chacha20: src length %u - src_off %u < len %u" 154 (String.length src) src_off len; 155 if Bytes.length dst - dst_off < len then 156 invalid_arg "Chacha20: dst length %u - dst_off %u < len %u" 157 (Bytes.length dst) dst_off len; 158 if String.length src - tag_off < tag_size then 159 invalid_arg "Chacha20: src length %u - tag_off %u < tag_size %u" 160 (String.length src) tag_off tag_size; 161 unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst 162 ~dst_off len 163 164let authenticate_decrypt ~key ~nonce ?adata data = 165 if String.length data < tag_size then None 166 else 167 let l = String.length data - tag_size in 168 let r = Bytes.create l in 169 if 170 unsafe_authenticate_decrypt_into ~key ~nonce ?adata data ~src_off:0 171 ~tag_off:l r ~dst_off:0 l 172 then Some (Bytes.unsafe_to_string r) 173 else None 174 175let authenticate_decrypt_tag ~key ~nonce ?adata ~tag data = 176 let cdata = data ^ tag in 177 authenticate_decrypt ~key ~nonce ?adata cdata