anil.recoil.org
forked from
gazagnaire.org/ocaml-crypto
upstream: https://github.com/mirage/mirage-crypto
1open Uncommon
2
3module Block = struct
4 module type Core = sig
5 type ekey
6 type dkey
7
8 val of_secret : string -> ekey * dkey
9 val e_of_secret : string -> ekey
10 val d_of_secret : string -> dkey
11 val key : int array
12 val block : int
13
14 (* XXX currently unsafe point *)
15 val encrypt :
16 key:ekey -> blocks:int -> string -> int -> bytes -> int -> unit
17
18 val decrypt :
19 key:dkey -> blocks:int -> string -> int -> bytes -> int -> unit
20 end
21
22 module type ECB = sig
23 type key
24
25 val of_secret : string -> key
26 val key_sizes : int array
27 val block_size : int
28 val encrypt : key:key -> string -> string
29 val decrypt : key:key -> string -> string
30
31 val encrypt_into :
32 key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
33
34 val decrypt_into :
35 key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
36
37 val unsafe_encrypt_into :
38 key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
39
40 val unsafe_decrypt_into :
41 key:key -> string -> src_off:int -> bytes -> dst_off:int -> int -> unit
42 end
43
44 module type CBC = sig
45 type key
46
47 val of_secret : string -> key
48 val key_sizes : int array
49 val block_size : int
50 val encrypt : key:key -> iv:string -> string -> string
51 val decrypt : key:key -> iv:string -> string -> string
52 val next_iv : ?off:int -> string -> iv:string -> string
53
54 val encrypt_into :
55 key:key ->
56 iv:string ->
57 string ->
58 src_off:int ->
59 bytes ->
60 dst_off:int ->
61 int ->
62 unit
63
64 val decrypt_into :
65 key:key ->
66 iv:string ->
67 string ->
68 src_off:int ->
69 bytes ->
70 dst_off:int ->
71 int ->
72 unit
73
74 val unsafe_encrypt_into :
75 key:key ->
76 iv:string ->
77 string ->
78 src_off:int ->
79 bytes ->
80 dst_off:int ->
81 int ->
82 unit
83
84 val unsafe_decrypt_into :
85 key:key ->
86 iv:string ->
87 string ->
88 src_off:int ->
89 bytes ->
90 dst_off:int ->
91 int ->
92 unit
93
94 val unsafe_encrypt_into_inplace :
95 key:key -> iv:string -> bytes -> dst_off:int -> int -> unit
96 end
97
98 module type CTR = sig
99 type key
100
101 val of_secret : string -> key
102 val key_sizes : int array
103 val block_size : int
104
105 type ctr
106
107 val add_ctr : ctr -> int64 -> ctr
108 val next_ctr : ?off:int -> string -> ctr:ctr -> ctr
109 val ctr_of_octets : string -> ctr
110 val stream : key:key -> ctr:ctr -> int -> string
111 val encrypt : key:key -> ctr:ctr -> string -> string
112 val decrypt : key:key -> ctr:ctr -> string -> string
113 val stream_into : key:key -> ctr:ctr -> bytes -> off:int -> int -> unit
114
115 val encrypt_into :
116 key:key ->
117 ctr:ctr ->
118 string ->
119 src_off:int ->
120 bytes ->
121 dst_off:int ->
122 int ->
123 unit
124
125 val decrypt_into :
126 key:key ->
127 ctr:ctr ->
128 string ->
129 src_off:int ->
130 bytes ->
131 dst_off:int ->
132 int ->
133 unit
134
135 val unsafe_stream_into :
136 key:key -> ctr:ctr -> bytes -> off:int -> int -> unit
137
138 val unsafe_encrypt_into :
139 key:key ->
140 ctr:ctr ->
141 string ->
142 src_off:int ->
143 bytes ->
144 dst_off:int ->
145 int ->
146 unit
147
148 val unsafe_decrypt_into :
149 key:key ->
150 ctr:ctr ->
151 string ->
152 src_off:int ->
153 bytes ->
154 dst_off:int ->
155 int ->
156 unit
157 end
158
159 module type GCM = sig
160 include Aead.AEAD
161
162 val key_sizes : int array
163 val block_size : int
164 end
165
166 module type CCM16 = sig
167 include Aead.AEAD
168
169 val key_sizes : int array
170 val block_size : int
171 end
172end
173
174module Counters = struct
175 module type S = sig
176 type ctr
177
178 val size : int
179 val add : ctr -> int64 -> ctr
180 val of_octets : string -> ctr
181 val unsafe_count_into : ctr -> bytes -> off:int -> blocks:int -> unit
182 end
183
184 module C64be = struct
185 type ctr = int64
186
187 let size = 8
188 let of_octets cs = String.get_int64_be cs 0
189 let add = Int64.add
190
191 let unsafe_count_into t buf ~off ~blocks =
192 let ctr = Bytes.create 8 in
193 Bytes.set_int64_be ctr 0 t;
194 Native.count8be ~ctr buf ~off ~blocks
195 end
196
197 module C128be = struct
198 type ctr = int64 * int64
199
200 let size = 16
201
202 let of_octets cs =
203 let buf = Bytes.unsafe_of_string cs in
204 Bytes.(get_int64_be buf 0, get_int64_be buf 8)
205
206 let add (w1, w0) n =
207 let w0' = Int64.add w0 n in
208 let flip = if Int64.logxor w0 w0' < 0L then w0' > w0 else w0' < w0 in
209 ((if flip then Int64.succ w1 else w1), w0')
210
211 let unsafe_count_into (w1, w0) buf ~off ~blocks =
212 let ctr = Bytes.create 16 in
213 Bytes.set_int64_be ctr 0 w1;
214 Bytes.set_int64_be ctr 8 w0;
215 Native.count16be ~ctr buf ~off ~blocks
216 end
217
218 module C128be32 = struct
219 include C128be
220
221 let add (w1, w0) n =
222 let hi = 0xffffffff00000000L and lo = 0x00000000ffffffffL in
223 (w1, Int64.(logor (logand hi w0) (add n w0 |> logand lo)))
224
225 let unsafe_count_into (w1, w0) buf ~off ~blocks =
226 let ctr = Bytes.create 16 in
227 Bytes.set_int64_be ctr 0 w1;
228 Bytes.set_int64_be ctr 8 w0;
229 Native.count16be4 ~ctr buf ~off ~blocks
230 end
231end
232
233let check_offset ~tag ~buf ~off ~len actual_len =
234 if off < 0 then invalid_arg "%s: %s off %u < 0" tag buf off;
235 if actual_len - off < len then
236 invalid_arg "%s: %s length %u - off %u < len %u" tag buf actual_len off len
237[@@inline]
238
239module Modes = struct
240 module ECB_of (Core : Block.Core) : Block.ECB = struct
241 type key = Core.ekey * Core.dkey
242
243 let key_sizes, block_size = Core.(key, block)
244 let of_secret = Core.of_secret
245
246 let unsafe_ecb xform key src src_off dst dst_off len =
247 xform ~key ~blocks:(len / block_size) src src_off dst dst_off
248
249 let ecb xform key src src_off dst dst_off len =
250 if len mod block_size <> 0 then
251 invalid_arg "ECB: length %u not of block size" len;
252 check_offset ~tag:"ECB" ~buf:"src" ~off:src_off ~len (String.length src);
253 check_offset ~tag:"ECB" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
254 unsafe_ecb xform key src src_off dst dst_off len
255
256 let encrypt_into ~key:(key, _) src ~src_off dst ~dst_off len =
257 ecb Core.encrypt key src src_off dst dst_off len
258
259 let unsafe_encrypt_into ~key:(key, _) src ~src_off dst ~dst_off len =
260 unsafe_ecb Core.encrypt key src src_off dst dst_off len
261
262 let decrypt_into ~key:(_, key) src ~src_off dst ~dst_off len =
263 ecb Core.decrypt key src src_off dst dst_off len
264
265 let unsafe_decrypt_into ~key:(_, key) src ~src_off dst ~dst_off len =
266 unsafe_ecb Core.decrypt key src src_off dst dst_off len
267
268 let encrypt ~key src =
269 let len = String.length src in
270 let dst = Bytes.create len in
271 encrypt_into ~key src ~src_off:0 dst ~dst_off:0 len;
272 Bytes.unsafe_to_string dst
273
274 let decrypt ~key src =
275 let len = String.length src in
276 let dst = Bytes.create len in
277 decrypt_into ~key src ~src_off:0 dst ~dst_off:0 len;
278 Bytes.unsafe_to_string dst
279 end
280
281 module CBC_of (Core : Block.Core) : Block.CBC = struct
282 type key = Core.ekey * Core.dkey
283
284 let key_sizes, block_size = Core.(key, block)
285 let block = block_size
286 let of_secret = Core.of_secret
287
288 let check_block_size ~iv len =
289 if String.length iv <> block then
290 invalid_arg "CBC: IV length %u not of block size" (String.length iv);
291 if len mod block <> 0 then
292 invalid_arg "CBC: argument length %u not of block size" len
293 [@@inline]
294
295 let next_iv ?(off = 0) cs ~iv =
296 check_block_size ~iv (String.length cs - off);
297 if String.length cs > off then
298 String.sub cs (String.length cs - block_size) block_size
299 else iv
300
301 let unsafe_encrypt_into_inplace ~key:(key, _) ~iv dst ~dst_off len =
302 let rec loop iv iv_i dst_i = function
303 | 0 -> ()
304 | b ->
305 Native.xor_into_bytes iv iv_i dst dst_i block;
306 Core.encrypt ~key ~blocks:1
307 (Bytes.unsafe_to_string dst)
308 dst_i dst dst_i;
309 (loop [@tailcall])
310 (Bytes.unsafe_to_string dst)
311 dst_i (dst_i + block) (b - 1)
312 in
313 loop iv 0 dst_off (len / block)
314
315 let unsafe_encrypt_into ~key ~iv src ~src_off dst ~dst_off len =
316 Bytes.unsafe_blit_string src src_off dst dst_off len;
317 unsafe_encrypt_into_inplace ~key ~iv dst ~dst_off len
318
319 let encrypt_into ~key ~iv src ~src_off dst ~dst_off len =
320 check_block_size ~iv len;
321 check_offset ~tag:"CBC" ~buf:"src" ~off:src_off ~len (String.length src);
322 check_offset ~tag:"CBC" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
323 unsafe_encrypt_into ~key ~iv src ~src_off dst ~dst_off len
324
325 let encrypt ~key ~iv src =
326 let dst = Bytes.create (String.length src) in
327 encrypt_into ~key ~iv src ~src_off:0 dst ~dst_off:0 (String.length src);
328 Bytes.unsafe_to_string dst
329
330 let unsafe_decrypt_into ~key:(_, key) ~iv src ~src_off dst ~dst_off len =
331 let b = len / block in
332 if b > 0 then begin
333 Core.decrypt ~key ~blocks:b src src_off dst dst_off;
334 Native.xor_into_bytes iv 0 dst dst_off block;
335 Native.xor_into_bytes src src_off dst (dst_off + block) ((b - 1) * block)
336 end
337
338 let decrypt_into ~key ~iv src ~src_off dst ~dst_off len =
339 check_block_size ~iv len;
340 check_offset ~tag:"CBC" ~buf:"src" ~off:src_off ~len (String.length src);
341 check_offset ~tag:"CBC" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
342 unsafe_decrypt_into ~key ~iv src ~src_off dst ~dst_off len
343
344 let decrypt ~key ~iv src =
345 let len = String.length src in
346 let msg = Bytes.create len in
347 decrypt_into ~key ~iv src ~src_off:0 msg ~dst_off:0 len;
348 Bytes.unsafe_to_string msg
349 end
350
351 module CTR_of (Core : Block.Core) (Ctr : Counters.S) :
352 Block.CTR with type key = Core.ekey and type ctr = Ctr.ctr = struct
353 (* FIXME: CTR has more room for speedups. Like stitching. *)
354
355 assert (Core.block = Ctr.size);;
356
357 type key = Core.ekey
358 type ctr = Ctr.ctr
359
360 let key_sizes, block_size = Core.(key, block)
361 let of_secret = Core.e_of_secret
362
363 let unsafe_stream_into ~key ~ctr buf ~off len =
364 let blocks = imax 0 len / block_size in
365 Ctr.unsafe_count_into ctr buf ~off ~blocks;
366 Core.encrypt ~key ~blocks (Bytes.unsafe_to_string buf) off buf off;
367 let slack = imax 0 len mod block_size in
368 if slack <> 0 then begin
369 let buf' = Bytes.create block_size in
370 let ctr = Ctr.add ctr (Int64.of_int blocks) in
371 Ctr.unsafe_count_into ctr buf' ~off:0 ~blocks:1;
372 Core.encrypt ~key ~blocks:1 (Bytes.unsafe_to_string buf') 0 buf' 0;
373 Bytes.unsafe_blit buf' 0 buf (off + (blocks * block_size)) slack
374 end
375
376 let stream_into ~key ~ctr buf ~off len =
377 check_offset ~tag:"CTR" ~buf:"buf" ~off ~len (Bytes.length buf);
378 unsafe_stream_into ~key ~ctr buf ~off len
379
380 let stream ~key ~ctr n =
381 let buf = Bytes.create n in
382 unsafe_stream_into ~key ~ctr buf ~off:0 n;
383 Bytes.unsafe_to_string buf
384
385 let unsafe_encrypt_into ~key ~ctr src ~src_off dst ~dst_off len =
386 unsafe_stream_into ~key ~ctr dst ~off:dst_off len;
387 Uncommon.unsafe_xor_into src ~src_off dst ~dst_off len
388
389 let encrypt_into ~key ~ctr src ~src_off dst ~dst_off len =
390 check_offset ~tag:"CTR" ~buf:"src" ~off:src_off ~len (String.length src);
391 check_offset ~tag:"CTR" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
392 unsafe_encrypt_into ~key ~ctr src ~src_off dst ~dst_off len
393
394 let encrypt ~key ~ctr src =
395 let len = String.length src in
396 let dst = Bytes.create len in
397 encrypt_into ~key ~ctr src ~src_off:0 dst ~dst_off:0 len;
398 Bytes.unsafe_to_string dst
399
400 let decrypt = encrypt
401 let decrypt_into = encrypt_into
402 let unsafe_decrypt_into = unsafe_encrypt_into
403 let add_ctr = Ctr.add
404
405 let next_ctr ?(off = 0) msg ~ctr =
406 add_ctr ctr (Int64.of_int @@ ((String.length msg - off) // block_size))
407
408 let ctr_of_octets = Ctr.of_octets
409 end
410
411 module GHASH : sig
412 type key
413
414 val derive : string -> key
415 val digesti : key:key -> string Uncommon.iter -> string
416
417 val digesti_off_len :
418 key:key -> (string * int * int) Uncommon.iter -> string
419
420 val tagsize : int
421 end = struct
422 type key = string
423
424 let keysize = Native.GHASH.keysize ()
425 let tagsize = 16
426
427 let derive cs =
428 assert (String.length cs >= tagsize);
429 let k = Bytes.create keysize in
430 Native.GHASH.keyinit cs k;
431 Bytes.unsafe_to_string k
432
433 let digesti_off_len ~key i =
434 let res = Bytes.make tagsize '\x00' in
435 i (fun (cs, off, len) -> Native.GHASH.ghash key res cs off len);
436 Bytes.unsafe_to_string res
437
438 let digesti ~key i =
439 let res = Bytes.make tagsize '\x00' in
440 i (fun cs -> Native.GHASH.ghash key res cs 0 (String.length cs));
441 Bytes.unsafe_to_string res
442 end
443
444 module GCM_of (C : Block.Core) : Block.GCM = struct
445 assert (C.block = 16);;
446
447 module CTR = CTR_of (C) (Counters.C128be32)
448
449 type key = { key : C.ekey; hkey : GHASH.key }
450
451 let tag_size = GHASH.tagsize
452 let key_sizes, block_size = C.(key, block)
453 let z128 = String.make block_size '\x00'
454
455 let of_secret cs =
456 let h = Bytes.create block_size in
457 let key = C.e_of_secret cs in
458 C.encrypt ~key ~blocks:1 z128 0 h 0;
459 { key; hkey = GHASH.derive (Bytes.unsafe_to_string h) }
460
461 let bits64 cs = Int64.of_int (String.length cs * 8)
462
463 let pack64s a b =
464 let cs = Bytes.create 16 in
465 Bytes.set_int64_be cs 0 a;
466 Bytes.set_int64_be cs 8 b;
467 Bytes.unsafe_to_string cs
468
469 let counter ~hkey nonce =
470 match String.length nonce with
471 | 0 -> invalid_arg "GCM: invalid nonce of length 0"
472 | 12 ->
473 let w1, w2 =
474 (String.get_int64_be nonce 0, String.get_int32_be nonce 8)
475 in
476 (w1, Int64.(shift_left (of_int32 w2) 32 |> add 1L))
477 | _ ->
478 CTR.ctr_of_octets @@ GHASH.digesti ~key:hkey
479 @@ iter2 nonce (pack64s 0L (bits64 nonce))
480
481 let unsafe_tag_into ~key ~hkey ~ctr ?(adata = "") cdata ~off ~len dst
482 ~tag_off =
483 CTR.unsafe_encrypt_into ~key ~ctr
484 (GHASH.digesti_off_len ~key:hkey
485 (iter3
486 (adata, 0, String.length adata)
487 (cdata, off, len)
488 (pack64s (bits64 adata) (Int64.of_int (len * 8)), 0, 16)))
489 ~src_off:0 dst ~dst_off:tag_off tag_size
490
491 let unsafe_authenticate_encrypt_into ~key:{ key; hkey } ~nonce ?adata src
492 ~src_off dst ~dst_off ~tag_off len =
493 let ctr = counter ~hkey nonce in
494 CTR.(
495 unsafe_encrypt_into ~key ~ctr:(add_ctr ctr 1L) src ~src_off dst ~dst_off
496 len);
497 unsafe_tag_into ~key ~hkey ~ctr ?adata
498 (Bytes.unsafe_to_string dst)
499 ~off:dst_off ~len dst ~tag_off
500
501 let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off
502 ~tag_off len =
503 check_offset ~tag:"GCM" ~buf:"src" ~off:src_off ~len (String.length src);
504 check_offset ~tag:"GCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
505 check_offset ~tag:"GCM" ~buf:"dst tag" ~off:tag_off ~len:tag_size
506 (Bytes.length dst);
507 unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst
508 ~dst_off ~tag_off len
509
510 let authenticate_encrypt ~key ~nonce ?adata data =
511 let l = String.length data in
512 let dst = Bytes.create (l + tag_size) in
513 unsafe_authenticate_encrypt_into ~key ~nonce ?adata data ~src_off:0 dst
514 ~dst_off:0 ~tag_off:l l;
515 Bytes.unsafe_to_string dst
516
517 let authenticate_encrypt_tag ~key ~nonce ?adata data =
518 let r = authenticate_encrypt ~key ~nonce ?adata data in
519 ( String.sub r 0 (String.length data),
520 String.sub r (String.length data) tag_size )
521
522 let unsafe_authenticate_decrypt_into ~key:{ key; hkey } ~nonce ?adata src
523 ~src_off ~tag_off dst ~dst_off len =
524 let ctr = counter ~hkey nonce in
525 CTR.(
526 unsafe_encrypt_into ~key ~ctr:(add_ctr ctr 1L) src ~src_off dst ~dst_off
527 len);
528 let ctag = Bytes.create tag_size in
529 unsafe_tag_into ~key ~hkey ~ctr ?adata src ~off:src_off ~len ctag
530 ~tag_off:0;
531 Eqaf.equal (String.sub src tag_off tag_size) (Bytes.unsafe_to_string ctag)
532
533 let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst
534 ~dst_off len =
535 check_offset ~tag:"GCM" ~buf:"src" ~off:src_off ~len (String.length src);
536 check_offset ~tag:"GCM" ~buf:"src tag" ~off:tag_off ~len:tag_size
537 (String.length src);
538 check_offset ~tag:"GCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
539 unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off
540 dst ~dst_off len
541
542 let authenticate_decrypt ~key ~nonce ?adata cdata =
543 if String.length cdata < tag_size then None
544 else
545 let l = String.length cdata - tag_size in
546 let data = Bytes.create l in
547 if
548 unsafe_authenticate_decrypt_into ~key ~nonce ?adata cdata ~src_off:0
549 ~tag_off:l data ~dst_off:0 l
550 then Some (Bytes.unsafe_to_string data)
551 else None
552
553 let authenticate_decrypt_tag ~key ~nonce ?adata ~tag:tag_data cipher =
554 let cdata = cipher ^ tag_data in
555 authenticate_decrypt ~key ~nonce ?adata cdata
556 end
557
558 module CCM16_of (C : Block.Core) : Block.CCM16 = struct
559 assert (C.block = 16);;
560
561 let tag_size = C.block
562
563 type key = C.ekey
564
565 let of_secret sec = C.e_of_secret sec
566 let key_sizes, block_size = C.(key, block)
567
568 let cipher ~key src ~src_off dst ~dst_off =
569 C.encrypt ~key ~blocks:1 src src_off dst dst_off
570
571 let unsafe_authenticate_encrypt_into ~key ~nonce ?(adata = "") src ~src_off
572 dst ~dst_off ~tag_off len =
573 Ccm.unsafe_generation_encryption_into ~cipher ~key ~nonce ~adata src
574 ~src_off dst ~dst_off ~tag_off len
575
576 let valid_nonce nonce =
577 let nsize = String.length nonce in
578 if nsize < 7 || nsize > 13 then
579 invalid_arg "CCM: nonce length not between 7 and 13: %u" nsize
580
581 let authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst ~dst_off
582 ~tag_off len =
583 check_offset ~tag:"CCM" ~buf:"src" ~off:src_off ~len (String.length src);
584 check_offset ~tag:"CCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
585 check_offset ~tag:"CCM" ~buf:"dst tag" ~off:tag_off ~len:tag_size
586 (Bytes.length dst);
587 valid_nonce nonce;
588 unsafe_authenticate_encrypt_into ~key ~nonce ?adata src ~src_off dst
589 ~dst_off ~tag_off len
590
591 let authenticate_encrypt ~key ~nonce ?adata cs =
592 valid_nonce nonce;
593 let l = String.length cs in
594 let dst = Bytes.create (l + tag_size) in
595 unsafe_authenticate_encrypt_into ~key ~nonce ?adata cs ~src_off:0 dst
596 ~dst_off:0 ~tag_off:l l;
597 Bytes.unsafe_to_string dst
598
599 let authenticate_encrypt_tag ~key ~nonce ?adata cs =
600 let res = authenticate_encrypt ~key ~nonce ?adata cs in
601 ( String.sub res 0 (String.length cs),
602 String.sub res (String.length cs) tag_size )
603
604 let unsafe_authenticate_decrypt_into ~key ~nonce ?(adata = "") src ~src_off
605 ~tag_off dst ~dst_off len =
606 Ccm.unsafe_decryption_verification_into ~cipher ~key ~nonce ~adata src
607 ~src_off ~tag_off dst ~dst_off len
608
609 let authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off dst
610 ~dst_off len =
611 check_offset ~tag:"CCM" ~buf:"src" ~off:src_off ~len (String.length src);
612 check_offset ~tag:"CCM" ~buf:"src tag" ~off:tag_off ~len:tag_size
613 (String.length src);
614 check_offset ~tag:"CCM" ~buf:"dst" ~off:dst_off ~len (Bytes.length dst);
615 valid_nonce nonce;
616 unsafe_authenticate_decrypt_into ~key ~nonce ?adata src ~src_off ~tag_off
617 dst ~dst_off len
618
619 let authenticate_decrypt ~key ~nonce ?adata data =
620 if String.length data < tag_size then None
621 else
622 let dlen = String.length data - tag_size in
623 let dst = Bytes.create dlen in
624 if
625 authenticate_decrypt_into ~key ~nonce ?adata data ~src_off:0
626 ~tag_off:dlen dst ~dst_off:0 dlen
627 then Some (Bytes.unsafe_to_string dst)
628 else None
629
630 let authenticate_decrypt_tag ~key ~nonce ?adata ~tag cs =
631 authenticate_decrypt ~key ~nonce ?adata (cs ^ tag)
632 end
633end
634
635module AES = struct
636 module Core : Block.Core = struct
637 let key = [| 16; 24; 32 |]
638 let block = 16
639
640 type ekey = string * int
641 type dkey = string * int
642
643 let of_secret_with init key =
644 let rounds =
645 match String.length key with
646 | 16 | 24 | 32 -> (String.length key / 4) + 6
647 | _ -> invalid_arg "AES.of_secret: key length %u" (String.length key)
648 in
649 let rk = Bytes.create (Native.AES.rk_s rounds) in
650 init key rk rounds;
651 (Bytes.unsafe_to_string rk, rounds)
652
653 let derive_d ?e buf rk rs = Native.AES.derive_d buf rk rs e
654 let e_of_secret = of_secret_with Native.AES.derive_e
655 let d_of_secret = of_secret_with (derive_d ?e:None)
656
657 let of_secret secret =
658 let ((e, _) as ekey) = e_of_secret secret in
659 (ekey, of_secret_with (derive_d ~e) secret)
660
661 (* XXX arg order ocaml<->c slows down *)
662 (* XXX bounds checks *)
663
664 let encrypt ~key:(e, rounds) ~blocks src off1 dst off2 =
665 Native.AES.enc src off1 dst off2 e rounds blocks
666
667 let decrypt ~key:(d, rounds) ~blocks src off1 dst off2 =
668 Native.AES.dec src off1 dst off2 d rounds blocks
669 end
670
671 module ECB = Modes.ECB_of (Core)
672 module CBC = Modes.CBC_of (Core)
673 module CTR = Modes.CTR_of (Core) (Counters.C128be)
674 module GCM = Modes.GCM_of (Core)
675 module CCM16 = Modes.CCM16_of (Core)
676end
677
678module DES = struct
679 module Core : Block.Core = struct
680 let key = [| 24 |]
681 let block = 8
682
683 type ekey = string
684 type dkey = string
685
686 let k_s = Native.DES.k_s ()
687
688 let gen_of_secret ~direction key =
689 if String.length key <> 24 then
690 invalid_arg "DES.of_secret: key length %u" (String.length key);
691 let key = Bytes.of_string key in
692 let keybuf = Bytes.create k_s in
693 Native.DES.des3key key direction keybuf;
694 Bytes.unsafe_to_string keybuf
695
696 let e_of_secret = gen_of_secret ~direction:0
697 let d_of_secret = gen_of_secret ~direction:1
698 let of_secret secret = (e_of_secret secret, d_of_secret secret)
699
700 let encrypt ~key ~blocks src off1 dst off2 =
701 Native.DES.ddes src off1 dst off2 blocks key
702
703 let decrypt = encrypt
704 end
705
706 module ECB = Modes.ECB_of (Core)
707 module CBC = Modes.CBC_of (Core)
708 module CTR = Modes.CTR_of (Core) (Counters.C64be)
709end
710
711let accelerated =
712 let flags =
713 (match Native.misc_mode () with 1 -> [ `XOR ] | _ -> [])
714 @ (match Native.AES.mode () with 1 -> [ `AES ] | _ -> [])
715 @ match Native.GHASH.mode () with 1 -> [ `GHASH ] | _ -> []
716 in
717 flags