unikernel/duniverse/eqaf/lib/dune

@@ -0,0 +1,25 @@
+(library
+ (name eqaf)
+ (public_name eqaf)
+ (modules unsafe eqaf))
+
+(rule
+ (copy %{read:../config/which-unsafe-file} unsafe.ml))
+
+(library
+ (name eqaf_bigstring)
+ (public_name eqaf.bigstring)
+ (modules eqaf_bigstring)
+ (libraries eqaf))
+
+(library
+ (name eqaf_bytes)
+ (public_name eqaf.bytes)
+ (modules eqaf_bytes)
+ (libraries eqaf))
+
+(library
+ (name eqaf_cstruct)
+ (public_name eqaf-cstruct)
+ (modules eqaf_cstruct)
+ (libraries cstruct eqaf.bigstring))

unikernel/duniverse/eqaf/lib/eqaf.ml

@@ -0,0 +1,389 @@
+let[@inline always] char_chr ch =
+  (* Char.chr contains a branch on [ch] and a plt indirection, this
+   * implementation ensures well-formedness by construction and avoids that: *)
+  Char.unsafe_chr (ch land 0xff)
+
+let[@inline] get x i = String.unsafe_get x i |> Char.code
+
+(* XXX(dinosaure): we use [unsafe_get] to avoid jump to exception:
+
+        sarq    $1, %rbx
+        movzbq  (%rax,%rbx), %rax
+        leaq    1(%rax,%rax), %rax
+        ret
+*)
+
+external unsafe_get_int16 : string -> int -> int = "%caml_string_get16u"
+let[@inline] get16 x i = unsafe_get_int16 x i
+
+(* XXX(dinosaure): same as [unsafe_get] but for [int16]:
+
+        sarq    $1, %rbx
+        movzwq  (%rax,%rbx), %rax
+        leaq    1(%rax,%rax), %rax
+        ret
+*)
+
+let equal ~ln a b =
+  let l1 = ln asr 1 in
+
+  (*
+        sarq    $1, %rcx
+        orq     $1, %rcx
+  *)
+
+  let r = ref 0 in
+
+  (*
+        movq    $1, %rdx
+  *)
+
+  for i = 0 to pred l1 do r := !r lor (get16 a (i * 2) lxor get16 b (i * 2)) done ;
+
+  (*
+        movq    $1, %rsi
+        addq    $-2, %rcx
+        cmpq    %rcx, %rsi
+        jg      .L104
+.L105:
+        leaq    -1(%rsi,%rsi), %r8
+
+        sarq    $1, %r8
+        movzwq  (%rdi,%r8), %r9
+        leaq    1(%r9,%r9), %r9
+        movzwq  (%rbx,%r8), %r8
+        leaq    1(%r8,%r8), %r8
+
+     // [unsafe_get_int16 a i] and [unsafe_get_int6 b i]
+
+        xorq    %r9, %r8
+        orq     $1, %r8
+        orq     %r8, %rdx
+        movq    %rsi, %r8
+        addq    $2, %rsi
+        cmpq    %rcx, %r8
+        jne     .L105
+.L104:
+  *)
+
+  for _ = 1 to ln land 1 do r := !r lor (get a (ln - 1) lxor get b (ln - 1)) done ;
+
+  (*
+        movq    $3, %rsi
+        movq    %rax, %rcx
+        andq    $3, %rcx
+        cmpq    %rcx, %rsi
+        jg      .L102
+.L103:
+        movq    %rax, %r8
+        addq    $-2, %r8
+
+        sarq    $1, %r8
+        movzbq  (%rdi,%r8), %r9
+        leaq    1(%r9,%r9), %r9
+        movzbq  (%rbx,%r8), %r8
+        leaq    1(%r8,%r8), %r8
+
+     // [unsafe_get a i] and [unsafe_get b i]
+
+        xorq    %r9, %r8
+        orq     $1, %r8
+        orq     %r8, %rdx
+        movq    %rsi, %r8
+        addq    $2, %rsi
+        cmpq    %rcx, %r8
+        jne     .L103
+.L102:
+  *)
+
+  !r = 0
+
+(*
+        cmpq    $1, %rdx
+        sete    %al
+        movzbq  %al, %rax
+        leaq    1(%rax,%rax), %rax
+        ret
+*)
+
+let equal a b =
+  let al = String.length a in
+  let bl = String.length b in
+  if al <> bl
+  then false
+  else equal ~ln:al a b
+
+let[@inline always] compare (a:int) b = a - b
+let[@inline always] sixteen_if_minus_one_or_less n = (n asr Sys.int_size) land 16
+let[@inline always] eight_if_one_or_more n = ((-n) asr Sys.int_size) land 8
+
+let compare_le ~ln a b =
+  let r = ref 0 in
+  let i = ref (pred ln) in
+
+  while !i >= 0 do
+    let xa = get a !i and xb = get b !i in
+    let c = compare xa xb in
+    r := !r lor ((sixteen_if_minus_one_or_less c + eight_if_one_or_more c) lsr !r) ;
+    decr i ;
+  done ;
+
+  (!r land 8) - (!r land 16)
+
+let compare_le_with_len ~len:ln a b =
+  let al = String.length a in
+  let bl = String.length b in
+  if ln = 0 then 0
+  else if (al lxor ln) lor (bl lxor ln) <> 0
+  then invalid_arg "compare_le_with_len"
+  else compare_le ~ln a b
+
+let compare_le a b =
+  let al = String.length a in
+  let bl = String.length b in
+  if al < bl
+  then 1
+  else if al > bl
+  then (-1)
+  else compare_le ~ln:al (* = bl *) a b
+
+let compare_be ~ln a b =
+  let r = ref 0 in
+  let i = ref 0 in
+
+  while !i < ln do
+    let xa = get a !i and xb = get b !i in
+    let c = compare xa xb in
+    r := !r lor ((sixteen_if_minus_one_or_less c + eight_if_one_or_more c) lsr !r) ;
+    incr i ;
+  done ;
+
+  (!r land 8) - (!r land 16)
+
+let compare_be_with_len ~len:ln a b =
+  let al = String.length a in
+  let bl = String.length b in
+  if ln = 0 then 0
+  else if (al lxor ln) lor (bl lxor ln) <> 0
+  then invalid_arg "compare_be_with_len"
+  else compare_be ~ln a b
+
+let compare_be a b =
+  let al = String.length a in
+  let bl = String.length b in
+  if al < bl then 1
+  else if al > bl then (-1)
+  else compare_be ~ln:al (* = bl *) a b
+
+let[@inline always] minus_one_or_less n =
+  n lsr (Sys.int_size - 1)
+
+let[@inline always] one_if_not_zero n =
+  minus_one_or_less ((- n) lor n)
+
+let[@inline always] zero_if_not_zero n =
+  (one_if_not_zero n) - 1
+
+let[@inline always] select_int choose_b a b =
+  let mask = ((- choose_b) lor choose_b) asr Sys.int_size in
+  (a land (lnot mask)) lor (b land mask)
+
+external int_of_bool : bool -> int = "%identity"
+external unsafe_bool_of_int : int -> bool = "%identity"
+
+let[@inline] bool_of_int n =
+  unsafe_bool_of_int (one_if_not_zero n)
+
+let[@inline always] find_uint8 ~off ~len ~f str =
+  let i = ref (len - 1) in
+  let a = ref (lnot 0) in
+  while !i >= off do
+    let byte = get str !i in
+    let pred = int_of_bool (f byte) in
+    (* XXX(dinosaure): a composition of [f] with [bool_of_int] such as
+       [let f = bool_of_int <.> f in] implies an allocation (of a closure).
+       To be GC-free, we must store result of [f] into a register, and apply
+       [bool_of_int] then (introspection was done on OCaml 4.08.1). *)
+    a := select_int (((!i - off) land min_int) lor pred) !a !i ;
+    decr i ;
+  done ; !a
+
+let find_uint8 ?(off= 0) ~f str =
+  (* XXX(dinosaure): with this overload, OCaml is able to produce 2 [find_uint8].
+     One with [off= 0] and one other where [off] is an argument. I think it's about
+     cross-module optimization where a call to [find_uint8 ~f v] will directly call
+     the first one and a call to [find_uint8 ~off:x ~f v] will call the second one. *)
+  let len = String.length str in
+  find_uint8 ~off ~len ~f str
+
+let exists_uint8 ?off ~f str =
+  let v = find_uint8 ?off ~f str in
+  let r = select_int (v + 1) 0 1 in
+  unsafe_bool_of_int r
+
+let divmod ~(x:int32) ~(m:int32) : int32 * int32 =
+  (* Division and remainder being constant-time with respect to [x]
+   * ( NOT [m] !). The OCaml variant would be:
+   * [(x / m , x mod m)] where [x] is a secret and [m] is not secret.
+   * Adapted from the NTRU Prime team's algorithm from
+   * supercop/crypto_kem/sntrup761/ref/uint32.c
+   * cite the round-2 ntru prime submission to nistpqc (march 2019)
+   * Note that in practice this works for at least some much larger [x] and [m],
+   * but it's unclear to me how to evaluate *which*, so leaving the original
+   * restrictions in.
+  *)
+  let ( - ) , ( + ), ( * ) = Int32.(sub, add, mul) in
+  let ( >> ) = Int32.shift_right_logical in
+  if (m <= 0l) then raise (Invalid_argument "m <= 0") ;
+  if (m >= 16348l) then raise (Invalid_argument "m >= 16348 not supported") ;
+
+  let of_uint32 uint =
+    (* apparently Int64.of_int32 sign-extends ... great... avoid that: *)
+    let b = Bytes.make 8 '\x00' in
+    Unsafe.set_int32_le b 0 uint ;
+    Unsafe.get_int64_le b 0
+  in
+
+  let x_0 = x in
+
+  let x_2, q_1 =
+    let int32_div_unsigned n d =
+      (* can be replaced by Int32.unsigned_div
+       * from OCaml >= 4.10 *)
+      let sub,min_int = Int32.(sub,min_int)in
+      let int32_unsigned_compare n m =
+        Int32.compare (sub n min_int) (sub m min_int)
+      in
+      if d < 0_l then
+        if int32_unsigned_compare n d < 0 then 0_l else 1_l
+      else
+        let q =
+          let open Int32 in
+          shift_left (Int32.div (Int32.shift_right_logical n 1) d) 1 in
+        let r = sub n (Int32.mul q d) in
+        if int32_unsigned_compare r d >= 0 then Int32.succ q else q
+    in
+    let v = int32_div_unsigned Int32.min_int m |> of_uint32 in
+    (*let v = 0x80_00_00_00 / m in*) (* floored div *)
+    let x_1, q_0 =
+      let qpart_0 =
+        let open Int64 in
+        shift_right_logical (mul (of_uint32 x_0) v) 31
+        |> to_int32
+      in
+      x_0 - (qpart_0 * m), qpart_0
+    in
+    let qpart_1 =
+      let open Int64 in
+      shift_right_logical (mul (of_uint32 x_1) v) 31
+      |> to_int32 in
+    x_1 - (qpart_1 * m),
+    (q_0 + qpart_1 + 1l) in
+  let x_3 = x_2 - m  in
+  let mask = 0l - (x_3 >> 31) in
+  q_1 + mask, x_3 + (Int32.logand mask m)
+
+let ascii_of_int32 ~digits (n:int32) : string =
+  (* Recursively calls [divmod n 10]; the remainder is turned into ASCII
+     and the quotient is used for the next division.*)
+  if digits < 0 then raise (Invalid_argument "digits < 0");
+  let out = Bytes.make digits '0' in
+  let rec loop x = function
+    | -1 -> Bytes.unsafe_to_string out
+    | idx ->
+      let next, this = divmod ~x ~m:10l in
+      Bytes.set out idx @@ char_chr (0x30 lor (Int32.to_int this)) ;
+      loop next (pred idx)
+  in loop n (pred digits)
+
+let[@inline always] to_hex_nibble f : char =
+  let a = 86 + f in
+  let c = 1 + ((a - 71 * ((a land 0x10) lsr 4)) lor 0x20) in
+  char_chr c
+
+let hex_of_string rawbytes =
+  String.init (2 * String.length rawbytes)
+    (fun idx ->
+       let byt = String.get rawbytes (idx lsr 1) |> Char.code in
+       (* select which 4 bits to use, this can probably be done faster:*)
+       let nib = 0xf land (byt lsr (((lnot idx) land 1) lsl 2)) in
+       to_hex_nibble nib)
+
+let hex_of_bytes rawbytes = hex_of_string (Bytes.unsafe_to_string rawbytes)
+
+let[@inline always] select_a_if_in_range ~low ~high ~n a b =
+  (* select [a] if [low <= n <= high] and [b] if [n] is out of range.*)
+  (* NB: ONLY WORKS FOR [0 <= low <= high <= max_int]*)
+  (* The idea being that:
+     1.a) if low <=   n : (n - low)  is positive +
+     1.b) if low  >   n : (n - low)  is negative -
+     2.a) if   n <= high: (high - n) is positive +
+     2.b) if   n  > high: (high - n) is negative -
+     We OR the numbers together; we only really care about the sign bit
+     which is set when negative.
+     Thus both numbers are positive iff (low <= n && n <= high).
+     We then select the sign bit with (land min_int) and use that to choose:
+  *)
+  let out_of_range = (* choose b if out of range *)
+    ((n - low) lor (high - n)
+     land min_int)
+  in
+  select_int out_of_range a b
+
+let lowercase_ascii src =
+  (* ct version of String.lowercase_ascii *)
+  String.map
+    ( fun ch -> let n = Char.code ch in
+      (* 0x41 is 'A'; 0x5a is 'Z'; 0x20 controls case for ASCII letters *)
+      select_a_if_in_range ~low:0x41 ~high:0x5a ~n (n lor 0x20) (n)
+      |> char_chr
+    ) src
+
+let uppercase_ascii src =
+  (* ct version of String.uppercase_ascii *)
+  String.map
+    ( fun ch -> let n = Char.code ch in
+      (* 0x61 is 'a'; 0x7a is 'z'; 0x20 controls case for ASCII letters *)
+      select_a_if_in_range ~low:0x61 ~high:0x7a ~n (n lxor 0x20) (n)
+      |> char_chr
+    ) src
+
+let bytes_of_hex rawhex =
+  (* hex length must be multiple of 2: *)
+  let error_bitmap = ref ((String.length rawhex land 1) lsl 4) in
+  let decoded =
+    Bytes.init (String.length rawhex lsr 1)
+      (fun idx ->
+         let idx = idx lsl 1 in
+         let nib idx =
+           String.get rawhex idx
+           |> Char.code
+           |> fun n -> (* uppercase -> lowercase: *)
+           select_a_if_in_range ~low:0x41 ~high:0x5a
+             ~n
+             (n lor 0x20) (* set case bit *)
+             n (* leave as-is *)
+           |> fun n -> (* now either invalid; lowercase; numeric*)
+           (select_a_if_in_range ~low:0x30 ~high:0x39
+              ~n
+              (n - 0x30) (* numeric: subtract '0' to get [0..9] *)
+              (select_a_if_in_range ~low:0x61 ~high:0x66
+                 ~n
+                 (* a-f: subtract 'a' and add 10 to get [10..15]: *)
+                 (n - 0x61 + 10)
+                 (0xff) (* invalid, ensure we set upper bits of error_bitmap *)
+              )
+           )
+         in
+         let nibf0 = nib idx
+         and nib0f = nib (succ idx) in
+         error_bitmap := !error_bitmap lor nibf0 lor nib0f ;
+         char_chr ((nibf0 lsl 4) lor nib0f)
+      )
+  in
+  (* if any non-nibble bits were set in !error_bitmap, decoding failed: *)
+  decoded, !error_bitmap land (lnot 0xf)
+
+let string_of_hex rawhex =
+  let byt, error = bytes_of_hex rawhex in
+  Bytes.unsafe_to_string byt, error

