unikernel/duniverse/ocaml-cstruct/lib/cstruct.js

@@ -0,0 +1,53 @@
+/*
+ * Copyright (c) 2015 Citrix Inc
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+
+//Provides: caml_blit_bigstring_to_bigstring
+//Requires: caml_bigstring_blit_ba_to_ba
+var caml_blit_bigstring_to_bigstring = caml_bigstring_blit_ba_to_ba
+
+//Provides: caml_blit_bigstring_to_string
+//Requires: caml_bigstring_blit_ba_to_bytes
+var caml_blit_bigstring_to_string = caml_bigstring_blit_ba_to_bytes
+
+//Provides: caml_blit_string_to_bigstring
+//Requires: caml_bigstring_blit_string_to_ba
+var caml_blit_string_to_bigstring = caml_bigstring_blit_string_to_ba
+
+//Provides: caml_compare_bigstring
+//Requires: caml_int_compare, caml_ba_get_1
+function caml_compare_bigstring(buf1, buf1_off, buf2, buf2_off, len) {
+  var i, r;
+  for (i = 0; i < len; i++) {
+    r = caml_int_compare(caml_ba_get_1(buf1, buf1_off + i), caml_ba_get_1(buf2, buf2_off + i));
+    if (r != 0) return r;
+  }
+  return 0;
+}
+
+//Provides: caml_fill_bigstring
+//Requires: caml_ba_set_1
+function caml_fill_bigstring(buf, buf_off, buf_len, v) {
+  var i;
+  for (i = 0; i < buf_len; i++) {
+    caml_ba_set_1(buf, buf_off + i, v);
+  }
+  return 0;
+}
+
+//Provides: caml_check_alignment_bigstring
+function caml_check_alignment_bigstring(buf, ofs, alignment) {
+  return true; // FIXME: No concept of a fixed buffer address?
+}

unikernel/duniverse/ocaml-cstruct/lib/cstruct.ml

@@ -0,0 +1,963 @@
+(*
+ * Copyright (c) 2012 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+(* Note:
+ *
+ * We try to maintain the property that no constructed [t] can ever point out of
+ * its underlying buffer. This property is guarded by all of the constructing
+ * functions and the fact that the type is private, and used by various
+ * functions that would otherwise be completely unsafe.
+ *
+ * Furthermore, no operation on [t] is allowed to extend the view on the
+ * underlying Bigarray structure, only narrowing is allowed.
+ *
+ * All well-intended souls are kindly invited to cross-check that the code
+ * indeed maintains this invariant.
+ *)
+
+type t = {
+  buffer: buffer;
+  off   : int;
+  len   : int;
+}
+
+let pp_t ppf t =
+  Format.fprintf ppf "[%d,%d](%d)" t.off t.len (Bigarray.Array1.dim t.buffer)
+let string_t ppf str =
+  Format.fprintf ppf "[%d]" (String.length str)
+let bytes_t ppf str =
+  Format.fprintf ppf "[%d]" (Bytes.length str)
+
+let err fmt =
+  let b = Buffer.create 20 in                         (* for thread safety. *)
+  let ppf = Format.formatter_of_buffer b in
+  let k ppf = Format.pp_print_flush ppf (); invalid_arg (Buffer.contents b) in
+  Format.kfprintf k ppf fmt
+
+let err_of_bigarray t = err "Cstruct.of_bigarray off=%d len=%d" t
+let err_sub t = err "Cstruct.sub: %a off=%d len=%d" pp_t t
+let err_shift t = err "Cstruct.shift %a %d" pp_t t
+let err_shiftv n = err "Cstruct.shiftv short by %d" n
+let err_copy_to_string caller t = err "Cstruct.%s %a off=%d len=%d" caller pp_t t
+let err_to_hex_string t = err "Cstruct.to_hex_string %a off=%d len=%d" pp_t t
+let err_blit_src src dst =
+  err "Cstruct.blit src=%a dst=%a src-off=%d len=%d" pp_t src pp_t dst
+let err_blit_dst src dst =
+  err "Cstruct.blit src=%a dst=%a dst-off=%d len=%d" pp_t src pp_t dst
+let err_blit_from_string_src src dst =
+  err "Cstruct.blit_from_string src=%a dst=%a src-off=%d len=%d"
+    string_t src pp_t dst
+let err_blit_from_string_dst src dst =
+  err "Cstruct.blit_from_string src=%a dst=%a dst-off=%d len=%d"
+    string_t src pp_t dst
+let err_blit_from_bytes_src src dst =
+  err "Cstruct.blit_from_bytes src=%a dst=%a src-off=%d len=%d"
+    bytes_t src pp_t dst
+let err_blit_from_bytes_dst src dst =
+  err "Cstruct.blit_from_bytes src=%a dst=%a dst-off=%d len=%d"
+    bytes_t src pp_t dst
+let err_blit_to_bytes_src src dst =
+  err "Cstruct.blit_to_bytes src=%a dst=%a src-off=%d len=%d"
+    pp_t src bytes_t dst
+let err_blit_to_bytes_dst src dst=
+  err "Cstruct.blit_to_bytes src=%a dst=%a dst-off=%d len=%d"
+    pp_t src bytes_t dst
+let err_invalid_bounds f =
+  err "invalid bounds in Cstruct.%s %a off=%d len=%d" f pp_t [@@inline never]
+let err_split t = err "Cstruct.split %a start=%d off=%d" pp_t t
+let err_iter t = err "Cstruct.iter %a i=%d len=%d" pp_t t
+
+let of_bigarray ?(off=0) ?len buffer =
+  let dim = Bigarray.Array1.dim buffer in
+  let len =
+    match len with
+    | None     -> dim - off
+    | Some len -> len in
+  if off < 0 || len < 0 || off + len < 0 || off + len > dim then err_of_bigarray off len
+  else { buffer; off; len }
+
+let to_bigarray buffer =
+  Bigarray.Array1.sub buffer.buffer buffer.off buffer.len
+
+let create_unsafe len =
+  let buffer = Bigarray.(Array1.create char c_layout len) in
+  { buffer ; len ; off = 0 }
+
+let check_bounds t len =
+  len >= 0 && Bigarray.Array1.dim t.buffer >= len
+
+let empty = create_unsafe 0
+
+external check_alignment_bigstring : buffer -> int -> int -> bool = "caml_check_alignment_bigstring"
+
+let check_alignment t alignment =
+  if alignment > 0 then
+    check_alignment_bigstring t.buffer t.off alignment
+  else invalid_arg "check_alignment must be positive integer"
+
+type byte = char
+
+let byte (i:int) : byte = Char.chr i
+let byte_to_int (b:byte) = int_of_char b
+
+type uint8 = int
+type uint16 = int
+type uint32 = int32
+type uint64 = int64
+
+let debug t =
+  let max_len = Bigarray.Array1.dim t.buffer in
+  if t.off+t.len > max_len || t.len < 0 || t.off < 0 then (
+    Format.printf "ERROR: t.off+t.len=%d %a\n%!" (t.off+t.len) pp_t t;
+    assert false;
+  ) else
+    Format.asprintf "%a" pp_t t
+
+let sub t off len =
+  (* from https://github.com/mirage/ocaml-cstruct/pull/245
+
+     Cstruct.sub should select what a programmer intuitively expects a
+     sub-cstruct to be. I imagine holding out my hands, with the left
+     representing the start offset and the right the end. I think of a
+     sub-cstruct as any span within this range. If I move my left hand only to
+     the right (new_start >= t.off), and my right hand only to the left
+     (new_end <= old_end), and they don't cross (new_start <= new_end), then I
+     feel sure the result will be a valid sub-cstruct. And if I violate any one
+     of these constraints (e.g. moving my left hand further left), then I feel
+     sure that the result wouldn't be something I'd consider to be a sub-cstruct.
+
+     Wrapping considerations in modular arithmetic:
+
+     Note that if x is non-negative, and x + y wraps, then x + y must be
+     negative. This is easy to see with modular arithmetic because if y is
+     negative then the two arguments will cancel to some degree the result
+     cannot be further from zero than one of the arguments. If y is positive
+     then x + y can wrap, but even max_int + max_int doesn't wrap all the way to
+     zero.
+
+     The three possibly-wrapping operations are:
+
+     new_start = t.off + off. t.off is non-negative so if this wraps then
+     new_start will be negative and will fail the new_start >= t.off test.
+
+     new_end = new_start + len. The above test ensures that new_start is
+     non-negative in any successful return. So if this wraps then new_end will
+     be negative and will fail the new_start <= new_end test.
+
+     old_end = t.off + t.len. This uses only the existing trusted values. It
+     could only wrap if the underlying bigarray had a negative length!  *)
+  let new_start = t.off + off in
+  let new_end = new_start + len in
+  let old_end = t.off + t.len in
+  if new_start >= t.off && new_end <= old_end && new_start <= new_end then
+    { t with off = new_start ; len }
+  else
+    err_sub t off len
+
+let shift t amount =
+  let off = t.off + amount in
+  let len = t.len - amount in
+  if amount < 0 || amount > t.len || not (check_bounds t (off+len)) then
+    err_shift t amount
+  else { t with off; len }
+
+let rec skip_empty = function
+  | t :: ts when t.len = 0 -> skip_empty ts
+  | x -> x
+
+let rec shiftv ts = function
+  | 0 -> skip_empty ts
+  | n ->
+    match ts with
+    | [] -> err_shiftv n
+    | t :: ts when n >= t.len -> shiftv ts (n - t.len)
+    | t :: ts -> shift t n :: ts
+
+external unsafe_blit_bigstring_to_bigstring : buffer -> int -> buffer -> int -> int -> unit = "caml_blit_bigstring_to_bigstring" [@@noalloc]
+
+external unsafe_blit_string_to_bigstring : string -> int -> buffer -> int -> int -> unit = "caml_blit_string_to_bigstring" [@@noalloc]
+
+external unsafe_blit_bytes_to_bigstring : Bytes.t -> int -> buffer -> int -> int -> unit = "caml_blit_string_to_bigstring" [@@noalloc]
+
+external unsafe_blit_bigstring_to_bytes : buffer -> int -> Bytes.t -> int -> int -> unit = "caml_blit_bigstring_to_string" [@@noalloc]
+
+external unsafe_compare_bigstring : buffer -> int -> buffer -> int -> int -> int = "caml_compare_bigstring" [@@noalloc]
+
+external unsafe_fill_bigstring : buffer -> int -> int -> int -> unit = "caml_fill_bigstring" [@@noalloc]
+
+let copy_to_string caller src srcoff len =
+  if len < 0 || srcoff < 0 || src.len - srcoff < len then
+    err_copy_to_string caller src srcoff len
+  else
+    let b = Bytes.create len in
+    unsafe_blit_bigstring_to_bytes src.buffer (src.off+srcoff) b 0 len;
+    (* The following call is safe, since b is not visible elsewhere. *)
+    Bytes.unsafe_to_string b
+
+let copy = copy_to_string "copy"
+
+let blit src srcoff dst dstoff len =
+  if len < 0 || srcoff < 0 || src.len - srcoff < len then
+    err_blit_src src dst srcoff len
+  else if dstoff < 0 || dst.len - dstoff < len then
+    err_blit_dst src dst dstoff len
+  else
+    unsafe_blit_bigstring_to_bigstring src.buffer (src.off+srcoff) dst.buffer
+      (dst.off+dstoff) len
+
+let sub_copy cstr off len : t =
+  let cstr2 = create_unsafe len in
+  blit cstr off cstr2 0 len;
+  cstr2
+
+let blit_from_string src srcoff dst dstoff len =
+  if len < 0 || srcoff < 0 || dstoff < 0 || String.length src - srcoff < len then
+    err_blit_from_string_src src dst srcoff len
+  else if dst.len - dstoff < len then
+    err_blit_from_string_dst src dst dstoff len
+  else
+    unsafe_blit_string_to_bigstring src srcoff dst.buffer (dst.off+dstoff) len
+
+let blit_from_bytes src srcoff dst dstoff len =
+  if len < 0 || srcoff < 0 || dstoff < 0 || Bytes.length src - srcoff < len then
+    err_blit_from_bytes_src src dst srcoff len
+  else if dst.len - dstoff < len then
+    err_blit_from_bytes_dst src dst dstoff len
+  else
+    unsafe_blit_bytes_to_bigstring src srcoff dst.buffer (dst.off+dstoff) len
+
+let blit_to_bytes src srcoff dst dstoff len =
+  if len < 0 || srcoff < 0 || dstoff < 0 || src.len - srcoff < len then
+    err_blit_to_bytes_src src dst srcoff len
+  else if Bytes.length dst - dstoff < len then
+    err_blit_to_bytes_dst src dst dstoff len
+  else
+    unsafe_blit_bigstring_to_bytes src.buffer (src.off+srcoff) dst dstoff len
+
+let compare t1 t2 =
+  let l1 = t1.len
+  and l2 = t2.len in
+  match compare l1 l2 with
+  | 0 ->
+    ( match unsafe_compare_bigstring t1.buffer t1.off t2.buffer t2.off l1 with
+      | 0 -> 0
+      | r -> if r < 0 then -1 else 1 )
+  | r -> r
+
+let equal t1 t2 = compare t1 t2 = 0
+
+(* Note that this is only safe as long as all [t]s are coherent. *)
+let memset t x = unsafe_fill_bigstring t.buffer t.off t.len x
+
+let create len =
+  let t = create_unsafe len in
+  memset t 0;
+  t
+
+let set_uint8 t i c =
+  if i >= t.len || i < 0 then err_invalid_bounds "set_uint8" t i 1
+  else Bigarray.Array1.set t.buffer (t.off+i) (Char.unsafe_chr c)
+
+let set_char t i c =
+  if i >= t.len || i < 0 then err_invalid_bounds "set_char" t i 1
+  else Bigarray.Array1.set t.buffer (t.off+i) c
+
+let get_uint8 t i =
+  if i >= t.len || i < 0 then err_invalid_bounds "get_uint8" t i 1
+  else Char.code (Bigarray.Array1.get t.buffer (t.off+i))
+
+let get_char t i =
+  if i >= t.len || i < 0 then err_invalid_bounds "get_char" t i 1
+  else Bigarray.Array1.get t.buffer (t.off+i)
+
+
+external ba_set_int16 : buffer -> int -> uint16 -> unit = "%caml_bigstring_set16u"
+external ba_set_int32 : buffer -> int -> uint32 -> unit = "%caml_bigstring_set32u"
+external ba_set_int64 : buffer -> int -> uint64 -> unit = "%caml_bigstring_set64u"
+external ba_get_int16 : buffer -> int -> uint16 = "%caml_bigstring_get16u"
+external ba_get_int32 : buffer -> int -> uint32 = "%caml_bigstring_get32u"
+external ba_get_int64 : buffer -> int -> uint64 = "%caml_bigstring_get64u"
+
+external swap16 : int -> int = "%bswap16"
+external swap32 : int32 -> int32 = "%bswap_int32"
+external swap64 : int64 -> int64 = "%bswap_int64"
+
+let set_uint16 swap p t i c =
+  if i > t.len - 2 || i < 0 then err_invalid_bounds (p ^ ".set_uint16") t i 2
+  else ba_set_int16 t.buffer (t.off+i) (if swap then swap16 c else c) [@@inline]
+
+let set_uint32 swap p t i c =
+  if i > t.len - 4 || i < 0 then err_invalid_bounds (p ^ ".set_uint32") t i 4
+  else ba_set_int32 t.buffer (t.off+i) (if swap then swap32 c else c) [@@inline]
+
+let set_uint64 swap p t i c =
+  if i > t.len - 8 || i < 0 then err_invalid_bounds (p ^ ".set_uint64") t i 8
+  else ba_set_int64 t.buffer (t.off+i) (if swap then swap64 c else c) [@@inline]
+
+let get_uint16 swap p t i =
+  if i > t.len - 2 || i < 0 then err_invalid_bounds (p ^ ".get_uint16") t i 2
+  else
+    let r = ba_get_int16 t.buffer (t.off+i) in
+    if swap then swap16 r else r [@@inline]
+
+let get_uint32 swap p t i =
+  if i > t.len - 4 || i < 0 then err_invalid_bounds (p ^ ".get_uint32") t i 4
+  else
+    let r = ba_get_int32 t.buffer (t.off+i) in
+    if swap then swap32 r else r [@@inline]
+
+let get_uint64 swap p t i =
+  if i > t.len - 8 || i < 0 then err_invalid_bounds (p ^ ".get_uint64") t i 8
+  else
+    let r = ba_get_int64 t.buffer (t.off+i) in
+    if swap then swap64 r else r [@@inline]
+
+module BE = struct
+  let set_uint16 t i c = set_uint16 (not Sys.big_endian) "BE" t i c [@@inline]
+  let set_uint32 t i c = set_uint32 (not Sys.big_endian) "BE" t i c [@@inline]
+  let set_uint64 t i c = set_uint64 (not Sys.big_endian) "BE" t i c [@@inline]
+  let get_uint16 t i = get_uint16 (not Sys.big_endian) "BE" t i [@@inline]
+  let get_uint32 t i = get_uint32 (not Sys.big_endian) "BE" t i [@@inline]
+  let get_uint64 t i = get_uint64 (not Sys.big_endian) "BE" t i [@@inline]
+end
+
+module LE = struct
+  let set_uint16 t i c = set_uint16 Sys.big_endian "LE" t i c [@@inline]
+  let set_uint32 t i c = set_uint32 Sys.big_endian "LE" t i c [@@inline]
+  let set_uint64 t i c = set_uint64 Sys.big_endian "LE" t i c [@@inline]
+  let get_uint16 t i = get_uint16 Sys.big_endian "LE" t i [@@inline]
+  let get_uint32 t i = get_uint32 Sys.big_endian "LE" t i [@@inline]
+  let get_uint64 t i = get_uint64 Sys.big_endian "LE" t i [@@inline]
+end
+
+module HE = struct
+  let set_uint16 t i c = set_uint16 false "HE" t i c [@@inline]
+  let set_uint32 t i c = set_uint32 false "HE" t i c [@@inline]
+  let set_uint64 t i c = set_uint64 false "HE" t i c [@@inline]
+  let get_uint16 t i = get_uint16 false "HE" t i [@@inline]
+  let get_uint32 t i = get_uint32 false "HE" t i [@@inline]
+  let get_uint64 t i = get_uint64 false "HE" t i [@@inline]
+end
+
+let length { len ; _ } = len
+
+(** [sum_lengths ~caller acc l] is [acc] plus the sum of the lengths
+    of the elements of [l].  Raises [Invalid_argument caller] if
+    arithmetic overflows. *)
+let rec sum_lengths_aux ~caller acc = function
+  | [] -> acc
+  | h :: t ->
+     let sum = length h + acc in
+     if sum < acc then invalid_arg caller
+     else sum_lengths_aux ~caller sum t
+
+let sum_lengths ~caller l = sum_lengths_aux ~caller 0 l
+
+let lenv l = sum_lengths ~caller:"Cstruct.lenv" l
+
+let copyv ts =
+  let sz = sum_lengths ~caller:"Cstruct.copyv" ts in
+  let dst = Bytes.create sz in
+  let _ = List.fold_left
+    (fun off src ->
+      let x = length src in
+      unsafe_blit_bigstring_to_bytes src.buffer src.off dst off x;
+      off + x
+    ) 0 ts in
+  (* The following call is safe, since dst is not visible elsewhere. *)
+  Bytes.unsafe_to_string dst
+
+let fillv ~src ~dst =
+  let rec aux dst n = function
+    | [] -> n, []
+    | hd::tl ->
+        let avail = length dst in
+        let first = length hd in
+        if first <= avail then (
+          blit hd 0 dst 0 first;
+          aux (shift dst first) (n + first) tl
+        ) else (
+          blit hd 0 dst 0 avail;
+          let rest_hd = shift hd avail in
+          (n + avail, rest_hd :: tl)
+        ) in
+  aux dst 0 src
+
+let to_string ?(off=0) ?len:sz t =
+  let len = match sz with None -> length t - off | Some l -> l in
+  copy_to_string "to_string" t off len
+
+let to_hex_string ?(off=0) ?len:sz t : string =
+  let[@inline] nibble_to_char (i:int) : char =
+    if i < 10 then
+      Char.chr (i + Char.code '0')
+    else
+      Char.chr (i - 10 + Char.code 'a')
+  in
+
+  let len = match sz with None -> length t - off | Some l -> l in
+  if len < 0 || off < 0 || t.len - off < len then
+    err_to_hex_string t off len
+  else (
+    let out = Bytes.create (2 * len) in
+    for i=0 to len-1 do
+      let c = Char.code @@ Bigarray.Array1.get t.buffer (i+t.off+off) in
+      Bytes.set out (2*i) (nibble_to_char (c lsr 4));
+      Bytes.set out (2*i+1) (nibble_to_char (c land 0xf));
+    done;
+    Bytes.unsafe_to_string out
+  )
+
+
+let to_bytes ?off ?len t =
+  Bytes.unsafe_of_string (to_string ?off ?len t)
+
+let [@inline always] of_data_abstract blitfun lenfun ?allocator ?(off=0) ?len buf =
+  let buflen =
+    match len with
+    | None -> lenfun buf - off
+    | Some len -> len in
+  match allocator with
+  | None ->
+    let c = create_unsafe buflen in
+    blitfun buf off c 0 buflen;
+    c
+  | Some fn ->
+    let c = fn buflen in
+    blitfun buf off c 0 buflen;
+    { c with len = buflen }
+
+let of_string ?allocator ?off ?len buf =
+  of_data_abstract blit_from_string String.length ?allocator ?off ?len buf
+
+let of_bytes ?allocator ?off ?len buf =
+  of_data_abstract blit_from_bytes Bytes.length ?allocator ?off ?len buf
+
+let of_hex ?(off=0) ?len str =
+  let str =
+    let l = match len with None -> String.length str - off | Some l -> l in
+    String.sub str off l
+  in
+  let string_fold ~f ~z str =
+    let st = ref z in
+    ( String.iter (fun c -> st := f !st c) str  ; !st )
+  in
+  let hexdigit p = function
+    | 'a' .. 'f' as x -> int_of_char x - 87
+    | 'A' .. 'F' as x -> int_of_char x - 55
+    | '0' .. '9' as x -> int_of_char x - 48
+    | x ->
+      Format.ksprintf invalid_arg "of_hex: invalid character at pos %d: %C" p x
+  in
+  let whitespace = function
+    | ' ' | '\t' | '\r' | '\n' -> true
+    | _ -> false
+  in
+  match
+    string_fold
+      ~f:(fun (cs, i, p, acc) ->
+          let p' = succ p in
+          function
+          | char when whitespace char -> (cs, i, p', acc)
+          | char ->
+            match acc, hexdigit p char with
+            | (None  , x) -> (cs, i, p', Some (x lsl 4))
+            | (Some y, x) -> set_uint8 cs i (x lor y) ; (cs, succ i, p', None))
+      ~z:(create_unsafe (String.length str lsr 1), 0, 0, None)
+      str
+  with
+  | _ , _, _, Some _ ->
+    Format.ksprintf invalid_arg "of_hex: odd numbers of characters"
+  | cs, i, _, _ -> sub cs 0 i
+
+let hexdump_pp fmt t =
+  let before fmt =
+    function
+    | 0 -> ()
+    | 8 -> Format.fprintf fmt "  ";
+    | _ -> Format.fprintf fmt " "
+  in
+  let after fmt =
+    function
+    | 15 -> Format.fprintf fmt "@;"
+    |  _ -> ()
+  in
+  Format.pp_open_vbox fmt 0 ;
+  for i = 0 to length t - 1 do
+    let column = i mod 16 in
+    let c = Char.code (Bigarray.Array1.get t.buffer (t.off+i)) in
+    Format.fprintf fmt "%a%.2x%a" before column c after column
+  done ;
+  Format.pp_close_box fmt ()
+
+let hexdump = Format.printf "@\n%a@." hexdump_pp
+
+let hexdump_to_buffer buf t =
+  let f = Format.formatter_of_buffer buf in
+  Format.fprintf f "@\n%a@." hexdump_pp t
+
+let split ?(start=0) t off =
+  try
+    let header =sub t start off in
+    let body = sub t (start+off) (length t - off - start) in
+    header, body
+  with Invalid_argument _ -> err_split t start off
+
+type 'a iter = unit -> 'a option
+let iter lenfn pfn t =
+  let body = ref (Some t) in
+  let i = ref 0 in
+  fun () ->
+    match !body with
+      |Some buf when length buf = 0 ->
+        body := None;
+        None
+      |Some buf -> begin
+        match lenfn buf with
+        |None ->
+          body := None;
+          None
+        |Some plen ->
+          incr i;
+          let p,rest =
+            try split buf plen with Invalid_argument _ -> err_iter buf !i plen
+          in
+          body := Some rest;
+          Some (pfn p)
+      end
+      |None -> None
+
+let rec fold f next acc = match next () with
+  | None -> acc
+  | Some v -> fold f next (f acc v)
+
+let append cs1 cs2 =
+  let l1 = length cs1 and l2 = length cs2 in
+  let cs = create_unsafe (l1 + l2) in
+  blit cs1 0 cs 0  l1 ;
+  blit cs2 0 cs l1 l2 ;
+  cs
+
+let concat = function
+  | []   -> create_unsafe 0
+  | [cs] -> cs
+  | css  ->
+      let result = create_unsafe (sum_lengths ~caller:"Cstruct.concat" css) in
+      let aux off cs =
+        let n = length cs in
+        blit cs 0 result off n ;
+        off + n in
+      ignore @@ List.fold_left aux 0 css ;
+      result
+
+let rev t =
+  let n = length t in
+  let out = create_unsafe n in
+  for i_src = 0 to n - 1 do
+    let byte = get_uint8 t i_src in
+    let i_dst = n - 1 - i_src in
+    set_uint8 out i_dst byte
+  done;
+  out
+
+(* Convenience function. *)
+
+external unsafe_blit_string_to_bigstring
+  : string -> int -> buffer -> int -> int -> unit
+  = "caml_blit_string_to_bigstring"
+[@@noalloc]
+
+let get { buffer; off; len; } zidx =
+  if zidx < 0 || zidx >= len then invalid_arg "index out of bounds" ;
+  Bigarray.Array1.get buffer (off + zidx)
+
+let get_byte { buffer; off; len; } zidx =
+  if zidx < 0 || zidx >= len then invalid_arg "index out of bounds" ;
+  Char.code (Bigarray.Array1.get buffer (off + zidx))
+
+let string ?(off= 0) ?len str =
+  let str_len = String.length str in
+  let len = match len with None -> str_len | Some len -> len in
+  if off < 0 || len < 0 || off + len > str_len then invalid_arg "index out of bounds" ;
+  let buffer = Bigarray.(Array1.create char c_layout str_len) in
+  unsafe_blit_string_to_bigstring str 0 buffer 0 str_len ;
+  of_bigarray ~off ~len buffer
+
+let buffer ?(off= 0) ?len buffer =
+  let buffer_len = Bigarray.Array1.dim buffer in
+  let len = match len with None -> buffer_len - off | Some len -> len in
+  if off < 0 || len < 0 || off + len > buffer_len then invalid_arg "index out of bounds" ;
+  of_bigarray ~off ~len buffer
+
+let start_pos { off; _ } = off
+let stop_pos { off; len; _ } = off + len
+
+let head ?(rev= false) ({ len; _ } as cs) =
+  if len = 0 then None
+  else Some (get_char cs (if rev then len - 1 else 0))
+
+let tail ?(rev= false) ({ buffer; off; len; } as cs) =
+  if len = 0 then cs
+  else if rev then of_bigarray ~off ~len:(len - 2) buffer
+  else of_bigarray ~off:(off + 1) ~len:(len - 1) buffer
+
+let is_empty { len; _ } = len = 0
+
+let is_prefix ~affix:({ len= alen; _ } as affix)
+    ({ len; _ } as cs) =
+  if alen > len then false
+  else
+    let max_zidx = alen - 1 in
+    let rec loop i =
+      if i > max_zidx then true
+      else if get_char affix i <> get_char cs i
+      then false else loop (succ i) in
+    loop 0
+
+let is_infix ~affix:({ len= alen; _ } as affix)
+    ({ len; _ } as cs) =
+  if alen > len then false
+  else
+    let max_zidx_a = alen - 1 in
+    let max_zidx_s = len - alen in
+    let rec loop i k =
+      if i > max_zidx_s then false
+      else if k > max_zidx_a then true
+      else if k > 0 then
+        if get_char affix k = get_char cs (i + k)
+        then loop i (succ k)
+        else loop (succ i) 0
+      else if get_char affix 0 = get_char cs i
+      then loop i 1
+      else loop (succ i) 0 in
+    loop 0 0
+
+let is_suffix ~affix:({ len= alen; _ } as affix)
+    ({ len; _ } as cs) =
+  if alen > len then false
+  else
+    let max_zidx = alen - 1 in
+    let max_zidx_a = alen - 1 in
+    let max_zidx_s = len - 1 in
+    let rec loop i =
+      if i > max_zidx then true
+      else if get_char affix (max_zidx_a - i) <> get_char cs (max_zidx_s - i)
+      then false else loop (succ i) in
+    loop 0
+
+let for_all sat cs =
+  let rec go acc i =
+    if i < length cs
+    then go (sat (get_char cs i) && acc) (succ i)
+    else acc in
+  go true 0
+
+let exists sat cs =
+  let rec go acc i =
+    if i < length cs
+    then go (sat (get_char cs i) || acc) (succ i)
+    else acc in
+  go false 0
+
+let start { buffer; off; _ } =
+  of_bigarray buffer ~off ~len:0
+
+let stop { buffer; off; len; } =
+  of_bigarray buffer ~off:(off + len) ~len:0
+
+let is_white = function ' ' | '\t' .. '\r' -> true | _ -> false
+
+let trim ?(drop = is_white) ({ buffer; off; len; } as cs) =
+  if len = 0 then cs
+  else
+    let max_zpos = len in
+    let max_zidx = len - 1 in
+    let rec left_pos i =
+      if i > max_zidx then max_zpos
+      else if drop (get_char cs i) then left_pos (succ i) else i in
+    let rec right_pos i =
+      if i < 0 then 0
+      else if drop (get_char cs i) then right_pos (pred i) else succ i in
+    let left = left_pos 0 in
+    if left = max_zpos
+    then of_bigarray buffer ~off:((off * 2 + len) / 2) ~len:0
+    else
+      let right = right_pos max_zidx in
+      if left = 0 && right = max_zpos then cs
+      else of_bigarray buffer ~off:(off + left) ~len:(right - left)
+
+let fspan ~min ~max ~sat ({ buffer= v; off; len; } as cs) =
+  if min < 0 then invalid_arg "span: negative min" ;
+  if max < 0 then invalid_arg "span: negative max" ;
+  if min > max || max = 0 then (buffer ~off:off ~len:0 v, cs)
+  else
+    let max_zidx = len - 1 in
+    let max_zidx =
+      let k = max - 1 in
+      if k > max_zidx || k < 0 then max_zidx else k in
+    let need_zidx = min in
+    let rec loop i =
+      if i <= max_zidx && sat (get_char cs i) then loop (i + 1)
+      else if i < need_zidx || i = 0 then buffer ~off:off ~len:0 v, cs
+      else if i = len then (cs, buffer ~off:(off + len) ~len:0 v)
+      else buffer ~off:off ~len:i v, buffer ~off:(off + i) ~len:(len - i) v in
+    loop 0
+
+let rspan ~min ~max ~sat ({ buffer= v; off; len; } as cs) =
+  if min < 0 then invalid_arg "span: negative min" ;
+  if max < 0 then invalid_arg "span: negative max" ;
+  if min > max || max = 0 then (cs, buffer ~off:(off + len) ~len:0 v)
+  else
+    let max_zidx = len - 1 in
+    let min_zidx =
+      let k = len - max in if k < 0 then 0 else k in
+    let need_zidx = len - min - 1 in
+    let rec loop i =
+      if i >= min_zidx && sat (get_char cs i) then loop (i - 1)
+      else if i > need_zidx || i = max_zidx then (cs, buffer ~off:(off + len) ~len:0 v)
+      else if i < 0 then (buffer ~off:off ~len:0 v, cs)
+      else (buffer ~off:off ~len:(i + 1) v, buffer ~off:(off + i + 1) ~len:(len - (i + 1)) v) in
+    loop max_zidx
+
+let span ?(rev= false) ?(min= 0) ?(max= max_int) ?(sat= fun _ -> true) cs =
+  match rev with
+  | true  -> rspan ~min ~max ~sat cs
+  | false -> fspan ~min ~max ~sat cs
+
+let take ?(rev= false) ?min ?max ?sat cs =
+  (if rev then snd else fst) @@ span ~rev ?min ?max ?sat cs
+
+let drop ?(rev= false) ?min ?max ?sat cs =
+  (if rev then fst else snd) @@ span ~rev ?min ?max ?sat cs
+
+let fcut ~sep:({ len= sep_len; _ } as sep)
+    ({ buffer= v; off; len; } as cs) =
+  if sep_len = 0 then invalid_arg "cut: empty separator" ;
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_zidx = len - sep_len in
+  let rec check_sep i k =
+    if k > max_sep_zidx
+    then Some (buffer ~off:off ~len:i v,
+               buffer ~off:(off + i + sep_len) ~len:(len - i - sep_len) v)
+    else if get_char cs (i + k) = get_char sep k
+    then check_sep i (k + 1)
+    else scan (i + 1)
+  and scan i =
+    if i > max_s_zidx then None
+    else if get_char cs i = get_char sep 0
+    then check_sep i 1
+    else scan (i + 1) in
+  scan 0
+
+let rcut ~sep:({ len= sep_len; _ } as sep) ({ buffer= v; off; len; } as cs) =
+  if sep_len = 0 then invalid_arg "cut: empty separator" ;
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_zidx = len - 1 in
+  let rec check_sep i k =
+    if k > max_sep_zidx then Some (buffer ~off:off ~len:i v,
+                                   buffer ~off:(off + i + sep_len) ~len:(len - i - sep_len) v)
+    else if get_char cs (i + k) = get_char sep k
+    then check_sep i (k + 1)
+    else rscan (i - 1)
+  and rscan i =
+    if i < 0 then None
+    else if get_char cs i = get_char sep 0
+    then check_sep i 1
+    else rscan (i - 1) in
+  rscan (max_s_zidx - max_sep_zidx)
+
+let cut ?(rev= false) ~sep cs = match rev with
+  | true  -> rcut ~sep cs
+  | false -> fcut ~sep cs
+
+let add_sub ~no_empty buf ~off ~len acc =
+  if len = 0
+  then ( if no_empty then acc else buffer ~off ~len buf :: acc )
+  else buffer ~off ~len buf :: acc
+
+let fcuts ~no_empty ~sep:({ len= sep_len; _ } as sep)
+      ({ buffer; off; len; } as cs) =
+  if sep_len = 0 then invalid_arg "cuts: empty separator" ;
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_zidx = len - sep_len in
+  let rec check_sep zanchor i k acc =
+    if k > max_sep_zidx
+    then
+      let new_start = i + sep_len in
+      scan new_start new_start (add_sub ~no_empty buffer ~off:(off + zanchor) ~len:(i - zanchor) acc)
+    else
+      if get_char cs (i + k) = get_char sep k
+      then check_sep zanchor i (k + 1) acc
+      else scan zanchor (i + 1) acc
+  and scan zanchor i acc =
+    if i > max_s_zidx
+    then
+      if zanchor = 0 then (if no_empty && len = 0 then [] else [ cs ])
+      else List.rev (add_sub ~no_empty buffer ~off:(off + zanchor) ~len:(len - zanchor) acc)
+    else
+      if get_char cs i = get_char sep 0
+      then check_sep zanchor i 1 acc
+      else scan zanchor (i + 1) acc in
+  scan 0 0 []
+
+let rcuts ~no_empty ~sep:({ len= sep_len; _ } as sep)
+      ({ buffer; len; _ } as cs) =
+  if sep_len = 0 then invalid_arg "cuts: empty separator" ;
+  let s_len = len in
+  let max_sep_zidx = sep_len - 1 in
+  let max_s_zidx = len - 1 in
+  let rec check_sep zanchor i k acc =
+    if k > max_sep_zidx
+    then let off = i + sep_len in
+         rscan i (i - sep_len) (add_sub ~no_empty buffer ~off ~len:(zanchor - off) acc)
+    else
+      if get_char cs (i + k) = get_char cs k
+      then check_sep zanchor i (k + 1) acc
+      else rscan zanchor (i - 1) acc
+  and rscan zanchor i acc =
+    if i < 0 then
+      if zanchor = s_len then ( if no_empty && s_len = 0 then [] else [ cs ])
+      else add_sub ~no_empty buffer ~off:0 ~len:zanchor acc
+    else
+      if get_char cs i = get_char sep 0
+      then check_sep zanchor i 1 acc
+      else rscan zanchor (i - 1) acc in
+  rscan s_len (max_s_zidx - max_sep_zidx) []
+
+let cuts ?(rev= false) ?(empty= true) ~sep cs = match rev with
+  | true  -> rcuts ~no_empty:(not empty) ~sep cs
+  | false -> fcuts ~no_empty:(not empty) ~sep cs
+
+let fields ?(empty= false) ?(is_sep= is_white) ({ buffer; off; len; } as cs) =
+  let no_empty = not empty in
+  let max_pos = len in
+  let rec loop i end_pos acc =
+    if i < 0 then begin
+        if end_pos = len
+        then ( if no_empty && len = 0 then [] else [ cs ])
+        else add_sub ~no_empty buffer ~off:off ~len:(end_pos - (i + 1)) acc
+      end else begin
+        if not (is_sep (get_char cs i))
+        then loop (i - 1) end_pos acc
+        else loop (i - 1) i (add_sub ~no_empty buffer ~off:(off + i + 1) ~len:(end_pos - (i + 1)) acc)
+      end in
+  loop (max_pos - 1) max_pos []
+
+let ffind sat ({ buffer= v; len; _ } as cs) =
+  let max_idx = len - 1 in
+  let rec loop i =
+    if i > max_idx then None
+    else if sat (get_char cs i)
+    then Some (buffer ~off:i ~len:1 v)
+    else loop (i + 1) in
+  loop 0
+
+let rfind sat ({ buffer= v; len; _ } as cs) =
+  let rec loop i =
+    if i < 0 then None
+    else if sat (get_char cs i)
+    then Some (buffer ~off:i ~len:1 v)
+    else loop (i - 1) in
+  loop (len - 1)
+
+let find ?(rev= false) sat cs = match rev with
+  | true  -> rfind sat cs
+  | false -> ffind sat cs
+
+let ffind_sub ~sub:({ len= sub_len; _ } as sub) ({ buffer= v; off; len; } as cs) =
+  if sub_len > len then None
+  else
+    let max_zidx_sub = sub_len - 1 in
+    let max_zidx_s = len - sub_len in
+    let rec loop i k =
+      if i > max_zidx_s then None
+      else if k > max_zidx_sub then Some (buffer v ~off:(off + i) ~len:sub_len)
+      else if k > 0
+      then ( if get_char sub k = get_char cs (i + k)
+             then loop i (k + 1)
+             else loop (i + 1) 0 )
+      else if get_char sub 0 = get_char cs i
+      then loop i 1
+      else loop (i + 1) 0 in
+    loop 0 0
+
+let rfind_sub ~sub:({ len= sub_len; _ } as sub) ({ buffer= v; len; _ } as cs) =
+  if sub_len > len then None
+  else
+    let max_zidx_sub = sub_len - 1 in
+    let rec loop i k =
+      if i < 0 then None
+      else if k > max_zidx_sub then Some (buffer v ~off:i ~len:sub_len)
+      else if k > 0
+      then ( if get_char sub k = get_char cs (i + k)
+             then loop i (k + 1)
+             else loop (i - 1) 0 )
+      else if get_char sub 0 = get_char cs i
+      then loop i 1
+      else loop (i - 1) 0 in
+    loop (len - sub_len) 0
+
+let find_sub ?(rev= false) ~sub cs = match rev with
+  | true  -> rfind_sub ~sub cs
+  | false -> ffind_sub ~sub cs
+
+let filter sat ({ len; _ } as cs) =
+  if len = 0 then empty
+  else
+    let b = create len in
+    let max_zidx = len - 1 in
+    let rec loop b k i =
+      if i > max_zidx
+      then (if k = len then b else sub b 0 k)
+      else
+        let chr = get_char cs i in
+        if sat chr then ( set_char b k chr ; loop b (k + 1) (i + 1))
+        else loop b k (i + 1) in
+    loop b 0 0
+
+let filter_map f ({ len; _ } as cs) =
+  if len = 0 then empty
+  else
+    let b = create len in
+    let max_zidx = len - 1 in
+    let rec loop b k i =
+      if i > max_zidx
+      then (if k = len then b else sub b 0 k)
+      else match f (get_char cs i) with
+           | Some chr ->
+              set_char b i chr ;
+              loop b (k + 1) (i + 1)
+           | None ->
+              loop b k (i + 1) in
+    loop b 0 0
+
+let map f ({ len; _ } as cs) =
+  if len = 0 then empty
+  else
+    let b = create len in
+    for i = 0 to len - 1 do
+      set_char b i (f (get_char cs i))
+    done ; b
+
+let mapi f ({ len; _ } as cs) =
+  if len = 0 then empty
+  else
+    let b = create len in
+    for i = 0 to len - 1 do
+      set_char b i (f i (get_char cs i))
+    done ; b

unikernel/duniverse/ocaml-cstruct/lib/cstruct.mli

@@ -0,0 +1,838 @@
+(*
+ * Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Manipulate external memory buffers as C-like structures.
+
+Cstruct is a library and ppx rewriter to make it easier to access C-like
+structures directly from OCaml.  It supports both reading and writing to these
+memory buffers, and they are accessed via the [Bigarray] module.
+
+The library interface below is intended to be used in conjunction with the
+ppx rewriter that is also supplied with this library (in the [cstruct-ppx]
+ocamlfind package).
+
+An example description for the pcap packet format is:
+
+{[
+[%%cstruct
+type pcap_header = {
+  magic_number:  uint32_t; (* magic number *)
+  version_major: uint16_t; (* major version number *)
+  version_minor: uint16_t; (* minor version number *)
+  thiszone:      uint32_t; (* GMT to local correction *)
+  sigfigs:       uint32_t; (* accuracy of timestamps *)
+  snaplen:       uint32_t; (* max length of captured packets, in octets *)
+  network:       uint32_t; (* data link type *)
+} [@@little_endian]
+]
+[%%cstruct
+type pcap_packet = {
+  ts_sec:   uint32_t; (* timestamp seconds *)
+  ts_usec:  uint32_t; (* timestamp microseconds *)
+  incl_len: uint32_t; (* number of octets of packet saved in file *)
+  orig_len: uint32_t; (* actual length of packet *)
+} [@@little_endian]
+]
+[%%cstruct
+type ethernet = {
+  dst:       uint8_t;  [@len 6];
+  src:       uint8_t;  [@len 6];
+  ethertype: uint16_t;
+} [@@big_endian]
+]
+[%%cstruct
+type ipv4 = {
+  hlen_version: uint8_t;
+  tos:          uint8_t;
+  len:          uint16_t;
+  id:           uint16_t;
+  off:          uint16_t;
+  ttl:          uint8_t;
+  proto:        uint8_t;
+  csum:         uint16_t;
+  src:          uint8_t;  [@len 4];
+  dst:          uint8_t;  [@len 4]
+} [@@big_endian]
+]
+]}
+
+These will expand to get and set functions for every field, with types
+appropriate to the particular definition.  For instance:
+
+{[
+val get_pcap_packet_ts_sec : Cstruct.t -> Cstruct.uint32
+val set_pcap_packet_ts_sec : Cstruct.t -> Cstruct.uint32 -> unit
+val get_pcap_packet_ts_usec : Cstruct.t -> Cstruct.uint32
+val set_pcap_packet_ts_usec : Cstruct.t -> Cstruct.uint32 -> unit
+val get_pcap_packet_incl_len : Cstruct.t -> Cstruct.uint32
+val set_pcap_packet_incl_len : Cstruct.t -> Cstruct.uint32 -> unit
+val get_pcap_packet_orig_len : Cstruct.t -> Cstruct.uint32
+val set_pcap_packet_orig_len : Cstruct.t -> Cstruct.uint32 -> unit
+val hexdump_pcap_packet_to_buffer : Buffer.t -> Cstruct.t -> unit
+]}
+
+The buffers generate a different set of functions. For the  [ethernet]
+definitions, we have:
+
+{[
+val sizeof_ethernet : int
+val get_ethernet_dst : Cstruct.t -> Cstruct.t
+val copy_ethernet_dst : Cstruct.t -> string
+val set_ethernet_dst : string -> int -> Cstruct.t -> unit
+val blit_ethernet_dst : Cstruct.t -> int -> Cstruct.t -> unit
+val get_ethernet_src : Cstruct.t -> Cstruct.t
+val copy_ethernet_src : Cstruct.t -> string
+]}
+
+You can also declare C-like enums:
+
+{[
+[%%cenum
+type foo32 =
+  | ONE32
+  | TWO32     [@id 0xfffffffel]
+  | THREE32
+[@@uint32_t]
+]
+[%%cenum
+type bar16 =
+  | ONE  [@id 1]
+  | TWO
+  | FOUR [@id 4
+  | FIVE
+[@@uint16_t]
+]
+]}
+
+This generates signatures of the form:
+
+{[
+type foo32 = | ONE32 | TWO32 | THREE32
+val int_to_foo32 : int32 -> foo32 option
+val foo32_to_int : foo32 -> int32
+val foo32_to_string : foo32 -> string
+val string_to_foo32 : string -> foo32 option
+type bar16 = | ONE | TWO | FOUR | FIVE
+val int_to_bar16 : int -> bar16 option
+val bar16_to_int : bar16 -> int
+val bar16_to_string : bar16 -> string
+val string_to_bar16 : string -> bar16 option
+]}
+
+*)
+
+(** {2 Base types } *)
+
+type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+(** Type of a buffer. A cstruct is composed of an underlying buffer
+    and position/length within this buffer. *)
+
+type t = private {
+  buffer: buffer;
+  off   : int;
+  len   : int;
+}
+(** Type of a cstruct. *)
+
+type byte = char
+(** A single byte type *)
+
+val byte : int -> byte
+(** [byte v] convert [v] to a single byte.
+    @raise Invalid_argument if [v] is negative or greater than 255. *)
+
+type uint8 = int
+(** 8-bit unsigned integer.  The representation is currently an
+    unboxed OCaml integer. *)
+
+type uint16 = int
+(** 16-bit unsigned integer.  The representation is currently an
+    unboxed OCaml integer. *)
+
+type uint32 = int32
+(** 32-bit unsigned integer.  The representation is currently a
+    boxed OCaml int32. *)
+
+type uint64 = int64
+(** 64-bit unsigned integer.  The representation is currently a
+    boxed OCaml int64. *)
+
+(** {2 Creation and conversion} *)
+
+val empty : t
+(** [empty] is the cstruct of length 0. *)
+
+val of_bigarray: ?off:int -> ?len:int -> buffer -> t
+(** [of_bigarray ~off ~len b] is the cstruct contained in [b] starting
+    at offset [off] (default [0]) of length [len]
+    (default [Bigarray.Array1.dim b - off]). *)
+
+val to_bigarray: t -> buffer
+(** [to_bigarray t] converts a {!t} into a {!type:buffer} Bigarray, using
+    the Bigarray slicing to allocate a fresh array that preserves
+    sharing of the underlying buffer. *)
+
+val create : int -> t
+(** [create len] is a fresh cstruct of size [len] with an offset of 0,
+    filled with zero bytes. *)
+
+val create_unsafe : int -> t
+(** [create_unsafe len] is a cstruct of size [len] with an offset of 0.
+
+    Note that the returned cstruct will contain arbitrary data,
+    likely including the contents of previously-deallocated cstructs.
+
+    Beware!
+
+    Forgetting to replace this data could cause your application
+    to leak sensitive information.
+*)
+
+val of_string: ?allocator:(int -> t) -> ?off:int -> ?len:int -> string -> t
+(** [of_string ~allocator ~off ~len str] is the cstruct representation of [str]
+    slice located at offset [off] (default [0]) and of length [len] (default
+    [String.length str - off]),
+    with the underlying buffer allocated by [alloc]. If [allocator] is not
+    provided, [create] is used.
+
+    @raise Invalid_argument if [off] or [len] is negative, or
+    [String.length str - off] < [len].
+*)
+
+val of_bytes: ?allocator:(int -> t) -> ?off:int -> ?len:int -> bytes -> t
+(** [of_bytes ~allocator byt] is the cstruct representation of [byt]
+    slice located at offset [off] (default [0]) and of length [len] (default
+    [Bytes.length byt - off]),
+    with the underlying buffer allocated by [alloc]. If [allocator] is not
+    provided, [create] is used.
+
+    @raise Invalid_argument if [off] or [len] is negative, or
+    [Bytes.length str - off] < [len]. *)
+
+val of_hex: ?off:int -> ?len:int -> string -> t
+(** [of_hex ~off ~len str] is the cstruct [cs].  Every pair of hex-encoded
+    characters in [str] starting at offset [off] (default [0]) of length [len]
+    (default [String.length str - off]) are converted to one byte in [cs].
+    Whitespaces (space, newline, tab, carriage return) in [str] are skipped.
+
+    @raise Invalid_argument if the input string contains invalid characters or
+    has an odd numbers of non-whitespace characters, or if [off] or [len] are
+    negative, or [String.length str - off] < [len]. *)
+
+(** {2 Comparison } *)
+
+val equal : t -> t -> bool
+(** [equal t1 t2] is [true] iff [t1] and [t2] correspond to the same sequence of
+    bytes. *)
+
+val compare : t -> t -> int
+(** [compare t1 t2] gives an unspecified total ordering over {!t}. *)
+
+(** {2 Getters and Setters } *)
+
+val byte_to_int : byte -> int
+(** Convert a byte to an integer *)
+
+val check_bounds : t -> int -> bool
+(** [check_bounds cstr len] is [true] if [len] is a non-negative integer and
+    [cstr.buffer]'s size is greater or equal than [len] [false] otherwise.*)
+
+val check_alignment : t -> int -> bool
+(** [check_alignment cstr alignment] is [true] if the first byte stored
+    within [cstr] is at a memory address where [address mod alignment = 0],
+    [false] otherwise.
+    Typical uses are to check a buffer is aligned to a page or disk sector
+    boundary.
+    @raise Invalid_argument if [alignment] is not a positive integer. *)
+
+val get_char: t -> int -> char
+(** [get_char t off] returns the character contained in the cstruct
+    at offset [off].
+    @raise Invalid_argument if the offset exceeds cstruct length. *)
+
+val get_uint8: t -> int -> uint8
+(** [get_uint8 t off] returns the byte contained in the cstruct
+    at offset [off].
+    @raise Invalid_argument if the offset exceeds cstruct length. *)
+
+val set_char: t -> int -> char -> unit
+(** [set_char t off c] sets the byte contained in the cstruct
+    at offset [off] to character [c].
+    @raise Invalid_argument if the offset exceeds cstruct length. *)
+
+val set_uint8: t -> int -> uint8 -> unit
+(** [set_uint8 t off c] sets the byte contained in the cstruct
+    at offset [off] to byte [c].
+    @raise Invalid_argument if the offset exceeds cstruct length. *)
+
+val sub: t -> int -> int -> t
+(** [sub cstr off len] is [{ t with off = t.off + off; len }]
+    @raise Invalid_argument if the offset exceeds cstruct length. *)
+
+val sub_copy: t -> int -> int -> t
+(** [sub_copy cstr off len] is a new copy of [sub cstr off len],
+    that does not share the underlying buffer of [cstr].
+    @raise Invalid_argument if the offset exceeds cstruct length. *)
+
+val shift: t -> int -> t
+(** [shift cstr len] is [{ cstr with off=t.off+len; len=t.len-len }]
+    @raise Invalid_argument if the offset exceeds cstruct length. *)
+
+val copy: t -> int -> int -> string
+[@@ocaml.alert deprecated "this is just like [to_string] without defaults, were you looking for [sub_copy]?"]
+(** [copy cstr off len] is the string representation of the segment of
+    [t] starting at [off] of size [len]. It is equivalent to
+    [Cstruct.to_string cstr ~off ~len].
+    @raise Invalid_argument if [off] and [len] do not designate a
+    valid segment of [t]. *)
+
+val blit: t -> int -> t -> int -> int -> unit
+(** [blit src srcoff dst dstoff len] copies [len] characters from
+    cstruct [src], starting at index [srcoff], to cstruct [dst],
+    starting at index [dstoff]. It works correctly even if [src] and
+    [dst] are the same string, and the source and destination
+    intervals overlap.
+
+    @raise Invalid_argument if [srcoff] and [len] do not designate a
+    valid segment of [src], or if [dstoff] and [len] do not designate
+    a valid segment of [dst]. *)
+
+val blit_from_string: string -> int -> t -> int -> int -> unit
+(** [blit_from_string src srcoff dst dstoff len] copies [len]
+    characters from string [src], starting at index [srcoff], to
+    cstruct [dst], starting at index [dstoff].
+
+    @raise Invalid_argument if [srcoff] and [len] do not designate a
+    valid substring of [src], or if [dstoff] and [len] do not
+    designate a valid segment of [dst]. *)
+
+val blit_from_bytes: bytes -> int -> t -> int -> int -> unit
+(** [blit_from_bytes src srcoff dst dstoff len] copies [len]
+    characters from bytes [src], starting at index [srcoff], to
+    cstruct [dst], starting at index [dstoff].
+
+    @raise Invalid_argument if [srcoff] and [len] do not designate a
+    valid subsequence of [src], or if [dstoff] and [len] do not
+    designate a valid segment of [dst]. *)
+
+val blit_to_bytes: t -> int -> bytes -> int -> int -> unit
+(** [blit_to_bytes src srcoff dst dstoff len] copies [len] characters
+    from cstruct [src], starting at index [srcoff], to the [dst] buffer,
+    starting at index [dstoff].
+
+    @raise Invalid_argument if [srcoff] and [len] do not designate a
+    valid segment of [src], or if [dstoff] and [len] do not designate
+    a valid segment of [dst]. *)
+
+val memset: t -> int -> unit
+(** [memset t x] sets all the bytes of [t] to [x land 0xff]. *)
+
+val split: ?start:int -> t -> int -> t * t
+(** [split ~start cstr len] is a tuple containing the cstruct
+    extracted from [cstr] at offset [start] (default: 0) of length
+    [len] as first element, and the rest of [cstr] as second
+    element.
+    @raise Invalid_argument if [start] exceeds the cstruct length,
+    or if there is a bounds violation of the cstruct via [len+start]. *)
+
+val to_string: ?off:int -> ?len:int -> t -> string
+(** [to_string ~off ~len t] will allocate a fresh OCaml [string] and copy the
+    contents of the cstruct starting at offset [off] (default [0]) of length
+    [len] (default [Cstruct.length t - off]) into it, and return that string.
+
+    @raise Invalid_argument if [off] or [len] is negative, or
+    [Cstruct.length t - off] < [len]. *)
+
+val to_hex_string : ?off:int -> ?len:int -> t -> string
+(** [to_hex_string ~off ~len t] is a fresh OCaml [string] containing
+    the hex representation of [sub t off len]. It is therefore of length
+    [2 * len]. This string can be read back into a Cstruct using {!of_hex}.
+    @raise Invalid_argument if [off] or [len] is negative, or
+      if [Cstruct.length t - off < len].
+    @since 6.2 *)
+
+val to_bytes: ?off:int -> ?len:int -> t -> bytes
+(** [to_bytes ~off ~len t] will allocate a fresh OCaml [bytes] and copy the
+    contents of the cstruct starting at offset [off] (default [0]) of length
+    [len] (default [Cstruct.length t - off]) into it, and return that bytes.
+
+    @raise Invalid_argument if [off] or [len] is negative, or
+    [Cstruct.length str - off] < [len]. *)
+
+module BE : sig
+
+  (** Get/set big-endian integers of various sizes. The second
+      argument of those functions is the position relative to the
+      current offset of the cstruct. *)
+
+  val get_uint16: t -> int -> uint16
+  (** [get_uint16 cstr off] is the 16 bit long big-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val get_uint32: t -> int -> uint32
+  (** [get_uint32 cstr off] is the 32 bit long big-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val get_uint64: t -> int -> uint64
+  (** [get_uint64 cstr off] is the 64 bit long big-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint16: t -> int -> uint16 -> unit
+  (** [set_uint16 cstr off i] writes the 16 bit long big-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint32: t -> int -> uint32 -> unit
+  (** [set_uint32 cstr off i] writes the 32 bit long big-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint64: t -> int -> uint64 -> unit
+  (** [set_uint64 cstr off i] writes the 64 bit long big-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+end
+
+module LE : sig
+
+  (** Get/set little-endian integers of various sizes. The second
+      argument of those functions is the position relative to the
+      current offset of the cstruct. *)
+
+  val get_uint16: t -> int -> uint16
+  (** [get_uint16 cstr off] is the 16 bit long little-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val get_uint32: t -> int -> uint32
+  (** [get_uint32 cstr off] is the 32 bit long little-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val get_uint64: t -> int -> uint64
+  (** [get_uint64 cstr off] is the 64 bit long little-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint16: t -> int -> uint16 -> unit
+  (** [set_uint16 cstr off i] writes the 16 bit long little-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint32: t -> int -> uint32 -> unit
+  (** [set_uint32 cstr off i] writes the 32 bit long little-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint64: t -> int -> uint64 -> unit
+  (** [set_uint64 cstr off i] writes the 64 bit long little-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+end
+
+module HE : sig
+
+  (** Get/set host-endian integers of various sizes. The second
+      argument of those functions is the position relative to the
+      current offset of the cstruct. *)
+
+  val get_uint16: t -> int -> uint16
+  (** [get_uint16 cstr off] is the 16 bit long host-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val get_uint32: t -> int -> uint32
+  (** [get_uint32 cstr off] is the 32 bit long host-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val get_uint64: t -> int -> uint64
+  (** [get_uint64 cstr off] is the 64 bit long host-endian unsigned
+      integer stored in [cstr] at offset [off].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint16: t -> int -> uint16 -> unit
+  (** [set_uint16 cstr off i] writes the 16 bit long host-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint32: t -> int -> uint32 -> unit
+  (** [set_uint32 cstr off i] writes the 32 bit long host-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+
+  val set_uint64: t -> int -> uint64 -> unit
+  (** [set_uint64 cstr off i] writes the 64 bit long host-endian
+      unsigned integer [i] at offset [off] of [cstr].
+      @raise Invalid_argument if the buffer is too small. *)
+end
+
+(** {2 Debugging } *)
+
+val hexdump: t -> unit
+(** When the going gets tough, the tough hexdump their cstructs
+    and peer at it until the bug disappears.  This will directly
+    prettyprint the contents of the cstruct to the standard output. *)
+
+val hexdump_to_buffer: Buffer.t -> t -> unit
+(** [hexdump_to_buffer buf c] will append the pretty-printed hexdump
+    of the cstruct [c] to the buffer [buf]. *)
+
+val hexdump_pp: Format.formatter -> t -> unit
+(** [hexdump_pp f c] pretty-prints a hexdump of [c] to [f]. *)
+
+val debug: t -> string
+(** [debug t] will print out the internal details of a cstruct such
+    as its base offset and the length, and raise an assertion failure
+    if invariants have been violated.  Not intended for casual use. *)
+
+(** {2 List of buffers} *)
+
+val lenv: t list -> int
+(** [lenv cstrs] is the combined length of all cstructs in [cstrs].
+    @raise Invalid_argument if computing the sum overflows. *)
+
+val copyv: t list -> string
+(** [copyv cstrs] is the string representation of the concatenation of
+    all cstructs in [cstrs].
+    @raise Invalid_argument if the length of the result would
+    exceed [Sys.max_string_length]. *)
+
+val fillv: src:t list -> dst:t -> int * t list
+(** [fillv ~src ~dst] copies from [src] to [dst] until [src] is exhausted or [dst] is full.
+    Returns the number of bytes copied and the remaining data from [src], if any.
+    This is useful if you want buffer data into fixed-sized chunks. *)
+
+val shiftv: t list -> int -> t list
+(** [shiftv ts n] is [ts] without the first [n] bytes.
+    It has the property that [equal (concat (shiftv ts n)) (shift (concat ts) n)].
+    This operation is fairly fast, as it will share the tail of the list.
+    The first item in the returned list is never an empty cstruct,
+    so you'll get [[]] if and only if [lenv ts = n]. *)
+
+(** {2 Iterations} *)
+
+type 'a iter = unit -> 'a option
+(** Type of an iterator. *)
+
+val iter: (t -> int option) -> (t -> 'a) -> t -> 'a iter
+(** [iter lenf of_cstr cstr] is an iterator over [cstr] that returns
+    elements of size [lenf cstr] and type [of_cstr cstr]. *)
+
+val fold: ('b -> 'a -> 'b) -> 'a iter -> 'b -> 'b
+(** [fold f iter acc] is [(f iterN accN ... (f iter acc)...)]. *)
+
+val append: t -> t -> t
+(** [append t1 t2] is the concatenation [t1 || t2]. *)
+
+val concat: t list -> t
+(** [concat ts] is the concatenation of all the [ts]. It is not guaranteed that
+ * the result is a newly created [t] in the zero- and one-element cases. *)
+
+val rev: t -> t
+(** [rev t] is [t] in reverse order. The return value is a freshly allocated
+    cstruct, and the argument is not modified. *)
+
+(** {1 Helpers to parse.}
+
+    [Cstruct] is used to manipulate {i payloads} which can be formatted
+   according an {{:https://perdu.com/}RFC} or an user-defined format. In such context, this module
+   provides utilities to be able to easily {i parse} {i payloads}.
+
+    Due to the type {!Cstruct.t}, no copy are done when you use these utilities
+   and you are able to extract your information without a big performance cost.
+
+    More precisely, each values returned by these utilities will be located into
+   the minor-heap where the base buffer will never be copied or relocated.
+
+    For instance, to parse a Git tree object:
+
+{v
+  entry := perm ' ' name '\000' 20byte
+  tree  := entry *
+v}
+
+    {[
+      open Cstruct
+
+      let ( >>= ) = Option.bind
+
+      let rec hash_of_name ~name payload =
+        if is_empty payload then raise Not_found
+        else
+          cut ~sep:(v " ") payload >>= fun (_, payload) ->
+          cut ~sep:(v "\000") payload >>= fun (name', payload) ->
+          if name = name' then with_range ~len:20 payload
+          else hash_of_name ~name (shift payload 20)
+    ]}
+
+    A [Cstruct] defines a possibly empty subsequence of bytes in a {e base}
+   buffer (a {!Bigarray.Array1.t}).
+
+    The positions of a buffer [b] of length [l] are the slits found
+   before each byte and after the last byte of the buffer. They are
+   labelled from left to right by increasing number in the range \[[0];[l]\].
+
+{v
+positions  0   1   2   3   4    l-1    l
+           +---+---+---+---+     +-----+
+  indices  | 0 | 1 | 2 | 3 | ... | l-1 |
+           +---+---+---+---+     +-----+
+v}
+
+    The [i]th byte index is between positions [i] and [i+1].
+
+    Formally we define a subbuffer of [b] as being a subsequence
+   of bytes defined by a {e off} position and a {e len} number. When
+   [len] is [0] the subbuffer is {e empty}. Note that for a given
+   base buffer there are as many empty subbuffers as there are positions
+   in the buffer.
+
+    Like in strings, we index the bytes of a subbuffer using zero-based
+   indices.
+*)
+
+val get : t -> int -> char
+(** [get cs zidx] is the byte of [cs] at its zero-based index [zidx].
+    It's an alias of {!get_char}.
+
+    @raise Invalid_argument if [zidx] is not an index of [cs]. *)
+
+val get_byte : t -> int -> int
+(** [get_byte cs zidx] is [Char.code (get cs zidx)]. It's an alias of {!get_uint8}. *)
+
+val string : ?off:int -> ?len:int -> string -> t
+(** [string ~off ~len str] is the subbuffer of [str] that starts at position [off]
+   (defaults to [0]) and stops at position [off + len] (defaults to
+   [String.length str]). [str] is fully-replaced by an fresh allocated
+   {!type:buffer}.
+
+    @raise Invalid_argument if [off] or [off + len] are not positions of [str].
+*)
+
+val buffer : ?off:int -> ?len:int -> buffer -> t
+(** [buffer ~off ~len buffer] is the sub-part of [buffer] that starts at
+   position [off] (default to [0]) and stops at position [off + len] (default to
+   [Bigarray.Array1.dim buffer]). [buffer] is used as the base buffer of the
+   returned value (no major-heap allocation are performed).
+
+    @raise Invalid_argument if [off] or [off + len] are not positions of
+   [buffer]. *)
+
+val start_pos : t -> int
+(** [start_pos cs] is [cs]'s start position in the base {!type:buffer}. *)
+
+val stop_pos : t -> int
+(** [stop_pos cs] is [cs]'s stop position in the base {!type:buffer}. *)
+
+val length : t -> int
+(** Returns the length of the current cstruct view.  Note that this
+    length is potentially smaller than the actual size of the underlying
+    buffer, as the [sub] function can construct a smaller view. *)
+
+val head : ?rev:bool -> t -> char option
+(** [head cs] is [Some (get cs h)] with [h = 0] if [rev = false] (default) or [h
+   = length cs - 1] if [rev = true]. [None] is returned if [cs] is empty. *)
+
+val tail : ?rev:bool -> t -> t
+(** [tail cs] is [cs] without its first ([rev] is [false], default) or last
+   ([rev] is [true]) byte or [cs] is empty. *)
+
+val is_empty : t -> bool
+(** [is_empty cs] is [length cs = 0]. *)
+
+val is_prefix : affix:t -> t -> bool
+(** [is_prefix ~affix cs] is [true] iff [affix.[zidx] = cs.[zidx]] for all
+   indices [zidx] of [affix]. *)
+
+val is_suffix : affix:t -> t -> bool
+(** [is_suffix ~affix cs] is [true] iff [affix.[n - zidx] = cs.[m - zidx]] for
+   all indices [zidx] of [affix] with [n = length affix - 1] and [m = length cs
+   - 1]. *)
+
+val is_infix : affix:t -> t -> bool
+(** [is_infix ~affix cs] is [true] iff there exists an index [z] in [cs] such
+   that for all indices [zidx] of [affix] we have [affix.[zidx] = cs.[z +
+   zidx]]. *)
+
+val for_all : (char -> bool) -> t -> bool
+(** [for_all p cs] is [true] iff for all indices [zidx] of [cs], [p cs.[zidx] =
+   true]. *)
+
+val exists : (char -> bool) -> t -> bool
+(** [exists p cs] is [true] iff there exists an index [zidx] of [cs] with [p
+   cs.[zidx] = true]. *)
+
+val start : t -> t
+(** [start cs] is the empty sub-part at the start position of [cs]. *)
+
+val stop : t -> t
+(** [stop cs] is the empty sub-part at the stop position of [cs]. *)
+
+val trim : ?drop:(char -> bool) -> t -> t
+(** [trim ~drop cs] is [cs] with prefix and suffix bytes satisfying [drop] in
+   [cs] removed. [drop] defaults to [function ' ' | '\r' .. '\t' -> true | _ ->
+   false]. *)
+
+val span : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t
+(** [span ~rev ~min ~max ~sat cs] is [(l, r)] where:
+
+    {ul
+    {- if [rev] is [false] (default), [l] is at least [min] and at most
+       [max] consecutive [sat] satisfying initial bytes of [cs] or {!empty}
+       if there are no such bytes. [r] are the remaining bytes of [cs].}
+    {- if [rev] is [true], [r] is at least [min] and at most [max]
+       consecutive [sat] satisfying final bytes of [cs] or {!empty}
+       if there are no such bytes. [l] are the remaining bytes of [cs].}}
+
+    If [max] is unspecified the span is unlimited. If [min] is unspecified
+    it defaults to [0]. If [min > max] the condition can't be satisfied and
+    the left or right span, depending on [rev], is always empty. [sat]
+    defaults to [(fun _ -> true)].
+
+    The invariant [l ^ r = s] holds.
+
+    For instance, the {i ABNF} expression:
+
+{v
+  time := 1*10DIGIT
+v}
+
+    can be translated to:
+
+    {[
+      let (time, _) = span ~min:1 ~max:10 is_digit cs in
+    ]}
+
+    @raise Invalid_argument if [max] or [min] is negative. *)
+
+val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
+(** [take ~rev ~min ~max ~sat cs] is the matching span of {!span} without the remaining one.
+    In other words:
+
+    {[(if rev then snd else fst) @@ span ~rev ~min ~max ~sat cs]} *)
+
+val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
+(** [drop ~rev ~min ~max ~sat cs] is the remaining span of {!span} without the matching one.
+    In other words:
+
+    {[(if rev then fst else snd) @@ span ~rev ~min ~max ~sat cs]} *)
+
+val cut : ?rev:bool -> sep:t -> t -> (t * t) option
+(** [cut ~sep cs] is either the pair [Some (l, r)] of the two
+    (possibly empty) sub-buffers of [cs] that are delimited by the first
+    match of the non empty separator string [sep] or [None] if [sep] can't
+    be matched in [cs]. Matching starts from the beginning of [cs] ([rev] is
+    [false], default) or the end ([rev] is [true]).
+
+    The invariant [l ^ sep ^ r = s] holds.
+
+    For instance, the {i ABNF} expression:
+
+{v
+  field_name := *PRINT
+  field_value := *ASCII
+  field := field_name ":" field_value
+v}
+
+    can be translated to:
+
+    {[
+      match cut ~sep:":" value with
+      | Some (field_name, field_value) -> ...
+      | None -> invalid_arg "invalid field"
+    ]}
+
+    @raise Invalid_argument if [sep] is the empty buffer. *)
+
+val cuts : ?rev:bool -> ?empty:bool -> sep:t -> t -> t list
+(** [cuts ~sep cs] is the list of all sub-buffers of [cs] that are
+    delimited by matches of the non empty separator [sep]. Empty sub-buffers are
+    omitted in the list if [empty] is [false] (default to [true]).
+
+    Matching separators in [cs] starts from the beginning of [cs]
+    ([rev] is [false], default) or the end ([rev] is [true]). Once
+    one is found, the separator is skipped and matching starts again,
+    that is separator matches can't overlap. If there is no separator
+    match in [cs], the list [[cs]] is returned.
+
+    The following invariants hold:
+    {ul
+    {- [concat ~sep (cuts ~empty:true ~sep cs) = cs]}
+    {- [cuts ~empty:true ~sep cs <> []]}}
+
+    For instance, the {i ABNF} expression:
+
+{v
+  arg := *(ASCII / ",") ; any characters exclude ","
+  args := arg *("," arg)
+v}
+
+    can be translated to:
+
+    {[
+      let args = cuts ~sep:"," buffer in
+    ]}
+
+    @raise Invalid_argument if [sep] is the empty buffer. *)
+
+val fields : ?empty:bool -> ?is_sep:(char -> bool) -> t -> t list
+(** [fields ~empty ~is_sep cs] is the list of (possibly empty)
+    sub-buffers that are delimited by bytes for which [is_sep] is
+    [true]. Empty sub-buffers are omitted in the list if [empty] is
+    [false] (defaults to [true]). [is_sep c] if it's not define by the
+    user is [true] iff [c] is an US-ASCII white space character,
+    that is one of space [' '] ([0x20]), tab ['\t'] ([0x09]), newline
+    ['\n'] ([0x0a]), vertical tab ([0x0b]), form feed ([0x0c]), carriage
+    return ['\r'] ([0x0d]). *)
+
+val find : ?rev:bool -> (char -> bool) -> t -> t option
+(** [find ~rev sat cs] is the sub-buffer of [cs] (if any) that spans
+    the first byte that satisfies [sat] in [cs] after position [start cs]
+    ([rev] is [false], default) or before [stop cs] ([rev] is [true]).
+    [None] is returned if there is no matching byte in [s]. *)
+
+val find_sub : ?rev:bool -> sub:t -> t -> t option
+(** [find_sub ~rev ~sub cs] is the sub-buffer of [cs] (if any) that spans
+    the first match of [sub] in [cs] after position [start cs]
+    ([rev] is [false], default) or before [stop cs] ([rev] is [true]).
+    Only bytes are compared and [sub] can be on a different base buffer.
+    [None] is returned if there is no match of [sub] in [s]. *)
+
+val filter : (char -> bool) -> t -> t
+(** [filter sat cs] is the buffer made of the bytes of [cs] that satisfy [sat],
+    in the same order. *)
+
+val filter_map : (char -> char option) -> t -> t
+(** [filter_map f cs] is the buffer made of the bytes of [cs] as mapped by
+    [f], in the same order. *)
+
+val map : (char -> char) -> t -> t
+(** [map f cs] is [cs'] with [cs'.[i] = f cs.[i]] for all indices [i]
+    of [cs]. [f] is invoked in increasing index order. *)
+
+val mapi : (int -> char -> char) -> t -> t
+(** [map f cs] is [cs'] with [cs'.[i] = f i cs.[i]] for all indices [i]
+    of [cs]. [f] is invoked in increasing index order. *)
+
+(**/**)
+val sum_lengths : caller:string -> t list -> int
+(** [sum_lengths ~caller acc l] is [acc] plus the sum of the lengths
+    of the elements of [l].  Raises [Invalid_argument caller] if
+    arithmetic overflows. *)

