1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
(** {1 Exceptions} *)
exception Invalid_count of int
exception Invalid_seed of string
exception Urandom_error of exn
exception Gensalt_error
exception Bcrypt_error
(** {1 Type definitions} *)
type hash = string
type variant = A | Y | B
(** {1 Private functions and values} *)
external bcrypt_gensalt: char -> string -> int -> string = "bcrypt_gensalt_stub"
external bcrypt: string -> string -> string = "bcrypt_stub"
let () =
Callback.register_exception "gensalt_error" Gensalt_error;
Callback.register_exception "bcrypt_error" Bcrypt_error
let char_of_variant = function
| A -> 'a'
| Y -> 'y'
| B -> 'b'
let read_seed () =
let rec really_read ?(already_read = 0) fd to_read buff =
let read_this_time = Unix.read fd buff already_read (to_read - already_read) in
let already_read = already_read + read_this_time in
match already_read >= to_read with
| true -> ()
| false -> really_read ~already_read fd to_read buff
in
let fd = Unix.openfile "/dev/urandom" [Unix.O_RDONLY] 0o400 in
let len = 16 in
let buff = Bytes.create len in
really_read fd len buff;
Unix.close fd;
Bytes.unsafe_to_string buff
(** {1 Public functions and values} *)
let hash ?(count = 6) ?(variant = Y) ?seed passwd =
if count < 4 || count > 31
then raise (Invalid_count count)
else begin
let seed = match seed with
| Some s when String.length s >= 16 -> s
| Some s -> raise (Invalid_seed s)
| None -> try read_seed () with exc -> raise (Urandom_error exc)
in
let salt = bcrypt_gensalt (char_of_variant variant) seed count in
bcrypt passwd salt
end
let verify passwd hash =
bcrypt passwd hash = hash
let hash_of_string x = x
let string_of_hash x = x