unikernel/duniverse/eqaf/lib/eqaf.mli

@@ -0,0 +1,318 @@
+(** Eqaf - constant time / timing side channel resistant functions *)
+
+(** {1 Basics}
+
+    In cryptography, a timing-attack is a side-channel attack in which the
+   attacker attempts to compromise a cryptosystem by analyzing the time taken to
+   execute cryptographic algorithms.
+
+    In some cases, a process needs to compare two values (input value and
+   expected password). An attacker can analyze time needed by
+   {!String.compare}/{!String.equal} to calculate expected password.
+
+    This side-channel attack is due implementation of
+   {!String.compare}/{!String.equal} which leaves as soon as possible when it
+   reachs a difference between [a] and [b]. By this way, time taken to compare
+   two values differs if they are equal or not.
+
+    Distribution provides a little example of this kind of attack where we
+   construct step by step (byte per byte) expected value from time spended to
+   execute {!Stdlib.compare}.
+
+    Distribution wants to provide some functions which protect user against this
+   kind of attack:
+
+    {ul
+    {- [equal] like {!String.equal}}
+    {- [compare_be] like {!String.compare}}
+    {- [compare_le] which is a {!String.compare} with a reverse operation on
+   inputs}
+    {- {!divmod} like {!Int32.unsigned_div} and {!Int32.unsigned_rem}}}
+
+    These functions are tested to see how long they took to compare two equal
+   values and two different values. See {i check} tool for more informations. *)
+
+(** {1 Comparison functions} *)
+
+(** {2 Equal} *)
+
+val equal : string -> string -> bool
+(** [equal a b] returns [true] if [a] and [b] are equals. [String.equal a b =
+   equal a b] for any [a] and [b]. The execution time of [equal] depends solely
+   on the length of the strings, not the contents. *)
+
+(** {2 Big-endian comparison} *)
+
+val compare_be : string -> string -> int
+(** [compare_be a b] returns [0] if [a] is equal to [b], a negative integer if
+   [a] if {i less} (lexicographically) than [b], and a positive integer if [a]
+   is {i greater} (lexicographically) than [b].
+
+    [compare_be a b] returns the same {i order} than [String.compare a b] for
+   any [a] and [b] (but not necessary the same integer!). Order is defined as:
+
+    {ul
+    {- [compare_be a b < 0] means [a < b]}
+    {- [compare_be a b > 0] means [a > b]}
+    {- [compare_be a b = 0] means [a = b]}}
+
+    About time, if [String.length a <> String.length b], [compare_be] does not
+   look into [a] or [b] and no comparison in bytes will be done. *)
+
+val compare_be_with_len : len:int -> string -> string -> int
+(** [compare_be_with_len ~len a b] does {!compare_be}[ a b] on [len] bytes.
+
+    @raise Invalid_argument if [len] is upper than [String.length a] or
+   [String.length b]. *)
+
+(** {2 Little-endian comparison} *)
+
+val compare_le : string -> string -> int
+(** [compare_le a b] is semantically [compare_be (rev a) (rev b)],
+    where [rev] is a function that reverses a string bytewise
+    ([a = rev (rev a)]). *)
+
+val compare_le_with_len : len:int -> string -> string -> int
+(** [compare_le_with_len a b] is semantically [compare_be_with_len ~len (rev a)
+   (rev b)]. With [rev] reverse a string ([a = rev (rev a)]).
+
+    @raise Invalid_argument if [len] is upper than [String.length a] or
+   [String.length b]. *)
+
+(** {1 Arithmetic} *)
+
+(** {2 Division} *)
+
+val divmod : x:int32 -> m:int32 -> int32 * int32
+(** 32-bit unsigned division with remainder,
+    constant-time with respect to [x] ({b not} [m]).
+
+    @param x Dividend (number to be divided). {b Can be secret}.
+    @param m Divisor  {b Must not be secret}. Must be [0 < m < 16384]
+
+    This function is useful for implementation that need to produce e.g.
+    pincodes from binary values in int32 format, example: {!ascii_of_int32}.
+
+    @return [quotient, remainder]
+
+    Example:
+    {[
+      let ct = Eqaf.divmod ~x ~m in
+      let not_ct = Int32.unsigned_div x m, Int32.unsigned_rem x m in
+      assert ct = not_ct ;
+    ]}
+
+    That is, an attacker might be able to learn [m] by measuring
+    execution time, but not the value of [x].
+
+    @raise Invalid_argument when [not (0 < m && m < 16384)].
+
+    @see "supercop/crypto_kem/sntrup761/ref/uint32.c" Adapted from the NTRU Prime team's algorithm from [supercop/sntrup761], see round-2 NTRU Prime submission to NISTPQC (March 2019).
+*)
+
+(** {1:stringutil String utilities} *)
+
+(** {2 String search}*)
+
+val find_uint8 : ?off:int -> f:(int -> bool) -> string -> int
+(** [find_uint8 ?off ~f v] returns the index of the first occurrence which
+    respects the predicate [f] in string [v]. Otherwise, it returns [-1].
+    The caller is responsible for ensuring that [~f] operates in constant time.
+    The {!bool_of_int} function can be relevant when writing [~f] functions.
+*)
+
+val exists_uint8 : ?off:int -> f:(int -> bool) -> string -> bool
+(** [exists_uint8 ?off ~f v] tests if an occurrence respects the predicate
+    [f] in the string [v]. *)
+
+(** {2:ascii ASCII functions}*)
+
+val ascii_of_int32 : digits:int -> int32 -> string
+(** [ascii_of_int64 ~digits ~n] is a string consisting of
+    the rightmost [digits] characters of the decimal representation
+    of [n].
+    If [digits] is larger than the decimal representation, it is left-padded
+    with ['0'].
+    If [digits] is smaller, the output is truncated.
+
+    Example:
+    {[
+      let s1 = ascii_of_int64 ~digits:6 ~n:12345678L in
+      assert (s = "345678") ;
+      let s2 = ascii_of_int64 ~digits:6 ~n:1234L in
+      assert (s = "001234") ;
+    ]}
+
+    @raise Invalid_argument when [digits < 0]
+*)
+
+val lowercase_ascii : string -> string
+(** [lowercase_ascii str] is [str] where [A-Z] is replaced with [a-z].
+    It is a constant time implementation of {!String.lowercase_ascii}
+*)
+
+val uppercase_ascii : string -> string
+(** [uppercase_ascii str] is [str] where [a-z] is replaced with [A-Z].
+    It is a constant time implementation of {!String.uppercase_ascii}
+*)
+
+(** {2:hex Hex encoding and decoding}*)
+
+val hex_of_bytes : bytes -> string
+(** [hex_of_bytes raw] is [raw] hex-encoded in constant time.
+    Can be used to serialize sensitive values.
+    The {b contents can be secret}, but an attacker can learn the
+    {b length of} [raw] by timing this function.
+
+    Hex has two valid forms, lowercase and uppercase.
+    This function produces lowercase hex characters exclusively.
+
+    Example:
+    {[
+      let secret = "--Hi\x24" in
+      let serialized = hex_of_string secret in
+      (* serialized is now "2d2d486924" *)
+    ]}
+
+    @param raw is the source buffer. [raw] is not mutated by this function.
+*)
+
+val hex_of_string : string -> string
+(** [hex_of_string raw] is [hex_of_bytes raw] as a {!string} *)
+
+val bytes_of_hex : string -> bytes * int
+(** [bytes_of_hex hex] is [raw, error] decoded in constant time.
+    Can be used to e.g. decode secrets from configuration files.
+    The {b contents can be secret}, but an attacker can learn
+    the {b length of} [hex] by timing this function.
+
+    {b Error handling:} The second tuple element [error] is {b non-zero}
+    when the length of [hex] is not a multiple of 2,
+    or [hex] contains invalid characters.
+    Implementations should ensure that `error = 0` before using [raw].
+    The function signals errors this way to allow implementations to handle
+    invalid input errors in constant time.
+
+    @param hex The hex-encoded octet string. Accepts characters [0-9 a-f A-F].
+    Note that [0x] prefixes or whitespace are not accepted.
+
+    Example:
+    {[
+      let serialized = "2d2d486924" in
+      let secret, error = string_of_hex serialized in
+      assert (error = 0);
+      (* secret is now [--Hi$] *)
+    ]}
+*)
+
+val string_of_hex : string -> string * int
+(** [string_of_hex hex] is {!bytes_of_hex} [hex],
+    but returning a {!type:string} instead of {!type:bytes}.
+    See {!bytes_of_hex} regarding handling of invalid input errors.
+*)
+
+(** {1 Low-level primitives} *)
+
+(** {2 Bithacks} *)
+
+val one_if_not_zero : int -> int
+(** [one_if_not_zero n] is a constant-time version of
+    [if n <> 0 then 1 else 0]. This is functionally equivalent to [!!n] in the C
+    programming language. *)
+
+val zero_if_not_zero : int -> int
+(** [zero_if_not_zero n] is a constant-time of
+    [if n <> 0 then 0 else 1]. This is functionnaly equivalent to [!n] in the C
+    programming language. *)
+
+val int_of_bool : bool -> int
+(** [int_of_bool b] is equivalent to [if b then 1 else 0].
+    Internally it cast with [%identity] instead of branching.*)
+
+val bool_of_int : int -> bool
+(** [bool_of_int n] is equivalent to [if n = 0 then false else true]. *)
+
+(** {2 Composition} *)
+
+val select_int : int -> int -> int -> int
+(** [select_int choose_b a b] is [a] if [choose_b = 0] and [b] otherwise.
+    This comparison is constant-time and it should not be possible for a measuring
+    adversary to determine anything about the values of [choose_b], [a], or [b]. *)
+
+val select_a_if_in_range : low:int -> high:int ->
+  n:int -> int -> int -> int
+(** [select_a_if_in_range ~low ~high ~n a b]
+    - is [a] if [low <= n <= high] (in range)
+    - is [b] is [n < low || high < n] (out of range)
+
+    This function {b only works for positive ranges}:
+    @param low  invariant: [0 <= low <= max_int]
+    @param high invariant: [low <= high <= max_int]
+
+    This function can be used like {!select_int} but using an integer range
+    instead of zero/non-zero to select.
+
+    It operates in constant time and is safe to use with secret parameters for
+    [low, high, n, a, b].
+
+    Example:
+    {[
+      let a = 123 and b = 456 in
+      let x = select_a_if_in_range ~low:10 ~high:20 ~n:10 a b in
+      (* x = 123 *)
+      let x = select_a_if_in_range ~low:10 ~high:20 ~n:0 a b in
+      (* x = 456 *)
+      let x = select_a_if_in_range ~low:10 ~high:20 ~n:20 a b in
+      (* x = 123 *)
+      let x = select_a_if_in_range ~low:10 ~high:20 ~n:21 a b in
+      (* x = 456 *)
+
+      (* Constant-time subpatterns can be expressed by nesting,
+         Below is a constant time version of:
+         match 3 with
+         | 1 | 2| 3 | 4 ->
+            begin match 3 with
+            | 2 | 3 -> 111
+            | _ -> 222
+            end
+         | _ -> 333
+
+      *)
+      let n = 3
+      select_a_if_in_range ~low:1 ~high:4 ~n
+        (select_a_if_in_range ~low:2 ~high:3 ~n
+           (111)
+           (222)
+        )
+        333
+      (* evalutes to 111 because [1 <= n  <= 4] selects the inner pattern
+         and [2 <= n <= 3] selects the first branch ("a") of the inner pattern.
+      *)
+
+      (* The applications can also be composed in constant time,
+         note that all the branches are always evaluated, so large
+         expressions can get slow:
+      *)
+      4
+      |> fun n -> select_a_if_in_range ~low:1 ~high:5 ~n
+         (n * 10)
+         (n - 100)
+      |> fun n -> select_a_if_in_range ~low:20 ~high 30 ~n
+         (n * 100)
+         (n+3)
+      (* evaluates to [4 *10 + 3] *)
+
+      (* Below the normal, non-constant time version: *)
+      4
+      |> (function
+           | n when 1 <= n && n <= 5 -> n * 10
+           | n -> n - 100)
+      |> (function
+          | n when 20 <= n && n <= 30 -> n * 100
+          | n -> n + 3)
+    ]}
+
+    Another example of how to use this can be found in the implementations of
+    {!lowercase_ascii} and {!bytes_of_hex}.
+*)
+

