upstream: github.com/robur-coop/kdf
1external salsa_core : int -> string -> bytes -> unit = "caml_salsa_core"
2[@@noalloc]
3
4let salsa20_core count i =
5 let l = 64 in
6 if String.length i <> l then invalid_arg "input must be 16 blocks of 32 bits"
7 else
8 let o = Bytes.create l in
9 salsa_core count i o;
10 Bytes.unsafe_to_string o
11
12let salsa20_8_core i = salsa20_core 4 i
13
14let block_mix b r =
15 let b' = Bytes.create (String.length b) in
16 let x = Bytes.create 64 in
17 Bytes.unsafe_blit_string b (((2 * r) - 1) * 64) x 0 64;
18 for i = 0 to (2 * r) - 1 do
19 let b_i = Bytes.unsafe_of_string (String.sub b (i * 64) 64) in
20 Crypto.Uncommon.unsafe_xor_into (Bytes.unsafe_to_string x) ~src_off:0 b_i
21 ~dst_off:0 64;
22 Bytes.unsafe_blit_string
23 (salsa20_8_core (Bytes.unsafe_to_string b_i))
24 0 x 0 64;
25 let offset = ((i mod 2) lsl max 0 ((r / 2) - 1)) + (i / 2) in
26 Bytes.blit x 0 b' (offset * 64) 64
27 done;
28 b'
29
30let ro_mix b ~r ~n =
31 let blen = r * 128 in
32 let x = ref (Bytes.copy b) in
33 let v = Bytes.create (blen * n) in
34 for i = 0 to n - 1 do
35 Bytes.unsafe_blit !x 0 v (blen * i) blen;
36 x := block_mix (Bytes.unsafe_to_string !x) r
37 done;
38 for _ = 0 to n - 1 do
39 let integerify x =
40 let k = Bytes.get_int32_le x ((128 * r) - 64) in
41 let n' = n - 1 in
42 Int32.(to_int (logand k (of_int n')))
43 in
44 let j = integerify !x in
45 Crypto.Uncommon.unsafe_xor_into (Bytes.unsafe_to_string v)
46 ~src_off:(blen * j) !x ~dst_off:0 blen;
47 x := block_mix (Bytes.unsafe_to_string !x) r
48 done;
49 !x
50
51let derive ~password ~salt ~n ~r ~p ~dk_len =
52 let is_power_of_2 x = x land (x - 1) = 0 in
53 if n <= 1 then invalid_arg "n must be larger than 1"
54 else if not (is_power_of_2 n) then invalid_arg "n must be a power of 2"
55 else if p <= 0 then invalid_arg "p must be a positive integer"
56 else if p > Int64.to_int (Int64.div 0xffffffffL 4L) / r then
57 invalid_arg "p too big"
58 else if dk_len <= 0l then
59 invalid_arg "derived key length must be a positive integer";
60 let rec partition b blocks = function
61 | 0 -> blocks
62 | i ->
63 let off = (i - 1) * r * 128 in
64 let block = Bytes.unsafe_of_string (String.sub b off (r * 128)) in
65 partition b (block :: blocks) (i - 1)
66 in
67 let blen = Int32.of_int (128 * r * p) in
68 let dk = Pbkdf.pbkdf2 ~prf:`SHA256 ~password ~salt ~count:1 ~dk_len:blen in
69 let b = partition dk [] p in
70 let b' = List.map (ro_mix ~r ~n) b in
71 let salt = String.concat "" (List.map Bytes.unsafe_to_string b') in
72 Pbkdf.pbkdf2 ~prf:`SHA256 ~password ~salt ~count:1 ~dk_len