unikernel/duniverse/eqaf/attack/attack.ml

@@ -0,0 +1,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

unikernel/duniverse/eqaf/attack/dune

@@ -0,0 +1,11 @@
+(library
+ (name microtime)
+ (modules microtime)
+ (foreign_stubs
+  (language c)
+  (names microtime)))
+
+(executable
+ (name attack)
+ (modules attack)
+ (libraries fmt unix microtime))

unikernel/duniverse/eqaf/attack/microtime.c

@@ -0,0 +1,41 @@
+/* Copyright (c) 2018 David Kaloper Meršinjak. All rights reserved.
+   See LICENSE.md */
+
+#include <caml/mlvalues.h>
+
+#if defined (__x86_64__)
+#define __x86__
+
+#elif defined (__i686__)
+#warning Unmark uses unboxed native ints for low-level counters. Proceed with extreme caution.
+/* We can still do short benchmarks, tho. */
+#define __x86__
+
+#endif
+
+#if defined (__x86__)
+#include <x86intrin.h>
+#endif
+
+#include <time.h>
+
+#define __unit value unit __attribute__((unused))
+#define nsec 1000000000
+
+CAMLprim value caml_rdtsc (__unit) {
+#if defined (__x86__)
+  return Val_long (__rdtsc ());
+#else
+#warning Disabling RDTSC.
+  return Val_long (0);
+#endif
+}
+
+/* This will break on some, or all, of: Windows, macOS, Mirage.
+ * Please fill in the missing definitions.
+ */
+CAMLprim value caml_microtime (__unit) {
+  struct timespec ts;
+  clock_gettime (CLOCK_MONOTONIC, &ts);
+  return Val_long ((intnat) ts.tv_sec * nsec + (intnat) ts.tv_nsec);
+}

unikernel/duniverse/eqaf/attack/microtime.ml

@@ -0,0 +1 @@
+external microtime : unit -> int = "caml_microtime" [@@noalloc]