unikernel/duniverse/eqaf/lib/eqaf_bigstring.ml

@@ -0,0 +1,106 @@
+type bigstring = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+let length x = Bigarray.Array1.dim x [@@inline]
+let get x i = Bigarray.Array1.unsafe_get x i |> Char.code [@@inline]
+external unsafe_get_int16 : bigstring -> int -> int = "%caml_bigstring_get16u" [@@noalloc]
+let get16 x i = unsafe_get_int16 x i [@@inline]
+
+let equal ~ln a b =
+  let l1 = ln asr 1 in
+  let r = ref 0 in
+  for i = 0 to pred l1 do r := !r lor (get16 a (i * 2) lxor get16 b (i * 2)) done ;
+  for _ = 1 to ln land 1 do r := !r lor (get a (ln - 1) lxor get b (ln - 1)) done ;
+  !r = 0
+
+let equal a b =
+  let al = length a in
+  let bl = length b in
+  if al <> bl
+  then false
+  else equal ~ln:al a b
+
+let[@inline always] compare (a:int) b = a - b
+let[@inline always] sixteen_if_minus_one_or_less n = (n asr Sys.int_size) land 16
+let[@inline always] eight_if_one_or_more n = ((-n) asr Sys.int_size) land 8
+
+let compare_le ~ln a b =
+  let r = ref 0 in
+  let i = ref (pred ln) in
+
+  while !i >= 0 do
+    let xa = get a !i and xb = get b !i in
+    let c = compare xa xb in
+    r := !r lor ((sixteen_if_minus_one_or_less c + eight_if_one_or_more c) lsr !r) ;
+    decr i ;
+  done ;
+
+  (!r land 8) - (!r land 16)
+
+let compare_le_with_len ~len:ln a b =
+  let al = length a in
+  let bl = length b in
+  if ln = 0 then 0
+  else if (al lxor ln) lor (bl lxor ln) <> 0
+  then invalid_arg "compare_le_with_len"
+  else compare_le ~ln a b
+
+let compare_le a b =
+  let al = length a in
+  let bl = length b in
+  if al < bl
+  then 1
+  else if al > bl
+  then (-1)
+  else compare_le ~ln:al (* = bl *) a b
+
+let compare_be ~ln a b =
+  let r = ref 0 in
+  let i = ref 0 in
+
+  while !i < ln do
+    let xa = get a !i and xb = get b !i in
+    let c = compare xa xb in
+    r := !r lor ((sixteen_if_minus_one_or_less c + eight_if_one_or_more c) lsr !r) ;
+    incr i ;
+  done ;
+
+  (!r land 8) - (!r land 16)
+
+let compare_be_with_len ~len:ln a b =
+  let al = length a in
+  let bl = length b in
+  if ln = 0 then 0
+  else if (al lxor ln) lor (bl lxor ln) <> 0
+  then invalid_arg "compare_be_with_len"
+  else compare_be ~ln a b
+
+let compare_be a b =
+  let al = length a in
+  let bl = length b in
+  if al < bl then 1
+  else if al > bl then (-1)
+  else compare_be ~ln:al (* = bl *) a b
+
+(* XXX(dinosaure): see [eqaf.ml] for this part. *)
+
+external int_of_bool : bool -> int = "%identity"
+external unsafe_bool_of_int : int -> bool = "%identity"
+
+let[@inline always] find_uint8 ~off ~len ~f str =
+  let i = ref (len - 1) in
+  let a = ref (lnot 0) in
+  while !i >= off do
+    let byte = get str !i in
+    let pred = int_of_bool (f byte) in
+    a := Eqaf.select_int (((!i - off) land min_int) lor pred) !a !i ;
+    decr i ;
+  done ; !a
+
+let find_uint8 ?(off= 0) ~f str =
+  let len = length str in
+  find_uint8 ~off ~len ~f str
+
+let exists_uint8 ?off ~f str =
+  let v = find_uint8 ?off ~f str in
+  let r = Eqaf.select_int (v + 1) 0 1 in
+  unsafe_bool_of_int r