unikernel/duniverse/ocaml-cstruct/lib/cstruct_cap.ml

@@ -0,0 +1,73 @@
+(*
+ * Copyright (c) 2012-2019 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2019 Romain Calascibetta <romain.calascibetta@gmail.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+include (Cstruct : module type of Cstruct with type t := Cstruct.t)
+
+type 'a rd = < rd: unit; .. > as 'a
+type 'a wr = < wr: unit; .. > as 'a
+
+type 'a t = Cstruct.t
+
+type rdwr =  < rd: unit; wr: unit; >
+type ro = < rd: unit; >
+type wo = < wr: unit; >
+
+external ro : 'a rd t -> ro t = "%identity"
+external wo : 'a wr t -> wo t = "%identity"
+
+let of_string = Cstruct.of_string ?allocator:None
+let of_bytes = Cstruct.of_bytes ?allocator:None
+
+let pp ppf t = Cstruct.hexdump_pp ppf t
+
+let length = Cstruct.length
+
+let blit src ~src_off dst ~dst_off ~len =
+  Cstruct.blit src src_off dst dst_off len
+[@@inline]
+
+let blit_from_string src ~src_off dst ~dst_off ~len =
+  Cstruct.blit_from_string src src_off dst dst_off len
+[@@inline]
+
+let blit_from_bytes src ~src_off dst ~dst_off ~len =
+  Cstruct.blit_from_bytes src src_off dst dst_off len
+[@@inline]
+
+let blit_to_bytes src ~src_off dst ~dst_off ~len =
+  Cstruct.blit_to_bytes src src_off dst dst_off len
+[@@inline]
+
+let sub t ~off ~len =
+  Cstruct.sub t off len
+[@@inline]
+
+let sub_copy t ~off ~len =
+  Cstruct.sub_copy t off len
+[@@inline]
+
+let unsafe_to_bigarray = Cstruct.to_bigarray
+
+let concat vss =
+  let res = create_unsafe (Cstruct.sum_lengths ~caller:"Cstruct.Cap.concat" vss) in
+  let go off v =
+    let len = Cstruct.length v in
+    Cstruct.blit v 0 res off len ;
+    off + len in
+  let len = List.fold_left go 0 vss in
+  assert (len = Cstruct.length res) ;
+  res

unikernel/duniverse/ocaml-cstruct/lib/cstruct_cap.mli

@@ -0,0 +1,672 @@
+(*
+ * Copyright (c) 2012-2019 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2019 Romain Calascibetta <romain.calascibetta@gmail.com>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Raw memory buffers with capabilities
+
+    [Cstruct_cap] wraps OCaml Stdlib's
+   {{:http://caml.inria.fr/pub/docs/manual-ocaml/libref/Bigarray.html}Bigarray}
+   module. Each [t] consists of a proxy (consisting of offset, length, and the
+   actual {!Bigarray.t} buffer). The goal of this module is two-fold: enable
+   zero-copy - the underlying buffer is shared by most of the functions - and
+   static checking of read and write capabilities to the underlying buffer
+   (using phantom types).
+
+    Each ['a t] is parameterized by the available capabilities: read ([rd]) and
+   write ([wr]): to access the contents of the buffer the [read] capability is
+   necessary, for modifying the content of the buffer the [write] capability is
+   necessary. Capabilities can only be dropped, never gained, to a buffer.  If
+   code only has read capability, this does not mean that there is no other code
+   fragment with write capability to the underlying buffer.
+
+    The functions that retrieve bytes ({!get_uint8} etc.) require a [read]
+   capability, functions mutating the underlying buffer ({!set_uint8} etc.)
+   require a [write] capability. Allocation of a buffer (via {!create}, ...)
+   returns a [t] with read and write capabilities. {!val:ro} drops the write
+   capability, {!val:wo} drops the read capability. The only exception is
+   {!unsafe_to_bigarray} that returns the underlying [Bigarray.t].
+
+    Accessors and mutators for fixed size integers (8, 16, 32, 64 bit) are
+   provided for big-endian and little-endian encodings.  *)
+
+(** {2 Types} *)
+
+type 'a rd = < rd: unit; .. > as 'a
+(** Type of read capability. *)
+
+type 'a wr = < wr: unit; .. > as 'a
+(** Type of write capability. *)
+
+type 'a t
+(** Type of cstruct with capabilities ['a]. *)
+
+type buffer = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+(** Type of buffer. A {!t} is composed of an underlying buffer. *)
+
+type rdwr = < rd: unit; wr: unit; >
+(** Type of both read and write capability. *)
+
+type ro = < rd: unit; >
+(** Type of only read capability. *)
+
+type wo = < wr: unit; >
+(** Type of only write capability. *)
+
+type uint8 = int
+(** 8-bit unsigned integer. *)
+
+type uint16 = int
+(** 16-bit unsigned integer. *)
+
+type uint32 = int32
+(** 32-bit unsigned integer. *)
+
+type uint64 = int64
+(** 64-bit unsigned integer. *)
+
+(** {2 Capabilities} *)
+
+val ro : 'a rd t -> ro t
+(** [ro t] is [t'] with only read capability. *)
+
+val wo : 'a wr t -> wo t
+(** [wo t] is [t'] with only write capability. *)
+
+(** {2 Basic operations} *)
+
+val equal : 'a rd t -> 'b rd t -> bool
+(** [equal a b] is [true] iff [a] and [b] correspond to the same sequence of
+    bytes (it uses [memcmp] internally). Both [a] and [b] need at least read
+    capability {!rd}. *)
+
+val compare : 'a rd t -> 'b rd t -> int
+(** [compare a b] gives an unspecified total ordering over {!t}. Both [a] and
+    [b] need at least read capability {!rd}. *)
+
+val pp : Format.formatter -> 'a rd t -> unit
+(** [pp ppf t] pretty-prints [t] on [ppf]. [t] needs read capability {!rd}. *)
+
+val length : 'a t -> int
+(** [length t] return length of [t]. Note that this length is potentially
+   smaller than the actual size of the underlying buffer, as functions such as
+   {!sub}, {!shift}, and {!split} can construct a smaller view. *)
+
+val check_alignment : 'a t -> int -> bool
+(** [check_alignment t alignment] is [true] if the first byte stored
+    in the underlying buffer of [t] is at a memory address where
+    [address mod alignment = 0], [false] otherwise. The [mod] used has the
+    C/OCaml semantic (which differs from Python).
+    Typical uses are to check a buffer is aligned to a page or disk sector
+    boundary.
+
+    @raise Invalid_argument if [alignment] is not a positive integer. *)
+
+val lenv : 'a t list -> int
+(** [lenv vs] is the combined length of all {!t} in [vs].
+
+    @raise Invalid_argument if computing the sum overflows. *)
+
+(** {2 Constructors} *)
+
+val create : int -> rdwr t
+(** [create len] allocates a buffer and proxy with both read and write
+    capabilities of size [len]. It is filled with zero bytes. *)
+
+val create_unsafe : int -> rdwr t
+(** [create_unsafe len] allocates a buffer and proxy with both read and
+    write capabilities of size [len].
+
+    Note that the returned [t] will contain arbitrary data, likely including
+    the contents of previously-deallocated cstructs.
+
+    Beware!
+
+    Forgetting to replace this data could cause your application to leak
+    sensitive information. *)
+
+(** {2 Subviews} *)
+
+val sub : 'a t -> off:int -> len:int -> 'a t
+(** [sub t ~off ~len] returns a proxy which shares the underlying buffer of [t].
+    It is sliced at offset [off] and of length [len]. The returned value has the
+    same capabilities as [t].
+
+    @raise Invalid_argument if the offset exceeds [t] length. *)
+
+val sub_copy : 'a t -> off:int -> len:int -> rdwr t
+(** [sub_copy t ~off ~len] is a new copy of [sub t ~off ~len],
+    that does not share the underlying buffer of [t].
+    The returned value has read-write capabilities because it doesn't
+    affect [t].
+
+    @raise Invalid_argument if the offset exceeds [t] length. *)
+
+val shift : 'a t -> int -> 'a t
+(** [shift t len] returns a proxy which shares the underlying buffer of [t]. The
+    returned value starts [len] bytes later than the given [t]. The returned
+    value has the same capabilities as [t].
+
+    @raise Invalid_argument if the offset exceeds [t] length. *)
+
+val shiftv: 'a t list -> int -> 'a t list
+(** [shiftv ts n] is [ts] without the first [n] bytes.
+    It has the property that [equal (concat (shiftv ts n)) (shift (concat ts) n)].
+    This operation is fairly fast, as it will share the tail of the list.
+    The first item in the returned list is never an empty cstruct,
+    so you'll get [[]] if and only if [lenv ts = n]. *)
+
+val split : ?start:int -> 'a t -> int -> 'a t * 'a t
+(** [split ~start t len] returns two proxies extracted from [t]. The first
+    starts at offset [start] (default [0]), and is of length [len]. The second
+    is the remainder of [t]. The underlying buffer is shared, the capabilities
+    are preserved.
+
+    @raise Invalid_argument if [start] exceeds the length of [t],
+    or if there is a bounds violation of [t] via [len + start]. *)
+
+val copy : 'a t -> int -> int -> string
+[@@ocaml.alert deprecated "this is just like [to_string] without defaults, were you looking for [sub_copy]?"]
+(** [copy cstr off len] is the same as [Cstruct.to_string cstr ~off ~len]. *)
+
+(** {2 Construction from existing t} *)
+
+val append : 'a rd t -> 'b rd t -> rdwr t
+(** [append a b] allocates a buffer [r] of size [length a + length b]. Then the
+    content of [a] is copied at the start of the buffer [r], and [b] is copied
+    behind [a]'s end in [r]. [a] and [b] need at least read capability {!rd},
+    the returned value has both read and write capabilities. *)
+
+val concat : 'a rd t list -> rdwr t
+(** [concat vss] allocates a buffer [r] of size [lenv vss]. Each [v] of [vss]
+    is copied into the buffer [r]. Each [v] of [vss] need at least read
+    capability {!rd}, the returned value has both read and write capabilities.
+*)
+
+val fillv : src:'a rd t list -> dst:'b wr t -> int * 'a rd t list
+(** [fillv ~src ~dst] copies from [src] to [dst] until [src] is exhausted or
+    [dst] is full. It returns the number of bytes copied and the remaining data
+    from [src], if any. This is useful if you want to {i bufferize} data into
+    fixed-sized chunks. Each {!t} of [src] need at least read capability {!rd}.
+    [dst] needs at least write capability {!wr}. *)
+
+val rev : 'a rd t -> rdwr t
+(** [rev t] allocates a buffer [r] of size [length t], and fills it with the
+    bytes of [t] in reverse order. The given [t] needs at least read capability
+    {!rd}, the returned value has both read and write capabilities. *)
+
+(** {2 Mutation of the underlying buffer} *)
+
+val memset : 'a wr t -> int -> unit
+(** [memset t x] sets all bytes of [t] to [x land 0xFF]. [t] needs at least
+    write capability {!wr}. *)
+
+val blit : 'a rd t -> src_off:int -> 'b wr t -> dst_off:int -> len:int -> unit
+(** [blit src ~src_off dst ~dst_off ~len] copies [len] bytes from [src] starting
+    at index [src_off] to [dst] starting at index [dst_off]. It works correctly
+    even if [src] and [dst] refer to the same underlying buffer, and the [src]
+    and [dst] intervals overlap.  This function uses [memmove] internally.
+
+    [src] needs at least read capability {!rd}. [dst] needs at least
+    write capability {!wr}.
+
+    @raise Invalid_argument if [src_off] and [len] do not designate a valid
+    segment of [src], or if [dst_off] and [len] do not designate a valid segment
+    of [dst]. *)
+
+val blit_from_string : string -> src_off:int -> 'a wr t -> dst_off:int ->
+  len:int -> unit
+(** [blit_from_string src ~src_off dst ~dst_off ~len] copies [len] byres from
+    [src] starting at index [src_off] to [dst] starting at index [dst_off]. This
+    function uses [memcpy] internally.
+
+    [dst] needs at least write capability {!wr}.
+
+    @raise Invalid_argument if [src_off] and [len] do not designate a valid
+    sub-string of [src], or if [dst_off] and [len] do not designate a valid
+    segment of [dst]. *)
+
+val blit_from_bytes : bytes -> src_off:int -> 'a wr t -> dst_off:int -> len:int
+  -> unit
+(** [blit_from_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from
+    [src] starting at index [src_off] to [dst] starting at index [dst_off]. This
+    uses [memcpy] internally.
+
+    [dst] needs at least write capability {!wr}.
+
+    @raise Invalid_argument if [src_off] and [len] do not designate a valid
+    sub-sequence of [src], or if [dst_off] and [len] do no designate a valid
+    segment of [dst]. *)
+
+(** {2 Converters: string, bytes, bigarray} *)
+
+val of_string : ?off:int -> ?len:int -> string -> rdwr t
+(** [of_string ~off ~len s] allocates a buffer and copies the contents of [s]
+    into it starting at offset [off] (default [0]) and of length [len] (default
+    [String.length s - off]). The returned value has both read and write
+    capabilities.
+
+    @raise Invalid_argument if [off] and [len] does not designate a valid
+    segment of [s]. *)
+
+val to_string : ?off:int -> ?len:int -> 'a rd t -> string
+(** [to_string ~off ~len t] is the string representation of the segment of [t]
+    starting at [off] (default [0]) of size [len] (default [length t - off]).
+    [t] needs at least read capability {!rd}.
+
+    @raise Invalid_argument if [off] and [len] does not designate a valid
+    segment of [t]. *)
+
+val to_hex_string : ?off:int -> ?len:int -> _ rd t -> string
+(** [to_hex_string ~off ~len t] is a fresh OCaml [string] containing
+    the hex representation of [sub t off len]. See {!Cstruct.to_hex_string}.
+    @raise Invalid_argument if [off] or [len] is negative, or
+      if [Cstruct.length t - off < len].
+    @since 6.2 *)
+
+val of_hex : ?off:int -> ?len:int -> string -> rdwr t
+(** [of_hex ~off ~len s] allocates a buffer and copies the content of [s]
+    starting at offset [off] (default [0]) of length [len] (default
+    [String.length s - off]), decoding the hex-encoded characters.
+    Whitespaces in the string are ignored, every pair of hex-encoded characters
+    in [s] are converted to one byte in the returned {!t}, which is exactly
+    half the size of the non-whitespace characters of [s] from [off] of length
+    [len].
+
+    @raise Invalid_argument is the input string contains invalid characters or
+    an off number of non-whitespace characters. *)
+
+val copyv : 'a rd t list -> string
+(** [copy vs] is the string representation of the concatenation of all {!t} in
+    [vs]. Each {!t} need at least read capability {!rd}.
+
+    @raise Invalid_argument if the length of the result would exceed
+    {!Sys.max_string_length}. *)
+
+val of_bytes : ?off:int -> ?len:int -> bytes -> rdwr t
+(** [of_bytes ~off ~len b] allocates a buffer and copies the contents of [b]
+    into it starting at offset [off] (default [0]) and of length [len] (default
+    [Bytes.length b - off]). The returned value has both read and write
+    capabilities.
+
+    @raise Invalid_argument if [off] and [len] does not designate a valid
+    segment of [s]. *)
+
+val to_bytes : ?off:int -> ?len:int -> 'a rd t -> bytes
+(** [to_bytes ~off ~len t] is the bytes representation of the segment of [t]
+    starting at [off] (default [0]) of size [len] (default [length t - off]).
+    [t] needs at least read capability {!rd}.
+
+    @raise Invalid_argument if [off] and [len] do not designate a valid
+    segment of [t]. *)
+
+val blit_to_bytes : 'a rd t -> src_off:int -> bytes -> dst_off:int -> len:int
+  -> unit
+(** [blit_to_bytes src ~src_off dst ~dst_off ~len] copies length [len] bytes
+    from [src], starting at index [src_off], to sequences [dst], starting at
+    index [dst_off]. [blit_to_bytes] uses [memcpy] internally.
+
+    [src] needs at least read capability {!rd}.
+
+    @raise Invalid_argument if [src_off] and [len] do not designate a valid
+    segment of [src], or if [dst_off] and [len] do not designate a valid
+    sub-seuqnce of [dst]. *)
+
+val of_bigarray: ?off:int -> ?len:int -> buffer -> rdwr t
+(** [of_bigarray ~off ~len b] is a proxy that contains [b] with offset [off]
+    (default [0]) of length [len] (default [Bigarray.Array1.dim b - off]). The
+    returned value has both read and write capabilties.
+
+    @raise Invalid_argument if [off] and [len] do not designate a valid
+    segment of [b]. *)
+
+val unsafe_to_bigarray : 'a t -> buffer
+(** [unsafe_to_bigarray t] converts [t] into a {!buffer} Bigarray, using the
+    Bigarray slicing to allocate a fresh {i proxy} Bigarray that preserves
+    sharing of the underlying buffer.
+
+    In other words:
+
+    {[let t = Cstruct_cap.create 10 in
+      let b = Cstruct_cap.unsafe_to_bigarray t in
+      Bigarray.Array1.set b 0 '\x42' ;
+      assert (Cstruct_cap.get_char t 0 = '\x42')]} *)
+
+(** {2 Higher order functions} *)
+
+type 'a iter = unit -> 'a option
+(** Type of iterator. *)
+
+val iter : ('a rd t -> int option) -> ('a rd t -> 'v) -> 'a rd t -> 'v iter
+(** [iter lenf of_cstruct t] is an iterator over [t] that returns elements of
+    size [lenf t] and type [of_cstruct t]. [t] needs at least read capability
+    {!rd} and [iter] keeps capabilities of [t] on [of_cstruct]. *)
+
+val fold : ('acc -> 'x -> 'acc) -> 'x iter -> 'acc -> 'acc
+(** [fold f iter acc] is [(f iterN accN ... (f iter acc)...)]. *)
+
+(** {2 Accessors and mutators} *)
+
+val get_char : 'a rd t -> int -> char
+(** [get_char t off] returns the character contained in [t] at offset [off].
+    [t] needs at least read capability {!rd}.
+
+    @raise Invalid_argument if the offset exceeds [t] length. *)
+
+val set_char : 'a wr t -> int -> char -> unit
+(** [set_char t off c] sets the character contained in [t] at offset [off]
+    to character [c]. [t] needs at least write capability {!wr}.
+
+    @raise Invalid_argument if the offset exceeds [t] length. *)
+
+val get_uint8 : 'a rd t -> int -> uint8
+(** [get_uint8 t off] returns the byte contained in [t] at offset [off].
+    [t] needs at least read capability {!rd}.
+
+    @raise Invalid_argument if the offset exceeds [t] length. *)
+
+val set_uint8 : 'a wr t -> int -> uint8 -> unit
+(** [set_uint8 t off x] sets the byte contained in [t] at offset [off]
+    to byte [x]. [t] needs at least write capability {!wr}.
+
+    @raise Invalid_argument if the offset exceeds [t] length. *)
+
+module BE : sig
+  (** {3 Big-endian Byte Order}
+
+      The following operations assume a big-endian byte ordering of the
+      cstruct. If the machine-native byte ordering differs, then the get
+      operations will reorder the bytes so that they are in machine-native byte
+      order before returning the result, and the set operations will reorder the
+      bytes so that they are written out in the appropriate order.
+
+      Network byte order is big-endian, so you may need these operations when
+      dealing with raw frames, for example, in a userland networking stack. *)
+
+  val get_uint16 : 'a rd t -> int -> uint16
+  (** [get_uint16 t off] returns the two bytes in [t] starting at offset [off],
+      interpreted as an {!uint16}. [t] needs at least read capability {!rd}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 2]. *)
+
+  val get_uint32 : 'a rd t -> int -> uint32
+  (** [get_uint32 t off] returns the four bytes in [t] starting at offset [off].
+      [t] needs at least read capability {!rd}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 4]. *)
+
+  val get_uint64 : 'a rd t -> int -> uint64
+  (** [get_uint64 t off] returns the eight bytes in [t] starting at offset
+      [off]. [t] needs at least read capability {!rd}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 8]. *)
+
+  val set_uint16 : 'a wr t -> int -> uint16 -> unit
+  (** [set_uint16 t off v] sets the two bytes in [t] starting at offset [off] to
+      the value [v]. [t] needs at least write capability {!wr}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 2]. *)
+
+  val set_uint32 : 'a wr t -> int -> uint32 -> unit
+  (** [set_uint32 t off v] sets the four bytes in [t] starting at offset [off]
+      to the value [v]. [t] needs at least write capability {!wr}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 4]. *)
+
+  val set_uint64 : 'a wr t -> int -> uint64 -> unit
+  (** [set_uint64 t off v] sets the eight bytes in [t] starting at offset [off]
+      to the value [v]. [t] needs at least write capability {!wr}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 8]. *)
+end
+
+module LE : sig
+  (** {3 Little-endian Byte Order}
+
+      The following operations assume a little-endian byte ordering of the
+      cstruct. If the machine-native byte ordering differs, then the get
+      operations will reorder the bytes so that they are in machine-native byte
+      order before returning the result, and the set operations will reorder the
+      bytes so that they are written out in the appropriate order.
+
+      Most modern processor architectures are little-endian, so more likely than
+      not, these operations will not do any byte reordering. *)
+
+  val get_uint16 : 'a rd t -> int -> uint16
+  (** [get_uint16 t off] returns the two bytes in [t] starting at offset [off],
+      interpreted as an {!uint16}. [t] needs at least read capability {!rd}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 2]. *)
+
+  val get_uint32 : 'a rd t -> int -> uint32
+  (** [get_uint32 t off] returns the four bytes in [t] starting at offset [off].
+      [t] needs at least read capability {!rd}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 4]. *)
+
+  val get_uint64 : 'a rd t -> int -> uint64
+  (** [get_uint64 t off] returns the eight bytes in [t] starting at offset
+      [off]. [t] needs at least read capability {!rd}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 8]. *)
+
+  val set_uint16 : 'a wr t -> int -> uint16 -> unit
+  (** [set_uint16 t off v] sets the two bytes in [t] starting at offset [off] to
+      the value [v]. [t] needs at least write capability {!wr}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 2]. *)
+
+  val set_uint32 : 'a wr t -> int -> uint32 -> unit
+  (** [set_uint32 t off v] sets the four bytes in [t] starting at offset [off]
+      to the value [v]. [t] needs at least write capability {!wr}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 4]. *)
+
+  val set_uint64 : 'a wr t -> int -> uint64 -> unit
+  (** [set_uint64 t off v] sets the eight bytes in [t] starting at offset [off]
+      to the value [v]. [t] needs at least write capability {!wr}.
+
+      @raise Invalid_argument if offset [off] exceeds [length t - 8]. *)
+end
+
+(** {2 Helpers to parse with capabilities.}
+
+    As [Cstruct], capabilities interface provides helpers functions to help
+   the user to parse contents. *)
+
+val head : ?rev:bool -> 'a rd t -> char option
+(** [head cs] is [Some (get cs h)] with [h = 0] if [rev = false] (default) or [h
+   = length cs - 1] if [rev = true]. [None] is returned if [cs] is empty. *)
+
+val tail : ?rev:bool -> 'a rd t -> 'a rd t
+(** [tail cs] is [cs] without its first ([rev] is [false], default) or last
+   ([rev] is [true]) byte or [cs] is empty. *)
+
+val is_empty : 'a rd t -> bool
+(** [is_empty cs] is [length cs = 0]. *)
+
+val is_prefix : affix:'a rd t -> 'a rd t -> bool
+(** [is_prefix ~affix cs] is [true] iff [affix.[zidx] = cs.[zidx]] for all
+   indices [zidx] of [affix]. *)
+
+val is_suffix : affix:'a rd t -> 'a rd t -> bool
+(** [is_suffix ~affix cs] is [true] iff [affix.[n - zidx] = cs.[m - zidx]] for
+   all indices [zidx] of [affix] with [n = length affix - 1] and [m = length cs
+   - 1]. *)
+
+val is_infix : affix:'a rd t -> 'a rd t -> bool
+(** [is_infix ~affix cs] is [true] iff there exists an index [z] in [cs] such
+   that for all indices [zidx] of [affix] we have [affix.[zidx] = cs.[z +
+   zidx]]. *)
+
+val for_all : (char -> bool) -> 'a rd t -> bool
+(** [for_all p cs] is [true] iff for all indices [zidx] of [cs], [p cs.[zidx] =
+   true]. *)
+
+val exists : (char -> bool) -> 'a rd t -> bool
+(** [exists p cs] is [true] iff there exists an index [zidx] of [cs] with [p
+   cs.[zidx] = true]. *)
+
+val start : 'a rd t -> 'a rd t
+(** [start cs] is the empty sub-part at the start position of [cs]. *)
+
+val stop : 'a rd t -> 'a rd t
+(** [stop cs] is the empty sub-part at the stop position of [cs]. *)
+
+val trim : ?drop:(char -> bool) -> 'a rd t -> 'a rd t
+(** [trim ~drop cs] is [cs] with prefix and suffix bytes satisfying [drop] in
+   [cs] removed. [drop] defaults to [function ' ' | '\r' .. '\t' -> true | _ ->
+   false]. *)
+
+val span : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> 'a rd t -> 'a rd t * 'a rd t
+(** [span ~rev ~min ~max ~sat cs] is [(l, r)] where:
+
+    {ul
+    {- if [rev] is [false] (default), [l] is at least [min] and at most
+       [max] consecutive [sat] satisfying initial bytes of [cs] or {!is_empty}
+       if there are no such bytes. [r] are the remaining bytes of [cs].}
+    {- if [rev] is [true], [r] is at least [min] and at most [max]
+       consecutive [sat] satisfying final bytes of [cs] or {!is_empty}
+       if there are no such bytes. [l] are the remaining bytes of [cs].}}
+
+    If [max] is unspecified the span is unlimited. If [min] is unspecified
+    it defaults to [0]. If [min > max] the condition can't be satisfied and
+    the left or right span, depending on [rev], is always empty. [sat]
+    defaults to [(fun _ -> true)].
+
+    The invariant [l ^ r = s] holds.
+
+    For instance, the {i ABNF} expression:
+
+{v
+  time := 1*10DIGIT
+v}
+
+    can be translated to:
+
+    {[
+      let (time, _) = span ~min:1 ~max:10 is_digit cs in
+    ]}
+
+    @raise Invalid_argument if [max] or [min] is negative. *)
+
+val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> 'a rd t -> 'a rd t
+(** [take ~rev ~min ~max ~sat cs] is the matching span of {!span} without the remaining one.
+    In other words:
+
+    {[(if rev then snd else fst) @@ span ~rev ~min ~max ~sat cs]} *)
+
+val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> 'a rd t -> 'a rd t
+(** [drop ~rev ~min ~max ~sat cs] is the remaining span of {!span} without the matching one.
+    In other words:
+
+    {[(if rev then fst else snd) @@ span ~rev ~min ~max ~sat cs]} *)
+
+val cut : ?rev:bool -> sep:'a rd t -> 'a rd t -> ('a rd t * 'a rd t) option
+(** [cut ~sep cs] is either the pair [Some (l, r)] of the two
+    (possibly empty) sub-buffers of [cs] that are delimited by the first
+    match of the non empty separator string [sep] or [None] if [sep] can't
+    be matched in [cs]. Matching starts from the beginning of [cs] ([rev] is
+    [false], default) or the end ([rev] is [true]).
+
+    The invariant [l ^ sep ^ r = s] holds.
+
+    For instance, the {i ABNF} expression:
+
+{v
+  field_name := *PRINT
+  field_value := *ASCII
+  field := field_name ":" field_value
+v}
+
+    can be translated to:
+
+    {[
+      match cut ~sep:":" value with
+      | Some (field_name, field_value) -> ...
+      | None -> invalid_arg "invalid field"
+    ]}
+
+    @raise Invalid_argument if [sep] is the empty buffer. *)
+
+val cuts : ?rev:bool -> ?empty:bool -> sep:'a rd t -> 'a rd t -> 'a rd t list
+(** [cuts ~sep cs] is the list of all sub-buffers of [cs] that are
+    delimited by matches of the non empty separator [sep]. Empty sub-buffers are
+    omitted in the list if [empty] is [false] (default to [true]).
+
+    Matching separators in [cs] starts from the beginning of [cs]
+    ([rev] is [false], default) or the end ([rev] is [true]). Once
+    one is found, the separator is skipped and matching starts again,
+    that is separator matches can't overlap. If there is no separator
+    match in [cs], the list [[cs]] is returned.
+
+    The following invariants hold:
+    {ul
+    {- [concat ~sep (cuts ~empty:true ~sep cs) = cs]}
+    {- [cuts ~empty:true ~sep cs <> []]}}
+
+    For instance, the {i ABNF} expression:
+
+{v
+  arg := *(ASCII / ",") ; any characters exclude ","
+  args := arg *("," arg)
+v}
+
+    can be translated to:
+
+    {[
+      let args = cuts ~sep:"," buffer in
+    ]}
+
+    @raise Invalid_argument if [sep] is the empty buffer. *)
+
+val fields : ?empty:bool -> ?is_sep:(char -> bool) -> 'a rd t -> 'a rd t list
+(** [fields ~empty ~is_sep cs] is the list of (possibly empty)
+    sub-buffers that are delimited by bytes for which [is_sep] is
+    [true]. Empty sub-buffers are omitted in the list if [empty] is
+    [false] (defaults to [true]). [is_sep c] if it's not define by the
+    user is [true] iff [c] is an US-ASCII white space character,
+    that is one of space [' '] ([0x20]), tab ['\t'] ([0x09]), newline
+    ['\n'] ([0x0a]), vertical tab ([0x0b]), form feed ([0x0c]), carriage
+    return ['\r'] ([0x0d]). *)
+
+val find : ?rev:bool -> (char -> bool) -> 'a rd t -> 'a rd t option
+(** [find ~rev sat cs] is the sub-buffer of [cs] (if any) that spans
+    the first byte that satisfies [sat] in [cs] after position [start cs]
+    ([rev] is [false], default) or before [stop cs] ([rev] is [true]).
+    [None] is returned if there is no matching byte in [s]. *)
+
+val find_sub : ?rev:bool -> sub:'a rd t -> 'a rd t -> 'a rd t option
+(** [find_sub ~rev ~sub cs] is the sub-buffer of [cs] (if any) that spans
+    the first match of [sub] in [cs] after position [start cs]
+    ([rev] is [false], default) or before [stop cs] ([rev] is [true]).
+    Only bytes are compared and [sub] can be on a different base buffer.
+    [None] is returned if there is no match of [sub] in [s]. *)
+
+val filter : (char -> bool) -> 'a rd t -> 'a rd t
+(** [filter sat cs] is the buffer made of the bytes of [cs] that satisfy [sat],
+    in the same order. *)
+
+val filter_map : (char -> char option) -> 'a rd t -> rdwr t
+(** [filter_map f cs] is the buffer made of the bytes of [cs] as mapped by
+    [f], in the same order. *)
+
+val map : (char -> char) -> 'a rd t -> rdwr t
+(** [map f cs] is [cs'] with [cs'.[i] = f cs.[i]] for all indices [i]
+    of [cs]. [f] is invoked in increasing index order. *)
+
+val mapi : (int -> char -> char) -> 'a rd t -> rdwr t
+(** [map f cs] is [cs'] with [cs'.[i] = f i cs.[i]] for all indices [i]
+    of [cs]. [f] is invoked in increasing index order. *)

unikernel/duniverse/ocaml-cstruct/lib/cstruct_sexp.ml

@@ -0,0 +1,38 @@
+(*
+ * Copyright (c) 2012-2019 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+open Sexplib
+
+type buffer = Cstruct.buffer
+type t = Cstruct.t
+
+let buffer_of_sexp b = Conv.bigstring_of_sexp b
+let sexp_of_buffer b = Conv.sexp_of_bigstring b
+
+let t_of_sexp = function
+  | Sexp.Atom str ->
+      let n = String.length str in
+      let t = Cstruct.create_unsafe n in
+      Cstruct.blit_from_string str 0 t 0 n ;
+      t
+  | sexp -> Conv.of_sexp_error "Cstruct.t_of_sexp: atom needed" sexp
+
+let sexp_of_t t =
+  let n   = Cstruct.length t in
+  let str = Bytes.create n in
+  Cstruct.blit_to_bytes t 0 str 0 n ;
+  (* The following call is safe, since str is not visible elsewhere. *)
+  Sexp.Atom (Bytes.unsafe_to_string str)

unikernel/duniverse/ocaml-cstruct/lib/cstruct_sexp.mli

@@ -0,0 +1,37 @@
+(*
+ * Copyright (c) 2012-2019 Anil Madhavapeddy <anil@recoil.org>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+(** Sexpression serialisers for {!Cstruct.t} values *)
+
+type buffer = Cstruct.buffer
+(** [buffer] is an alias for the corresponding {!type:Cstruct.buffer} type *)
+
+val sexp_of_buffer : Cstruct.buffer -> Sexplib.Sexp.t
+(** [sexp_of_buffer b] returns the s-expression representation of the raw memory buffer [b] *)
+
+val buffer_of_sexp : Sexplib.Sexp.t -> Cstruct.buffer
+(** [buffer_of_sexp s] returns a fresh memory buffer from the s-expression [s].
+    [s] should have been constructed using {!sexp_of_buffer}. *)
+
+type t = Cstruct.t
+(** [t] is an alias for the corresponding {!Cstruct.t} type *)
+
+val sexp_of_t : t -> Sexplib.Sexp.t
+(** [sexp_of_t t] returns the s-expression representation of the Cstruct [t] *)
+
+val t_of_sexp : Sexplib.Sexp.t -> t
+(** [t_of_sexp s] returns a fresh {!Cstruct.t} that represents the
+     s-expression previously serialised by {!sexp_of_t}. *)

unikernel/duniverse/ocaml-cstruct/lib/cstruct_stubs.c

@@ -0,0 +1,81 @@
+/*
+ * Copyright (c) 2012 Anil Madhavapeddy <anil@recoil.org>
+ * Copyright (c) 2012 Pierre Chambart
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ */
+
+#include <string.h>
+#include <stdint.h>
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/bigarray.h>
+
+#ifndef Bytes_val
+#define Bytes_val String_val
+#endif
+
+CAMLprim value
+caml_blit_bigstring_to_string(value val_buf1, value val_ofs1, value val_buf2, value val_ofs2, value val_len)
+{
+  memcpy(Bytes_val(val_buf2) + Long_val(val_ofs2),
+         (char*)Caml_ba_data_val(val_buf1) + Long_val(val_ofs1),
+         Long_val(val_len));
+  return Val_unit;
+}
+
+CAMLprim value
+caml_blit_string_to_bigstring(value val_buf1, value val_ofs1, value val_buf2, value val_ofs2, value val_len)
+{
+  memcpy((char*)Caml_ba_data_val(val_buf2) + Long_val(val_ofs2),
+         String_val(val_buf1) + Long_val(val_ofs1),
+         Long_val(val_len));
+  return Val_unit;
+}
+
+CAMLprim value
+caml_blit_bigstring_to_bigstring(value val_buf1, value val_ofs1, value val_buf2, value val_ofs2, value val_len)
+{
+  memmove((char*)Caml_ba_data_val(val_buf2) + Long_val(val_ofs2),
+         (char*)Caml_ba_data_val(val_buf1) + Long_val(val_ofs1),
+         Long_val(val_len));
+  return Val_unit;
+}
+
+CAMLprim value
+caml_compare_bigstring(value val_buf1, value val_ofs1, value val_buf2, value val_ofs2, value val_len)
+{
+  int res = memcmp((char*)Caml_ba_data_val(val_buf1) + Long_val(val_ofs1),
+                   (char*)Caml_ba_data_val(val_buf2) + Long_val(val_ofs2),
+                   Long_val(val_len));
+  return Val_int(res);
+}
+
+CAMLprim value
+caml_fill_bigstring(value val_buf, value val_ofs, value val_len, value val_byte)
+{
+  memset((char*)Caml_ba_data_val(val_buf) + Long_val(val_ofs),
+         Int_val(val_byte),
+         Long_val(val_len));
+  return Val_unit;
+}
+
+CAMLprim value
+caml_check_alignment_bigstring(value val_buf, value val_ofs, value val_alignment)
+{
+  uint64_t address = (uint64_t) ((char *)Caml_ba_data_val(val_buf) + Long_val(val_ofs));
+  uintnat alignment = Unsigned_long_val(val_alignment);
+  return Val_bool(address % alignment == 0);
+}

unikernel/duniverse/ocaml-cstruct/lib/dune

@@ -0,0 +1,16 @@
+(library
+ (name cstruct)
+ (public_name cstruct)
+ (foreign_stubs
+  (language c)
+  (names cstruct_stubs))
+ (wrapped false)
+ (js_of_ocaml
+  (javascript_files cstruct.js))
+ (modules cstruct cstruct_cap))
+
+(library
+ (name cstruct_sexp)
+ (public_name cstruct-sexp)
+ (modules cstruct_sexp)
+ (libraries cstruct sexplib))