forked from
gazagnaire.org/ocaml-crypto
upstream: https://github.com/mirage/mirage-crypto
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