unikernel/duniverse/eqaf/lib/eqaf_bigstring.mli

@@ -0,0 +1,9 @@
+type bigstring = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+val equal : bigstring -> bigstring -> bool
+val compare_be : bigstring -> bigstring -> int
+val compare_be_with_len : len:int -> bigstring -> bigstring -> int
+val compare_le : bigstring -> bigstring -> int
+val compare_le_with_len : len:int -> bigstring -> bigstring -> int
+val find_uint8 : ?off:int -> f:(int -> bool) -> bigstring -> int
+val exists_uint8 : ?off:int -> f:(int -> bool) -> bigstring -> bool

unikernel/duniverse/eqaf/lib/eqaf_bytes.ml

@@ -0,0 +1,32 @@
+let equal a b =
+  let a' = Bytes.unsafe_to_string a in
+  let b' = Bytes.unsafe_to_string b in
+  Eqaf.equal a' b'
+
+let compare_le_with_len ~len a b =
+  let a' = Bytes.unsafe_to_string a in
+  let b' = Bytes.unsafe_to_string b in
+  Eqaf.compare_le_with_len ~len a' b'
+
+let compare_le a b =
+  let a' = Bytes.unsafe_to_string a in
+  let b' = Bytes.unsafe_to_string b in
+  Eqaf.compare_le a' b'
+
+let compare_be_with_len ~len a b =
+  let a' = Bytes.unsafe_to_string a in
+  let b' = Bytes.unsafe_to_string b in
+  Eqaf.compare_be_with_len ~len a' b'
+
+let compare_be a b =
+  let a' = Bytes.unsafe_to_string a in
+  let b' = Bytes.unsafe_to_string b in
+  Eqaf.compare_be a' b'
+
+let find_uint8 ?off ~f b =
+  let str = Bytes.unsafe_to_string b in
+  Eqaf.find_uint8 ?off ~f str
+
+let exists_uint8 ?off ~f b =
+  let str = Bytes.unsafe_to_string b in
+  Eqaf.exists_uint8 ?off ~f str

