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
|
open Microtime
let cycles = 1000
let length = 32
let range = [| "0"; "1"; "2"; "3"; "4"; "5"; "6"; "7"; "8"; "9"; "a"; "b"; "c"; "d"; "e"; "f"; |]
external random_seed : unit -> int array = "caml_sys_random_seed"
let pp_int_array ppf arr =
Fmt.pf ppf "[|" ;
for i = 0 to pred (Array.length arr) do Fmt.pf ppf "%d;" arr.(i) done ;
Fmt.pf ppf "|]"
let () =
let random_seed = random_seed () in
Fmt.pr "Random: %a.\n%!" pp_int_array random_seed ;
Random.full_init random_seed
let random length =
let get _ = range.(Random.int (Array.length range)).[0] in
String.init length get
exception Diff
let equal a b =
let ln = (min : int -> int -> int) (String.length a) (String.length b) in
try
for i = 0 to pred ln do if not (Char.equal a.[i] b.[i]) then raise_notrace Diff ; Unix.sleepf 0.0001 done ;
String.length a = String.length b
with Diff -> false
let stabilize_garbage_collector () =
let rec go limit last_heap_live_words =
if limit <= 0 then failwith "Unable to stabilize the number of live words in the heap" ;
Gc.compact () ;
let stat = Gc.stat () in
if stat.Gc.live_words <> last_heap_live_words
then go (pred limit) stat.Gc.live_words in
go 10 0
let compute a b =
let t0 = microtime () in
for _ = 0 to pred cycles do ignore (equal a b) done ;
let t1 = microtime () in
t1 - t0
let rec run hash prefix =
let timers = Hashtbl.create cycles in
for i = 0 to pred (Array.length range)
do
let m = prefix ^ range.(i) in
stabilize_garbage_collector () ;
Gc.compact () ;
Gc.minor () ;
let r = Sys.opaque_identity (compute m hash) in
Hashtbl.add timers m r ;
done ;
let results = Hashtbl.fold (fun k v a -> (k, v) :: a) timers [] in
let results = List.sort (fun (_, v0) (_, v1) -> (compare : int -> int -> int) v1 v0) results in
match results with
| [] -> assert false
| (hit, _) :: _ ->
if String.length hit = length
then hit
else run hash hit
let exit_success = 0
let exit_failure = 1
let () =
let hash = random length in
print_endline hash ;
let cracked = run hash "" in
print_endline cracked ;
if String.equal hash cracked then exit exit_success else exit exit_failure
|