unikernel/duniverse/eqaf/lib/eqaf_bytes.mli

@@ -0,0 +1,7 @@
+val equal : bytes -> bytes -> bool
+val compare_be : bytes -> bytes -> int
+val compare_be_with_len : len:int -> bytes -> bytes -> int
+val compare_le : bytes -> bytes -> int
+val compare_le_with_len : len:int -> bytes -> bytes -> int
+val find_uint8 : ?off:int -> f:(int -> bool) -> bytes -> int
+val exists_uint8 : ?off:int -> f:(int -> bool) -> bytes -> bool

unikernel/duniverse/eqaf/lib/eqaf_cstruct.ml

@@ -0,0 +1,26 @@
+let equal a b =
+  Eqaf_bigstring.equal (Cstruct.to_bigarray a) (Cstruct.to_bigarray b)
+
+let compare_be_with_len ~len a b =
+  Eqaf_bigstring.compare_be_with_len ~len
+    (Cstruct.to_bigarray a) (Cstruct.to_bigarray b)
+
+let compare_le_with_len ~len a b =
+  Eqaf_bigstring.compare_le_with_len ~len
+    (Cstruct.to_bigarray a) (Cstruct.to_bigarray b)
+
+let compare_le a b =
+  Eqaf_bigstring.compare_le
+    (Cstruct.to_bigarray a) (Cstruct.to_bigarray b)
+
+let compare_be a b =
+  Eqaf_bigstring.compare_be
+    (Cstruct.to_bigarray a) (Cstruct.to_bigarray b)
+
+let find_uint8 ?off ~f v =
+  Eqaf_bigstring.find_uint8
+    ?off ~f (Cstruct.to_bigarray v)
+
+let exists_uint8 ?off ~f v =
+  Eqaf_bigstring.exists_uint8
+    ?off ~f (Cstruct.to_bigarray v)

unikernel/duniverse/eqaf/lib/eqaf_cstruct.mli

@@ -0,0 +1,7 @@
+val equal : Cstruct.t -> Cstruct.t -> bool
+val compare_be : Cstruct.t -> Cstruct.t -> int
+val compare_be_with_len : len:int -> Cstruct.t -> Cstruct.t -> int
+val compare_le : Cstruct.t -> Cstruct.t -> int
+val compare_le_with_len : len:int -> Cstruct.t -> Cstruct.t -> int
+val find_uint8 : ?off:int -> f:(int -> bool) -> Cstruct.t -> int
+val exists_uint8 : ?off:int -> f:(int -> bool) -> Cstruct.t -> bool

unikernel/duniverse/eqaf/lib/unsafe_pre407.ml

@@ -0,0 +1,13 @@
+external set_int32_ne : bytes -> int -> int32 -> unit = "%caml_string_set32"
+external get_int64_ne : bytes -> int -> int64 = "%caml_string_get64"
+
+external swap32 : int32 -> int32 = "%bswap_int32"
+external swap64 : int64 -> int64 = "%bswap_int64"
+
+let set_int32_le b i x =
+  if Sys.big_endian then set_int32_ne b i (swap32 x)
+  else set_int32_ne b i x
+
+let get_int64_le b i =
+  if Sys.big_endian then swap64 (get_int64_ne b i)
+  else get_int64_ne b i

unikernel/duniverse/eqaf/lib/unsafe_pre408.ml

@@ -0,0 +1,13 @@
+external set_int32_ne : bytes -> int -> int32 -> unit = "%caml_bytes_set32"
+external get_int64_ne : bytes -> int -> int64 = "%caml_bytes_get64"
+
+external swap32 : int32 -> int32 = "%bswap_int32"
+external swap64 : int64 -> int64 = "%bswap_int64"
+
+let set_int32_le b i x =
+  if Sys.big_endian then set_int32_ne b i (swap32 x)
+  else set_int32_ne b i x
+
+let get_int64_le b i =
+  if Sys.big_endian then swap64 (get_int64_ne b i)
+  else get_int64_ne b i

unikernel/duniverse/eqaf/lib/unsafe_stable.ml

@@ -0,0 +1,2 @@
+let set_int32_le b i x = Bytes.set_int32_le b i x
+let get_int64_le b i = Bytes.get_int64_le b i