unikernel/duniverse/bstr/.gitignore

@@ -0,0 +1,16 @@
+_build
+setup.data
+setup.log
+doc/*.html
+*.native
+*.byte
+*.so
+lib/decompress_conf.ml
+*.tar.gz
+_tests
+lib_test/files
+zpipe
+c/dpipe
+*.merlin
+*.install
+.depend

unikernel/duniverse/bstr/.ocamlformat

@@ -0,0 +1,12 @@
+version=0.27.0
+exp-grouping=preserve
+break-infix=wrap-or-vertical
+break-collection-expressions=wrap
+break-sequences=false
+break-infix-before-func=false
+dock-collection-brackets=true
+break-separators=before
+field-space=tight
+if-then-else=compact
+break-sequences=false
+sequence-blank-line=compact

unikernel/duniverse/bstr/CHANGES.md

@@ -0,0 +1,7 @@
+### v0.0.2 (2025-06-23)
+
+- Fix SIGSEGV when we use `memmove`
+
+### v0.0.1 (2025-04-28)
+
+- First release of `bstr`, `slice` & `bin`

unikernel/duniverse/bstr/GNUmakefile

@@ -0,0 +1,54 @@
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+OCAMLDEP=ocamldep
+OCAMLMKLIB=ocamlmklib
+
+SRCS=lib/bstr.ml lib/slice.ml lib/bin.ml bin/generate.ml
+OBJS=$(SRCS:.ml=.cmo)
+OPTOBJS=$(SRCS:.ml=.cmx)
+
+OCAMLCFLAGS=-I lib -w "@1..3@5..28@30..39@43@46..47@49..57@61..62-40" \
+	-strict-sequence -strict-formats -short-paths -keep-locs -g -bin-annot-occurrences \
+	-no-alias-deps -opaque
+
+CFLAGS=-Wcast-align
+
+.SUFFIXES: .ml .mli .cmo .cmi .cmx .cma .cmxa
+
+.ml.cmo:
+	@echo "OCAMLC $<"
+	@$(OCAMLC) $(OCAMLCFLAGS) -c $<
+
+.mli.cmi:
+	@echo "OCAMLC $<"
+	@$(OCAMLC) $(OCAMLCFLAGS) -c $<
+
+.ml.cmx:
+	@echo "OCAMLOPT $<"
+	@$(OCAMLOPT) $(OCAMLCFLAGS) -c $<
+
+.cmo.cma:
+	@echo "OCAMLC -a $<"
+	@$(OCAMLC) -a $< $@
+
+.c.o:
+	@echo "CC $<"
+	@$(OCAMLC) -ccopt "$(CFLAGS)" $< -o $@
+
+.depend: $(SRCS)
+	@echo "OCAMLDEP **/*.mli **/*.ml"
+	@$(OCAMLDEP) **/*.mli **/*.ml > .depend
+	@echo "lib/bstr.o: lib/bstr.c" >> .depend
+	@echo "lib/bstr.cmxa: lib/bstr.cmx lib/bstr.o" >> .depend
+	@echo "lib/bstr.cma: lib/bstr.cmo lib/bstr.o" >> .depend
+
+include .depend
+
+lib/dllbstr.so lib/libbstr.a lib/bstr.cmxa lib/bstr.cma: lib/bstr.mllib
+	@echo "OCAMLMKLIB $^"
+	@$(OCAMLMKLIB) -o lib/bstr -oc lib/bstr -args $<
+
+.PHONY: clean
+clean:
+	rm -rf lib/*.cm{o,x,i,a,xa}
+	rm -rf lib/*.{o,a}

unikernel/duniverse/bstr/LICENSE.md

@@ -0,0 +1,20 @@
+The MIT License (MIT)
+
+Copyright (c) 2024 Romain Calascibetta
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of
+this software and associated documentation files (the "Software"), to deal in
+the Software without restriction, including without limitation the rights to
+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+the Software, and to permit persons to whom the Software is furnished to do so,
+subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

unikernel/duniverse/bstr/README.md

@@ -0,0 +1,122 @@
+# Bstr, Slice & Bin
+
+This small set of libraries offers a homogeneous API between 2 types and their
+derivations with the slice type, as well as a small DSL for decoding "packets"
+(such as ARP or DNS) without too much difficulty.
+
+The aim is to homogenize the 2 types bytes and bigstring and to derive them
+with a slice type, giving the user all the levers needed to manipulate byte
+sequences, whether in the form of a bigstring or bytes. The slice view avoids
+copying when it comes to decoding a packet and extracting a sub-part. The slice
+also applies to bigstrings, whose `Bigarray.Array1.sub` is more expensive.
+
+This set of libraries is a synthesis of [astring][astring] (which offers a range
+of useful functions as well as slice), [cstruct][cstruct] (which offers a
+similar API for bigstrings), [bigstringaf][bigstringaf] (which offers some other
+useful functions), the standard OCaml library and [repr][repr] for
+decoding/encoding these values into OCaml records/variants.
+
+## About API
+
+Here is an overview of the functions offered by `bstr` compared to other
+libraries:
+
+|                 | bstr | cstruct | bigstringaf | slice.bstr |
+|-----------------|------|---------|-------------|------------|
+|       `overlap` |   ✅ |      ❌ |          ❌ |         ✅ |
+|        `memcpy` |   ✅ |      ❌ |          ✅ |         ✅ |
+|       `memmove` |   ✅ |      ✅ |          ✅ |         ✅ |
+|      fast `sub` |   ❌ |      ❌ |          ❌ |         ✅ |
+|     fast `blit` |   ✅ |      ❌ |          ❌ |         ✅ |
+| release GC lock |   ✅ |      ❌ |          ❌ |         ✅ |
+| fast `contains` |   ✅ |      ❌ |          ✅ |         ✅ |
+
+### Fast `sub`
+
+`sub` is perhaps the most useful operation for a bigarray. In fact, unlike bytes
+and strings, sub offers a view (equivalent or smaller) of a bigarray without
+making a copy. If, for example, you need to decode[^1] a large sequence of bytes
+(without having the notion of a "stream"), it may be useful to use the `sub`
+operation to decode the information byte by byte and avoid copying throughout
+the decoding process.
+
+The implementation of `sub` proposed by `Bstr` is a little different from that
+of the standard OCaml library. In fact, it is specialized for a bigarray of
+dimension 1 containing bytes. In fact, the `Bigarray.Array1.sub` function is a
+little more generic and `Bstr` takes the opportunity to "specialize" the
+function according to our type.
+
+However, according to the representation proposed by `Cstruct`, `Cstruct.sub`
+remains **the fastest** operation compared to `Bstr` and `Bigstringaf`. If you
+want to have the same performance as `Cstruct`, the specialized `Slice` module
+for `Bstr.t` values is equivalent.
+
+Here is a comparative table of the `sub` function between all implementations
+(AMD Ryzen 9 7950X 16-Core Processor):
+
+|       | bigstringaf |   bstr | cstruct | slice |
+|-------|-------------|--------|---------|-------|
+| `sub` |     20.0 ns | 17.8ns |   2.8ns | 2.4ns |
+
+### Fast `blit`
+
+`blit` from a string or a bytes is a little faster than `Bigstringaf` and
+`Cstruct`. The difference basically lies in the fact that `Bstr.t` uses other
+"tags" to describe the FFI with the C `memcpy` function (specifically the
+[\[@untagged\]][untagged] tag).
+
+Here is a comparative table of the `blit_from_string` function between all the
+implementations:
+
+|                    | bigstringaf |  bstr | cstruct |
+|--------------------|-------------|-------|---------|
+| `blit_from_string` |       5.1ns | 4.3ns |   4.7ns |
+
+#### _mmaped_ or not? (GC lock)
+
+There are 2 ways to copy bytes between two bigarrays:
+- the "mmaped" version (`{memcpy,memmove}_mmaped`)
+- the simple version (`{memcpy,memmove}`)
+
+The first is quite specific because it releases the GC lock after a certain
+number of bytes (4096) have been copied. This can be advantageous if you want
+to make a large copy between two bigarrays in parallel in a `Thread`.
+
+If we specify _mmaped_, it is because the copy between two bigarrays, one of
+which **may** come from `Unix.map_file`, can also take time (and we may want to
+do it in parallel in a `Thread`) since it involves reading/writing on the disk.
+
+```ocaml
+let copy_to_file bstr filename () =
+  let len = Bstr.length bstr in
+  let fd = Unix.openfile filename Unix.[ O_WRONLY ] 0o644 in
+  let dst = Unix.map_file fd Bigarray.char Bigarray.c_layout false [| len |] in
+  let dst = Bigarray.array1_of_genarray dst in
+  Bstr.memcpy_mmaped bstr ~src_off:0 dst ~dst_off:0 ~len
+
+let () =
+  let th = Thread.create (copy_to_file bstr filename) () in
+  (* do something else in true parallel of [copy_to_file]. *)
+  (* the GC will not interrupt [th] during the copy. *)
+  Thread.join th
+```
+
+The simple version does **not** release the GC lock and only applies the
+desired function (`memmove` or `memcpy`).
+
+#### `memmove` or `memcpy`?
+
+`Bstr.blit` **always** uses the `memmove` function. However, it can be
+advantageous to use `memcpy` in a fairly specific case: when you know that the
+source refers to a memory area that is not shared with the destination.
+
+To find out, you can use the `Bstr.overlap` function, which checks whether or
+not the two bigarrays given have a common memory area.
+
+[^1]: `Bin` is currently being designed with this in mind.
+
+[astring]: https://github.com/dbuenzli/astring
+[cstruct]: https://github.com/mirage/ocaml-cstruct
+[repr]: https://github.com/mirage/repr
+[bigstringaf]: https://github.com/inhabitedtype/bigstringaf
+[untagged]: https://ocaml.org/manual/5.3/attributes.html

unikernel/duniverse/bstr/bench/blit.ml

@@ -0,0 +1,50 @@
+open Bechamel
+open Toolkit
+
+let src = String.make 256 '\x10'
+let cs = Cstruct.create 512
+let bstr = Bstr.create 512
+let bigstringaf = Bigstringaf.create 512
+let cstruct_blit () = Cstruct.blit_from_string src 0 cs 0 256
+let bstr_blit () = Bstr.blit_from_string src ~src_off:0 bstr ~dst_off:0 ~len:256
+
+let bigstringaf_blit () =
+  Bigstringaf.blit_from_string src ~src_off:0 bigstringaf ~dst_off:0 ~len:256
+
+let cstruct_blit = Staged.stage cstruct_blit
+let bstr_blit = Staged.stage bstr_blit
+let bigstringaf_blit = Staged.stage bigstringaf_blit
+let test0 = Test.make ~name:"Cstruct" cstruct_blit
+let test1 = Test.make ~name:"Bstr" bstr_blit
+let test2 = Test.make ~name:"Bigstringaf" bigstringaf_blit
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let tests =
+    Test.make_grouped ~name:"blit" ~fmt:"%s %s" [ test0; test1; test2 ]
+  in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg

unikernel/duniverse/bstr/bench/contains.ml

@@ -0,0 +1,75 @@
+let seed = "4EygbdYh+v35vvrmD9YYP4byT5E3H7lTeXJiIj+dQnc="
+let seed = Base64.decode_exn seed
+
+let seed =
+  let res = Array.make (String.length seed / 2) 0 in
+  for i = 0 to (String.length seed / 2) - 1 do
+    res.(i) <- (Char.code seed.[i * 2] lsl 8) lor Char.code seed.[(i * 2) + 1]
+  done;
+  res
+
+let random length =
+  let get _ =
+    match Random.int (10 + 26 + 26) with
+    | n when n < 10 -> Char.(chr (code '0' + n))
+    | n when n < 10 + 26 -> Char.(chr (code 'a' + n - 10))
+    | n -> Char.(chr (code 'A' + n - 10 - 26))
+  in
+  String.init length get
+
+let str = random 4096
+let chr_into_str = str.[Random.int 4096]
+
+open Bechamel
+open Toolkit
+
+let bstr_contains =
+  let bstr = Bstr.of_string str in
+  Test.make ~name:"bstr"
+  @@ Staged.stage
+  @@ fun () -> ignore (Bstr.contains bstr chr_into_str)
+
+let bigstringaf_contains =
+  let bstr = Bigstringaf.of_string str ~off:0 ~len:4096 in
+  Test.make ~name:"bigstringaf"
+  @@ Staged.stage
+  @@ fun () -> ignore (Bigstringaf.memchr bstr 0 chr_into_str 4096)
+
+let cstruct_contains =
+  let cs = Cstruct.of_string str in
+  let fn chr = chr == chr_into_str in
+  Test.make ~name:"cstruct"
+  @@ Staged.stage
+  @@ fun () -> ignore (Cstruct.exists fn cs)
+
+let tests =
+  Test.make_grouped ~name:"contains" ~fmt:"%s %s"
+    [ bstr_contains; bigstringaf_contains; cstruct_contains ]
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg

unikernel/duniverse/bstr/bench/dune

@@ -0,0 +1,87 @@
+(executable
+ (name sub)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries slice.bstr bstr cstruct bechamel bechamel-js))
+
+(rule
+ (targets sub.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./sub.exe))))
+
+(rule
+ (targets sub.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:sub.json} > %{targets}")))
+
+(executable
+ (name blit)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries bstr cstruct bechamel bechamel-js))
+
+(rule
+ (targets blit.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./blit.exe))))
+
+(rule
+ (targets blit.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:blit.json} > %{targets}")))
+
+(executable
+ (name equal)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries base64 slice.bstr bstr cstruct bigstringaf bechamel bechamel-js))
+
+(rule
+ (targets equal.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./equal.exe))))
+
+(rule
+ (targets equal.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:equal.json} > %{targets}")))
+
+(executable
+ (name contains)
+ (enabled_if
+  (= %{profile} benchmark))
+ (libraries slice.bstr base64 bigstringaf bstr cstruct bechamel bechamel-js))
+
+(rule
+ (targets contains.json)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ./contains.exe))))
+
+(rule
+ (targets contains.html)
+ (enabled_if
+  (= %{profile} benchmark))
+ (action
+  (system "%{bin:bechamel-html} < %{dep:contains.json} > %{targets}")))

unikernel/duniverse/bstr/bench/equal.ml

@@ -0,0 +1,77 @@
+let seed = "4EygbdYh+v35vvrmD9YYP4byT5E3H7lTeXJiIj+dQnc="
+let seed = Base64.decode_exn seed
+
+let seed =
+  let res = Array.make (String.length seed / 2) 0 in
+  for i = 0 to (String.length seed / 2) - 1 do
+    res.(i) <- (Char.code seed.[i * 2] lsl 8) lor Char.code seed.[(i * 2) + 1]
+  done;
+  res
+
+let random length =
+  let get _ =
+    match Random.int (10 + 26 + 26) with
+    | n when n < 10 -> Char.(chr (code '0' + n))
+    | n when n < 10 + 26 -> Char.(chr (code 'a' + n - 10))
+    | n -> Char.(chr (code 'A' + n - 10 - 26))
+  in
+  String.init length get
+
+let hash_eq_0 = random 4096
+let hash_eq_1 = Bytes.to_string (Bytes.of_string hash_eq_0)
+
+open Bechamel
+open Toolkit
+
+let bstr_equal =
+  let hash_eq_0 = Bstr.of_string hash_eq_0 in
+  let hash_eq_1 = Bstr.of_string hash_eq_1 in
+  Test.make ~name:"bstr"
+  @@ Staged.stage
+  @@ fun () -> Bstr.equal hash_eq_0 hash_eq_1
+
+let bigstringaf_equal =
+  let hash_eq_0 = Bigstringaf.of_string hash_eq_0 ~off:0 ~len:4096 in
+  let hash_eq_1 = Bigstringaf.of_string hash_eq_1 ~off:0 ~len:4096 in
+  Test.make ~name:"bigstringaf"
+  @@ Staged.stage
+  @@ fun () -> Bigstringaf.memcmp hash_eq_0 0 hash_eq_1 0 4096
+
+let cstruct_equal =
+  let hash_eq_0 = Cstruct.of_string hash_eq_0 in
+  let hash_eq_1 = Cstruct.of_string hash_eq_1 in
+  Test.make ~name:"cstruct"
+  @@ Staged.stage
+  @@ fun () -> Cstruct.equal hash_eq_0 hash_eq_1
+
+let tests =
+  Test.make_grouped ~name:"equal" ~fmt:"%s %s"
+    [ bstr_equal; bigstringaf_equal; cstruct_equal ]
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg

unikernel/duniverse/bstr/bench/sub.ml

@@ -0,0 +1,49 @@
+open Bechamel
+open Toolkit
+
+let cs = Cstruct.create 32
+let bstr = Bstr.create 32
+let slice : Slice_bstr.t = Slice_bstr.make bstr
+let cstruct_sub () = Cstruct.sub cs 8 8
+let bstr_sub () = Bstr.sub bstr ~off:8 ~len:8
+let bigstringaf_sub () = Bigstringaf.sub bstr ~off:8 ~len:8
+let slice_sub () = Slice.sub slice ~off:8 ~len:8
+let cstruct_sub = Staged.stage cstruct_sub
+let bstr_sub = Staged.stage bstr_sub
+let bigstringaf_sub = Staged.stage bigstringaf_sub
+let slice_sub = Staged.stage slice_sub
+let test0 = Test.make ~name:"Cstruct" cstruct_sub
+let test1 = Test.make ~name:"Bstr" bstr_sub
+let test2 = Test.make ~name:"Bigstringaf" bigstringaf_sub
+let test3 = Test.make ~name:"Slice" slice_sub
+
+let benchmark () =
+  let bootstrap = 0 and r_square = true and predictors = Measure.[| run |] in
+  let ols = Analyze.ols ~bootstrap ~r_square ~predictors in
+  let instances = Instance.[ monotonic_clock ] in
+  let limit = 2000
+  and stabilize = true
+  and quota = Time.second 1.0
+  and kde = Some 1000 in
+  let cfg = Benchmark.cfg ~limit ~stabilize ~quota ~kde () in
+  let tests =
+    Test.make_grouped ~name:"sub" ~fmt:"%s %s" [ test0; test1; test2; test3 ]
+  in
+  let raw = Benchmark.all cfg instances tests in
+  let res = List.map (fun i -> Analyze.all ols i raw) instances in
+  let res = Analyze.merge ols instances res in
+  (res, raw)
+
+let nothing _ = Ok ()
+let compare = String.compare
+
+let () =
+  let res = benchmark () in
+  let res =
+    let open Bechamel_js in
+    let dst = Channel stdout
+    and x_label = Measure.run
+    and y_label = Measure.label Instance.monotonic_clock in
+    emit ~dst nothing ~compare ~x_label ~y_label res
+  in
+  match res with Ok () -> () | Error (`Msg msg) -> failwith msg

unikernel/duniverse/bstr/bin.opam

@@ -0,0 +1,21 @@
+version: "0.0.2"
+opam-version: "2.0"
+name:         "bin"
+maintainer:   [ "Romain Calascibetta <romain.calascibetta@gmail.com>" ]
+authors:      [ "Romain Calascibetta <romain.calascibetta@gmail.com>" ]
+homepage:     "https://git.robur.coop/robur/bstr"
+bug-reports:  "https://git.robur.coop/robur/bstr"
+dev-repo:     "git+https://github.com/robur-coop/bstr"
+doc:          "https://robur-coop.github.io/bstr/"
+license:      "MIT"
+synopsis:     "A DSL to describe binary formats"
+
+build: [ "dune" "build" "-p" name "-j" jobs ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+
+depends: [
+  "ocaml"       {>= "4.14.0"}
+  "dune"        {>= "3.5.0"}
+  "slice"       {= version}
+]
+x-maintenance-intent: [ "(latest)" ]

unikernel/duniverse/bstr/bin/dune

@@ -0,0 +1,2 @@
+(executable
+ (name generate))

unikernel/duniverse/bstr/bin/generate.ml

@@ -0,0 +1,88 @@
+let module_to_be_replaced = ref "S"
+let new_module = ref "String"
+let input = ref None
+let output = ref None
+
+let splits ~sep str =
+  let sep_len = String.length sep in
+  if sep_len = 0 then invalid_arg "splits: empty separator not allowed";
+  let str_len = String.length str in
+  let max_sep_idx = sep_len - 1 in
+  let max_str_idx = str_len - sep_len in
+  let add_sub str ~start ~stop acc =
+    if start = stop then "" :: acc
+    else String.sub str start (stop - start) :: acc
+  in
+  let rec check_sep start i k acc =
+    if k > max_sep_idx then
+      let new_start = i + sep_len in
+      scan new_start new_start (add_sub str ~start ~stop:i acc)
+    else if str.[i + k] = sep.[k] then check_sep start i (k + 1) acc
+    else scan start (i + 1) acc
+  and scan start i acc =
+    if i > max_str_idx then
+      if start = 0 then [ str ]
+      else List.rev (add_sub str ~start ~stop:str_len acc)
+    else if str.[i] = sep.[0] then check_sep start i 1 acc
+    else scan start (i + 1) acc
+  in
+  scan 0 0 []
+
+let replace line module_to_be_replaced new_module =
+  let line = splits ~sep:(module_to_be_replaced ^ ".") line in
+  String.concat (new_module ^ ".") line
+
+let run () =
+  let ic, ic_finally =
+    match !input with
+    | Some filename ->
+        let ic = open_in_bin filename in
+        let finally () = close_in ic in
+        (ic, finally)
+    | None -> (stdin, ignore)
+  in
+  let oc, oc_finally =
+    match !output with
+    | Some filename ->
+        let oc = open_out filename in
+        let finally () = close_out oc in
+        (oc, finally)
+    | None -> (stdout, ignore)
+  in
+  Fun.protect ~finally:ic_finally @@ fun () ->
+  Fun.protect ~finally:oc_finally @@ fun () ->
+  let rec go () =
+    match input_line ic with
+    | line ->
+        let line = replace line !module_to_be_replaced !new_module in
+        output_string oc line; output_string oc "\n"; go ()
+    | exception End_of_file -> ()
+  in
+  go ()
+
+let usage =
+  "generate [-m module_to_be_replaced] [-n new_module] [-i input] [-o output] \
+   replaces all occurrences of [module_to_be_replaced] by [new_module] in \
+   [input] to [output]."
+
+let failwith fmt = Format.kasprintf failwith fmt
+
+let to_existing_filename var str =
+  if Sys.file_exists str && Sys.is_directory str = false then var := Some str
+  else failwith "%S does not exist" str
+
+let to_non_existing_filename var str =
+  if Sys.file_exists str = false then var := Some str
+  else failwith "%S already exists" str
+
+let args =
+  [
+    ("-m", Arg.Set_string module_to_be_replaced, "the module to be replaced")
+  ; ("-n", Arg.Set_string new_module, "the new module")
+  ; ("-i", Arg.String (to_existing_filename input), "the input")
+  ; ("-o", Arg.String (to_non_existing_filename output), "the output")
+  ]
+
+let () =
+  Arg.parse args ignore usage;
+  run ()

unikernel/duniverse/bstr/bstr.opam

@@ -0,0 +1,20 @@
+version: "0.0.2"
+opam-version: "2.0"
+name:         "bstr"
+maintainer:   [ "Romain Calascibetta <romain.calascibetta@gmail.com>" ]
+authors:      [ "Romain Calascibetta <romain.calascibetta@gmail.com>" ]
+homepage:     "https://git.robur.coop/robur/bstr"
+bug-reports:  "https://git.robur.coop/robur/bstr"
+dev-repo:     "git+https://github.com/robur-coop/bstr"
+doc:          "https://robur-coop.github.io/bstr/"
+license:      "MIT"
+synopsis:     "A simple library for bigstrings"
+
+build: [ "dune" "build" "-p" name "-j" jobs ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+
+depends: [
+  "ocaml"       {>= "4.14.0"}
+  "dune"        {>= "3.5.0"}
+]
+x-maintenance-intent: [ "(latest)" ]

unikernel/duniverse/bstr/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.7)
+(name bstr)
+(version v0.0.2)

unikernel/duniverse/bstr/lib/bin.mli

@@ -0,0 +1,295 @@
+(** [Bin] is a small library for encoding and decoding information from a buffer
+    (like a [bytes] or a [bigstring]). Unlike a {i parser combinator}, [Bin]
+    cannot decode a stream.
+
+    [Bin] can be used to project values coming from a pre-allocated buffer such
+    as a "framebuffer" (video, ethernet, etc.) or to inject values into it.
+    [Bin] can be seen as a library for describing (fairly basic) "C-like" types
+    of values that can be injected/projected into/from a particular memory area:
+
+    {[
+      #define PROPTAG_GET_COMMAND_LINE 0x00050001
+      #define VALUE_LENGTH_RESPONSE (1 << 31)
+
+      struct __attribute__((packed)) cmdline {
+        uint32_t id;
+        uint32_t value_len;
+        uint32_t param_len;
+        uint8    str[2048];
+      };
+
+      struct __attribute__((packed)) property_tag {
+        uint32_t id;
+        uint32_t value_len;
+        uint32_t param_len;
+      };
+
+      extern char _tags;
+
+      char *get_cmdline() {
+        struct cmdline p;
+        p.id = PROPTAG_GET_COMMAND_LINE;
+        p.value_len = len - sizeof(struct property_tag);
+        p.param_len = 2048 & ~VALUE_LENGTH_RESPONSE;
+        memcpy(&_tags, &p, sizeof(struct cmdline)); // inject
+        ...
+      }
+    ]}
+
+    [Bin] therefore allows you to describe a representation of a serialized
+    value in bytes and to associate with it a function that allows you to obtain
+    an OCaml value such as a record or a variant.
+
+    {[
+      open Bin
+
+      type cmdline = {
+          id: int32
+        ; value_len: int32
+        ; param_len: int32
+        ; cmdline: string
+      }
+
+      let cmdline =
+        record (fun id value_len param_len -> { id; value_len; param_len })
+        |+ field neint32 (Fun.const 0x00050001l)
+        |+ field neint32 (fun t -> t.value_len)
+        |+ field neint32 (fun t -> t.param_len)
+        |+ field cstring (fun t -> t.cmdline)
+        |> sealr
+
+      let encode_into tags ?(off = 0) value =
+        let off = ref off in
+        Bin.encode_bstr cmdline value tags off (* inject *)
+    ]}
+
+    Of course, it's not as fast as what we can do in C, but [Bin] has the
+    advantage of offering a small DSL that allows us to describe these types and
+    go directly to OCaml values, which is generally more pleasant to manipulate
+    with OCaml than to make C stubs. *)
+
+type 'a t
+
+(** {1:primitives Primitives.} *)
+
+val char : char t
+(** [char] is a representation of the character type. *)
+
+val uint8 : int t
+(** [uint8] is a representation of unsigned 8-bit integers. *)
+
+val int8 : int t
+(** [int8] is a representation of 8-bit integers. *)
+
+val beuint16 : int t
+(** [beint16] is a representation of big-endian unsigned 16-bit integers. *)
+
+val leuint16 : int t
+(** [leint16] is a representation of little-endian unsigned 16-bit integers. *)
+
+val neuint16 : int t
+(** [neint16] is a representation of native-endian unsigned 16-bit integers. *)
+
+val beint16 : int t
+(** [beint16] is a representation of big-endian 16-bit integers. *)
+
+val leint16 : int t
+(** [leint16] is a representation of little-endian 16-bit integers. *)
+
+val neint16 : int t
+(** [neint16] is a representation of native-endian 16-bit integers. *)
+
+val beint32 : int32 t
+(** [beint32] is a representation of big-endian 32-bit integers. *)
+
+val leint32 : int32 t
+(** [leint32] is a representation of little-endian 32-bit integers. *)
+
+val neint32 : int32 t
+(** [neint32] is a representation of native-endian 32-bit integers. *)
+
+val beint64 : int64 t
+(** [beint64] is a representation of big-endian 64-bit integers. *)
+
+val leint64 : int64 t
+(** [leint64] is a representation of little-endian 64-bit integers. *)
+
+val neint64 : int64 t
+(** [neint64] is a representation of native-endian 64-bit integers. *)
+
+val varint : int t
+
+val bytes : int -> string t
+(** [bytes n] is a representation of a bytes sequence of [n] byte(s). *)
+
+val bstr : int -> Bstr.t t
+(** [bstr n] is a representation of a bigstring of [n] byte(s). *)
+
+val cstring : string t
+val until : char -> string t
+
+val const : 'a -> 'a t
+(** [const v] is [v] without a serialization mechanism. *)
+
+val seq : len:int -> 'a t -> 'a array t
+(** [seq ~len v] is a representation of fixed-length arrays of values of type
+    [v]. *)
+
+val map : 'b t -> ('b -> 'a) -> ('a -> 'b) -> 'a t
+(** This combinator allows defining a representative of one type in terms of
+    another by supplying coercions between them. *)
+
+(* {2:records Records.}
+
+   {[
+     type header =
+       { version : int32
+       ; number : int32 }
+
+     let _PACK = 0x5041434bl
+
+     let header =
+       record (fun pack version number ->
+         if pack <> _PACK
+         then invalid_arg "Invalid PACK file";
+         { version; number })
+       |+ field beint32 (fun _ -> _PACK)
+       |+ field beint32 (fun t -> t.version)
+       |+ field beint32 (fun t -> t.number)
+       |> sealr
+   ]} *)
+
+type ('a, 'b, 'c) open_record
+(** The type for representing open records of type ['a] with a constructor of
+    ['b]. ['c] represents the remaining fields to be described using the
+    {!val:(|+)} operator. An open record initially stisfies ['c = 'b] and can be
+    {{!val:sealr} sealed} once ['c = 'a]. *)
+
+val record : 'b -> ('a, 'b, 'b) open_record
+(** [record f] is an incomplete representation of the record of type ['a] with
+    constructor [f]. To complete the representation, add fields with {!val:(|+)}
+    and then seal the record with {!val:sealr}. *)
+
+type ('a, 'b) field
+(** The type for fields holding values of type ['b] and belonging to a record of
+    type ['a]. *)
+
+val field : 'a t -> ('b -> 'a) -> ('b, 'a) field
+(** [field n t g] is the representation of the field called [n] of type [t] with
+    getter [g]. For instance:
+
+    {[
+      type t = { foo: string }
+
+      let foo = field cstring (fun t -> t.foo)
+    ]} *)
+
+val ( |+ ) :
+  ('a, 'b, 'c -> 'd) open_record -> ('a, 'c) field -> ('a, 'b, 'd) open_record
+(** [r |+ f] is the open record [r] augmented with the field [f]. *)
+
+val sealr : ('a, 'b, 'a) open_record -> 'a t
+(** [sealr r] seals the open record [r]. *)
+
+(** {2:variants Variants.}
+
+    {[
+      type t = Foo | Bar of string
+
+      let t =
+        variant (fun foo bar -> function Foo -> foo | Bar s -> bar s)
+        |~ case0 Foo
+        |~ case1 cstring (fun x -> Bar x)
+        |> sealv
+    ]} *)
+
+type ('a, 'b, 'c) open_variant
+(** The type for representing open variants of type ['a] with pattern-matching
+    of type ['b]. ['c] represents the remaining constructors to be described
+    using the {!val:(|~)} operator. An open variant initially satisfies
+    ['c = 'b] and can be {{!val:sealv} sealed} once ['c = 'a]. *)
+
+val variant : 'b -> ('a, 'b, 'b) open_variant
+(** [variant n p] is an incomplete representation of the variant type called [n]
+    of type ['a] using [p] to deconstruct values. To complete the
+    representation, add cases with {!val:(|~)} and then seal the variant with
+    {!val:sealv}. *)
+
+type ('a, 'b) case
+(** The type for representing variant cases of type ['a] with patterns of type
+    ['b]. *)
+
+type 'a case_p
+(** The type for representing patterns for a variant of type ['a]. *)
+
+val case0 : 'a -> ('a, 'a case_p) case
+(** [case0 v] is a representation of a variant constructor [v] with no
+    arguments. For instance:
+
+    {[
+      type t = Foo
+
+      let foo = case0 Foo
+    ]} *)
+
+val case1 : 'b t -> ('b -> 'a) -> ('a, 'b -> 'a case_p) case
+(** [case1 n t c] is a representation of a variant constructor [c] with an
+    argument of type [t]. For instances:
+
+    {[
+      type t = Foo of string
+
+      let foo = case1 cstring (fun s -> Foo s)
+    ]} *)
+
+val ( |~ ) :
+  ('a, 'b, 'c -> 'd) open_variant -> ('a, 'c) case -> ('a, 'b, 'd) open_variant
+(** [v |~ c] is the open variant [v] augmented with the case [c]. *)
+
+val sealv : ('a, 'b, 'a -> 'a case_p) open_variant -> 'a t
+(** [sealv v] seals the open variant [v]. *)
+
+(** {2:decoder Decoder.} *)
+
+val decode_bstr : 'a t -> Bstr.t -> int ref -> 'a
+(** [decode_bstr repr] is the binary decoder for values of type [repr]. *)
+
+val decode : 'a t -> string -> int ref -> 'a
+
+(** {2:encoder Encoder.} *)
+
+val encode_bstr : 'a t -> 'a -> Bstr.t -> int ref -> unit
+val to_string : 'a t -> 'a -> string
+
+module Size : sig
+  type -'a size_of
+  (** The type for size function related to binary encoder/decoder. *)
+
+  val size_of : 'a t -> 'a size_of
+
+  type 'a t = private
+    | Static of int
+    | Dynamic of 'a
+    | Unknown
+        (** A value representing information known about the length in bytes of
+            encodings produced by a particular binary codec:
+            - [Static n]: all encodings produced by this codec have length [n];
+            - [Dynamic fn]: the length of binary encodings is dependent on the
+              specific value, but may be efficiently computed at run-time via
+              the function [fn];
+            - [Unknown]: this codec may produce encodings that cannot be
+              efficiently pre-computed. *)
+
+  val of_encoding : 'a size_of -> (Bstr.t -> int -> int) t
+  val of_value : 'a size_of -> ('a -> int) t
+end
+
+val size_of_value : 'a t -> 'a -> int option
+(** [size_of_value encoding value] attempts to calculate the number of bytes
+    needed to encode the given [value] according to the given encoding. *)
+
+val size_of_bstr : ?off:int -> 'a t -> Bstr.t -> int option
+(** [size_of_encoding ?off encoding bstr] attempts to calculate the number of
+    bytes required to decode a value according to the given [encoding] and
+    according to what can be decoded in the given byte sequence [bstr] (at the
+    given offset [off], defaults to [0]). *)

unikernel/duniverse/bstr/lib/bstr.c

@@ -0,0 +1,325 @@
+/*
+ * Copyright (c) 2024 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 <caml/alloc.h>
+#include <caml/bigarray.h>
+#include <caml/custom.h>
+#include <caml/fail.h>
+#include <caml/m.h>
+#include <caml/memory.h>
+#include <caml/mlvalues.h>
+#include <string.h>
+
+#ifndef CAML_BA_SUBARRAY
+#define CAML_BA_SUBARRAY 0x800
+#endif
+
+CAMLextern void caml_enter_blocking_section(void);
+CAMLextern void caml_leave_blocking_section(void);
+
+CAMLprim value bstr_bytecode_ptr(value va) {
+  CAMLparam1(va);
+  CAMLlocal1(res);
+
+  struct caml_ba_array *a = Caml_ba_array_val(va);
+  void *src_a = a->data;
+  res = caml_copy_nativeint((intnat)src_a);
+
+  CAMLreturn(res);
+}
+
+intnat bstr_native_ptr(value va) {
+  struct caml_ba_array *a = Caml_ba_array_val(va);
+  return ((intnat)a->data);
+}
+
+#define bstr_uint8_off(ba, off) ((uint8_t *)Caml_ba_data_val(ba) + off)
+#define bytes_uint8_off(buf, off) ((uint8_t *)Bytes_val(buf) + off)
+#define LEAVE_RUNTIME_OP_CUTOFF 4096
+#define is_mmaped(ba) ((ba)->flags & CAML_BA_MAPPED_FILE)
+
+void bstr_native_memcpy_mmaped(value src, intnat src_off, value dst,
+                               intnat dst_off, intnat len) {
+  int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long));
+
+  if (leave_runtime)
+    caml_enter_blocking_section();
+  memcpy(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
+  if (leave_runtime)
+    caml_leave_blocking_section();
+}
+
+void bstr_native_memcpy(value src, intnat src_off, value dst, intnat dst_off,
+                        intnat len) {
+  memcpy(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
+}
+
+CAMLprim value bstr_bytecode_memcpy(value src, value src_off, value dst,
+                                    value dst_off, value len) {
+  CAMLparam5(src, src_off, dst, dst_off, len);
+
+  if (is_mmaped(Caml_ba_array_val(src)) || is_mmaped(Caml_ba_array_val(dst)))
+    bstr_native_memcpy_mmaped(src, Unsigned_long_val(src_off), dst,
+                              Unsigned_long_val(dst_off),
+                              Unsigned_long_val(len));
+  else
+    bstr_native_memcpy(src, Unsigned_long_val(src_off), dst,
+                       Unsigned_long_val(dst_off), Unsigned_long_val(len));
+
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value bstr_native_memmove_mmaped(value src, intnat src_off, value dst,
+                                          intnat dst_off, intnat len) {
+  CAMLparam2(src, dst);
+  int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long)) ||
+                      is_mmaped(Caml_ba_array_val(src)) ||
+                      is_mmaped(Caml_ba_array_val(dst));
+
+  if (leave_runtime)
+    caml_enter_blocking_section();
+  memmove(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
+  if (leave_runtime)
+    caml_leave_blocking_section();
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value bstr_native_memmove(value src, intnat src_off, value dst,
+                                   intnat dst_off, intnat len) {
+  CAMLparam2(src, dst);
+  int leave_runtime = (len > LEAVE_RUNTIME_OP_CUTOFF * sizeof(long));
+
+  if (leave_runtime)
+    caml_enter_blocking_section();
+  memmove(bstr_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
+  if (leave_runtime)
+    caml_leave_blocking_section();
+  CAMLreturn(Val_unit);
+}
+
+CAMLprim value bstr_bytecode_memmove(value src, value src_off, value dst,
+                                     value dst_off, value len) {
+  CAMLparam5(src, src_off, dst, dst_off, len);
+  if (is_mmaped(Caml_ba_array_val(src)) || is_mmaped(Caml_ba_array_val(dst)))
+    bstr_native_memmove_mmaped(src, Unsigned_long_val(src_off), dst,
+                               Unsigned_long_val(dst_off),
+                               Unsigned_long_val(len));
+  else
+    bstr_native_memmove(src, Unsigned_long_val(src_off), dst,
+                        Unsigned_long_val(dst_off), Unsigned_long_val(len));
+  CAMLreturn(Val_unit);
+}
+
+intnat bstr_native_memcmp(value s1, intnat s1_off, value s2, intnat s2_off,
+                          intnat len) {
+  intnat res;
+  res = memcmp(bstr_uint8_off(s1, s1_off), bstr_uint8_off(s2, s2_off), len);
+  return (res);
+}
+
+CAMLprim value bstr_bytecode_memcmp(value s1, value s1_off, value s2,
+                                    value s2_off, value len) {
+  CAMLparam5(s1, s1_off, s2, s2_off, len);
+  intnat res;
+  res = bstr_native_memcmp(s1, Unsigned_long_val(s1_off), s2,
+                           Unsigned_long_val(s2_off), Unsigned_long_val(len));
+  CAMLreturn(Val_long(res));
+}
+
+#define __MEM1(name)                                                           \
+  intnat bstr_native_##name(value src, intnat src_off, intnat src_len,         \
+                            intnat va) {                                       \
+    uint8_t *res = name(bstr_uint8_off(src, src_off), va, src_len);            \
+    if (res == NULL)                                                           \
+      return (-1);                                                             \
+                                                                               \
+    return ((intnat)(res - bstr_uint8_off(src, src_off)));                     \
+  }                                                                            \
+                                                                               \
+  CAMLprim value bstr_bytecode_##name(value src, value src_off, value src_len, \
+                                      value va) {                              \
+    CAMLparam4(src, src_off, src_len, va);                                     \
+    intnat res;                                                                \
+    res =                                                                      \
+        bstr_native_##name(src, Unsigned_long_val(src_off),                    \
+                           Unsigned_long_val(src_len), Unsigned_long_val(va)); \
+    CAMLreturn(Val_long(res));                                                 \
+  }
+
+__MEM1(memset)
+__MEM1(memchr)
+
+void bstr_native_unsafe_blit_from_bytes(value src, intnat src_off, value dst,
+                                        intnat dst_off, intnat len) {
+  memcpy(bstr_uint8_off(dst, dst_off), bytes_uint8_off(src, src_off), len);
+}
+
+CAMLprim value bstr_bytecode_unsafe_blit_from_bytes(value src, intnat src_off,
+                                                    value dst, intnat dst_off,
+                                                    intnat len) {
+  CAMLparam5(src, src_off, dst, dst_off, len);
+  memcpy(bstr_uint8_off(dst, Unsigned_long_val(dst_off)),
+         bytes_uint8_off(src, Unsigned_long_val(src_off)),
+         Unsigned_long_val(len));
+  CAMLreturn(Val_unit);
+}
+
+void bstr_native_unsafe_blit_to_bytes(value src, intnat src_off, value dst,
+                                      intnat dst_off, intnat len) {
+  memcpy(bytes_uint8_off(dst, dst_off), bstr_uint8_off(src, src_off), len);
+}
+
+CAMLprim value bstr_bytecode_unsafe_blit_to_bytes(value src, intnat src_off,
+                                                  value dst, intnat dst_off,
+                                                  intnat len) {
+  CAMLparam5(src, src_off, dst, dst_off, len);
+  memcpy(bytes_uint8_off(dst, Unsigned_long_val(dst_off)),
+         bstr_uint8_off(src, Unsigned_long_val(src_off)),
+         Unsigned_long_val(len));
+  CAMLreturn(Val_unit);
+}
+
+#include <stdatomic.h>
+
+#define atomic_store_release(p, v)                                             \
+  atomic_store_explicit((p), (v), memory_order_release)
+
+CAMLextern struct custom_operations caml_ba_ops;
+
+static void caml_ba_update_proxy(struct caml_ba_array *b1,
+                                 struct caml_ba_array *b2) {
+  struct caml_ba_proxy *proxy;
+  /* Nothing to do for un-managed arrays */
+  if ((b1->flags & CAML_BA_MANAGED_MASK) == CAML_BA_EXTERNAL)
+    return;
+  if (b1->proxy != NULL) {
+    /* If b1 is already a proxy for a larger array, increment refcount of
+       proxy */
+    b2->proxy = b1->proxy;
+#if OCAML_VERSION_MAJOR >= 5
+    (void)atomic_fetch_add(&b1->proxy->refcount, 1);
+#else
+    b1->proxy->refcount += 1;
+#endif
+  } else {
+    /* Otherwise, create proxy and attach it to both b1 and b2 */
+    proxy = malloc(sizeof(struct caml_ba_proxy));
+    if (proxy == NULL)
+      caml_raise_out_of_memory();
+#if OCAML_VERSION_MAJOR >= 5
+    atomic_store_release(&proxy->refcount, 2);
+#else
+    proxy->refcount = 2;
+#endif
+    /* initial refcount: 2 = original array + sub array */
+    proxy->data = b1->data;
+    proxy->size = b1->flags & CAML_BA_MAPPED_FILE ? caml_ba_byte_size(b1) : 0;
+    b1->proxy = proxy;
+    b2->proxy = proxy;
+  }
+}
+
+CAMLprim value bstr_native_unsafe_sub(value vbstr, intnat off, intnat len) {
+  CAMLparam1(vbstr);
+  CAMLlocal1(res);
+
+  char *sub = Caml_ba_array_val(vbstr)->data + off;
+  res =
+      caml_alloc_custom_mem(&caml_ba_ops, SIZEOF_BA_ARRAY + sizeof(intnat), 0);
+  struct caml_ba_array *new;
+  new = Caml_ba_array_val(res);
+  new->data = sub;
+  new->num_dims = 1;
+  new->flags = Caml_ba_array_val(vbstr)->flags | CAML_BA_SUBARRAY;
+  new->proxy = NULL;
+  new->dim[0] = len;
+  Custom_ops_val(res) = Custom_ops_val(vbstr);
+  caml_ba_update_proxy(Caml_ba_array_val(vbstr), Caml_ba_array_val(res));
+  CAMLreturn(res);
+}
+
+CAMLprim value bstr_bytecode_unsafe_sub(value vbstr, value voff, value vlen) {
+  CAMLparam3(vbstr, voff, vlen);
+  CAMLlocal1(res);
+
+  intnat off = Unsigned_long_val(voff);
+  intnat len = Unsigned_long_val(vlen);
+  char *sub = Caml_ba_array_val(vbstr)->data + off;
+  res =
+      caml_alloc_custom_mem(&caml_ba_ops, SIZEOF_BA_ARRAY + sizeof(intnat), 0);
+  struct caml_ba_array *new;
+  new = Caml_ba_array_val(res);
+  new->data = sub;
+  new->num_dims = 1;
+  new->flags = Caml_ba_array_val(vbstr)->flags | CAML_BA_SUBARRAY;
+  new->proxy = NULL;
+  new->dim[0] = len;
+  Custom_ops_val(res) = Custom_ops_val(vbstr);
+  caml_ba_update_proxy(Caml_ba_array_val(vbstr), Caml_ba_array_val(res));
+  CAMLreturn(res);
+}
+
+/* This function is **only** useful when accessing to a bigstring for an
+ * architecture requiring alignment **and** for an OCaml executable in
+ * bytecode. It concerns only 32-bits architectures.
+ */
+
+uint64_t bstr_native_get64u(value va, intnat off) {
+#ifdef ARCH_ALIGN_INT64
+  char b0, b1, b2, b3, b4, b5, b6, b7;
+#endif
+  struct caml_ba_array *a = Caml_ba_array_val(va);
+  void *addr = &((unsigned char *)a->data)[off];
+  uint64_t res;
+
+#ifdef ARCH_ALIGN_INT64
+  if (!((size_t)addr) & 0x7)
+    res = *((uint64_t *)addr);
+  else {
+    b0 = ((unsigned char *)a->data)[off];
+    b1 = ((unsigned char *)a->data)[off + 1];
+    b2 = ((unsigned char *)a->data)[off + 2];
+    b3 = ((unsigned char *)a->data)[off + 3];
+    b4 = ((unsigned char *)a->data)[off + 4];
+    b5 = ((unsigned char *)a->data)[off + 5];
+    b6 = ((unsigned char *)a->data)[off + 6];
+    b7 = ((unsigned char *)a->data)[off + 7];
+#ifdef ARCH_BIG_ENDIAN
+    res = (uint64_t)b0 << 56 | (uint64_t)b1 << 48 | (uint64_t)b2 << 40 |
+          (uint64_t)b3 << 32 | (uint64_t)b4 << 24 | (uint64_t)b5 << 16 |
+          (uint64_t)b6 << 8 | (uint64_t)b7;
+#else
+    res = (uint64_t)b7 << 56 | (uint64_t)b6 << 48 | (uint64_t)b5 << 40 |
+          (uint64_t)b4 << 32 | (uint64_t)b3 << 24 | (uint64_t)b2 << 16 |
+          (uint64_t)b1 << 8 | (uint64_t)b0;
+#endif
+  }
+#else
+  res = *((uint64_t *)addr);
+#endif
+
+  return (res);
+}
+
+CAMLprim value bstr_bytecode_get64u(value va, value off) {
+  CAMLparam2(va, off);
+  CAMLlocal1(res);
+
+  uint64_t val = bstr_native_get64u(va, Unsigned_long_val(off));
+  res = caml_copy_int64(val);
+
+  CAMLreturn(res);
+}

unikernel/duniverse/bstr/lib/bstr.ml

@@ -0,0 +1,787 @@
+(*
+ * Copyright (c) 2024 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.
+ *)
+
+type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+external length : t -> int = "%caml_ba_dim_1"
+
+external ptr : t -> (nativeint[@unboxed])
+  = "bstr_bytecode_ptr" "bstr_native_ptr"
+[@@noalloc]
+
+let overlap a b =
+  let src_a = ptr a in
+  let src_b = ptr b in
+  let len_a = Nativeint.of_int (length a) in
+  let len_b = Nativeint.of_int (length b) in
+  let len =
+    let ( + ) = Nativeint.add in
+    let ( - ) = Nativeint.sub in
+    Nativeint.max 0n (Nativeint.min (src_a + len_a) (src_b + len_b))
+    - Nativeint.max src_a src_b
+  in
+  let len = Nativeint.to_int len in
+  if src_a >= src_b && src_a < Nativeint.add src_b len_b then
+    let offset = Nativeint.(to_int (sub src_a src_b)) in
+    Some (len, 0, offset)
+  else if src_b >= src_a && src_b < Nativeint.add src_a len_a then
+    let offset = Nativeint.(to_int (sub src_b src_a)) in
+    Some (len, offset, 0)
+  else None
+
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+
+let ( < ) (x : int) y = x < y [@@inline]
+
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+
+let ( <= ) (x : int) y = x <= y [@@inline]
+
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+
+let ( > ) (x : int) y = x > y [@@inline]
+
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+
+let ( >= ) (x : int) y = x >= y [@@inline]
+
+module Bytes = struct
+  include Bytes
+
+  external _unsafe_get_uint8 : bytes -> int -> int = "%bytes_unsafe_get"
+  external _unsafe_set_uint8 : bytes -> int -> int -> unit = "%bytes_unsafe_set"
+  external _unsafe_get_int32_ne : bytes -> int -> int32 = "%caml_bytes_get32u"
+
+  external _unsafe_set_int32_ne : bytes -> int -> int32 -> unit
+    = "%caml_bytes_set32u"
+end
+
+external swap16 : int -> int = "%bswap16"
+external swap32 : int32 -> int32 = "%bswap_int32"
+external swap64 : int64 -> int64 = "%bswap_int64"
+external get_uint8 : t -> int -> int = "%caml_ba_ref_1"
+external unsafe_get_uint8 : t -> int -> int = "%caml_ba_unsafe_ref_1"
+external set_uint8 : t -> int -> int -> unit = "%caml_ba_set_1"
+external get_uint16_ne : t -> int -> int = "%caml_bigstring_get16"
+external set_int16_ne : t -> int -> int -> unit = "%caml_bigstring_set16"
+external get_int32_ne : t -> int -> int32 = "%caml_bigstring_get32"
+external set_int32_ne : t -> int -> int32 -> unit = "%caml_bigstring_set32"
+external set_int64_ne : t -> int -> int64 -> unit = "%caml_bigstring_set64"
+external unsafe_get_uint16_ne : t -> int -> int = "%caml_bigstring_get16u"
+
+external unsafe_set_uint16_ne : t -> int -> int -> unit
+  = "%caml_bigstring_set16u"
+
+external unsafe_get_int64_ne : t -> (int[@untagged]) -> (int64[@unboxed])
+  = "bstr_bytecode_get64u" "bstr_native_get64u"
+[@@noalloc]
+
+external _unsafe_set_int64_ne : t -> int -> int64 -> unit
+  = "%caml_bigstring_set64u"
+
+external unsafe_memcmp :
+     t
+  -> (int[@untagged])
+  -> t
+  -> (int[@untagged])
+  -> (int[@untagged])
+  -> (int[@untagged]) = "bstr_bytecode_memcmp" "bstr_native_memcmp"
+[@@noalloc]
+
+external unsafe_memcpy :
+  t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
+  = "bstr_bytecode_memcpy" "bstr_native_memcpy"
+[@@noalloc]
+
+external unsafe_memcpy_mmaped :
+  t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
+  = "bstr_bytecode_memcpy" "bstr_native_memcpy_mmaped"
+[@@noalloc]
+
+external unsafe_memmove :
+  t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
+  = "bstr_bytecode_memmove" "bstr_native_memmove"
+[@@noalloc]
+
+external unsafe_memmove_mmaped :
+  t -> (int[@untagged]) -> t -> (int[@untagged]) -> (int[@untagged]) -> unit
+  = "bstr_bytecode_memmove" "bstr_native_memmove_mmaped"
+[@@noalloc]
+
+external unsafe_memchr :
+     t
+  -> (int[@untagged])
+  -> (int[@untagged])
+  -> (int[@untagged])
+  -> (int[@untagged]) = "bstr_bytecode_memchr" "bstr_native_memchr"
+[@@noalloc]
+
+external unsafe_memset :
+     t
+  -> (int[@untagged])
+  -> (int[@untagged])
+  -> (int[@untagged])
+  -> (int[@untagged]) = "bstr_bytecode_memset" "bstr_native_memset"
+[@@noalloc]
+
+let memcmp src ~src_off dst ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > Bigarray.Array1.dim src - len
+    || dst_off < 0
+    || dst_off > Bigarray.Array1.dim dst - len
+  then invalid_arg "Bstr.memcmp";
+  unsafe_memcmp src src_off dst dst_off len
+
+let memcpy src ~src_off dst ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > Bigarray.Array1.dim src - len
+    || dst_off < 0
+    || dst_off > Bigarray.Array1.dim dst - len
+  then invalid_arg "Bstr.memcpy";
+  unsafe_memcpy src src_off dst dst_off len
+
+let memcpy_mmaped src ~src_off dst ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > Bigarray.Array1.dim src - len
+    || dst_off < 0
+    || dst_off > Bigarray.Array1.dim dst - len
+  then invalid_arg "Bstr.memcpy";
+  unsafe_memcpy_mmaped src src_off dst dst_off len
+
+let memmove src ~src_off dst ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > Bigarray.Array1.dim src - len
+    || dst_off < 0
+    || dst_off > Bigarray.Array1.dim dst - len
+  then invalid_arg "Bstr.memmove";
+  unsafe_memmove src src_off dst dst_off len
+
+let memmove_mmaped src ~src_off dst ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > Bigarray.Array1.dim src - len
+    || dst_off < 0
+    || dst_off > Bigarray.Array1.dim dst - len
+  then invalid_arg "Bstr.memmove";
+  unsafe_memmove_mmaped src src_off dst dst_off len
+
+let memchr src ~off ~len value =
+  if len < 0 || off < 0 || off > Bigarray.Array1.dim src - len then
+    invalid_arg "Bstr.memchr";
+  unsafe_memchr src off len (Char.code value)
+
+let memset src ~off ~len value =
+  if len < 0 || off < 0 || off > Bigarray.Array1.dim src - len then
+    invalid_arg "Bstr.memset";
+  ignore (unsafe_memset src off len (Char.code value))
+
+let empty = Bigarray.Array1.create Bigarray.char Bigarray.c_layout 0
+let create len = Bigarray.Array1.create Bigarray.char Bigarray.c_layout len
+
+external get : t -> int -> char = "%caml_ba_ref_1"
+external unsafe_get : t -> int -> char = "%caml_ba_unsafe_ref_1"
+external set : t -> int -> char -> unit = "%caml_ba_set_1"
+external unsafe_set : t -> int -> char -> unit = "%caml_ba_unsafe_set_1"
+
+let fill bstr ?(off = 0) ?len chr =
+  let len = match len with Some len -> len | None -> length bstr - off in
+  memset bstr ~off ~len chr
+
+let make len chr =
+  let bstr = create len in
+  ignore (unsafe_memset bstr 0 len (Char.code chr));
+  (* [Obj.magic] instead of [Char.code]? *)
+  bstr
+
+let init len fn =
+  let bstr = create len in
+  for i = 0 to len - 1 do
+    unsafe_set bstr i (fn i)
+  done;
+  bstr
+
+let copy src =
+  let len = length src in
+  let bstr = create len in
+  unsafe_memcpy src 0 bstr 0 len;
+  bstr
+
+let chop ?(rev = false) bstr =
+  if length bstr == 0 then None
+  else if not rev then Some (unsafe_get bstr 0)
+  else Some (unsafe_get bstr (length bstr - 1))
+
+let get_int64_ne bstr idx =
+  if idx < 0 || idx > length bstr - 8 then invalid_arg "Bstr.get_int64_ne";
+  unsafe_get_int64_ne bstr idx
+
+let get_int8 bstr i =
+  (get_uint8 bstr i lsl (Sys.int_size - 8)) asr (Sys.int_size - 8)
+
+let get_uint16_le bstr i =
+  if Sys.big_endian then swap16 (get_uint16_ne bstr i) else get_uint16_ne bstr i
+
+let get_uint16_be bstr i =
+  if not Sys.big_endian then swap16 (get_uint16_ne bstr i)
+  else get_uint16_ne bstr i
+
+let[@coverage off] _unsafe_get_uint16_le bstr i =
+  (* TODO(dinosaure): for unicode. *)
+  if Sys.big_endian then swap16 (unsafe_get_uint16_ne bstr i)
+  else unsafe_get_uint16_ne bstr i
+
+let[@coverage off] _unsafe_get_uint16_be bstr i =
+  (* TODO(dinosaure): for unicode. *)
+  if not Sys.big_endian then swap16 (unsafe_get_uint16_ne bstr i)
+  else unsafe_get_uint16_ne bstr i
+
+let get_int16_ne bstr i =
+  (get_uint16_ne bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
+
+let get_int16_le bstr i =
+  (get_uint16_le bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
+
+let get_int16_be bstr i =
+  (get_uint16_be bstr i lsl (Sys.int_size - 16)) asr (Sys.int_size - 16)
+
+let get_int32_le bstr i =
+  if Sys.big_endian then swap32 (get_int32_ne bstr i) else get_int32_ne bstr i
+
+let get_int32_be bstr i =
+  if not Sys.big_endian then swap32 (get_int32_ne bstr i)
+  else get_int32_ne bstr i
+
+let get_int64_le bstr i =
+  if Sys.big_endian then swap64 (get_int64_ne bstr i) else get_int64_ne bstr i
+
+let get_int64_be bstr i =
+  if not Sys.big_endian then swap64 (get_int64_ne bstr i)
+  else get_int64_ne bstr i
+
+let[@coverage off] _unsafe_set_uint16_le bstr i x =
+  (* TODO(dinosaure): for unicode. *)
+  if Sys.big_endian then unsafe_set_uint16_ne bstr i (swap16 x)
+  else unsafe_set_uint16_ne bstr i x
+
+let[@coverage off] _unsafe_set_uint16_be bstr i x =
+  (* TODO(dinosaure): for unicode. *)
+  if Sys.big_endian then unsafe_set_uint16_ne bstr i x
+  else unsafe_set_uint16_ne bstr i (swap16 x)
+
+let set_int16_le bstr i x =
+  if Sys.big_endian then set_int16_ne bstr i (swap16 x)
+  else set_int16_ne bstr i x
+
+let set_int16_be bstr i x =
+  if not Sys.big_endian then set_int16_ne bstr i (swap16 x)
+  else set_int16_ne bstr i x
+
+let set_int32_le bstr i x =
+  if Sys.big_endian then set_int32_ne bstr i (swap32 x)
+  else set_int32_ne bstr i x
+
+let set_int32_be bstr i x =
+  if not Sys.big_endian then set_int32_ne bstr i (swap32 x)
+  else set_int32_ne bstr i x
+
+let set_int64_le bstr i x =
+  if Sys.big_endian then set_int64_ne bstr i (swap64 x)
+  else set_int64_ne bstr i x
+
+let set_int64_be bstr i x =
+  if not Sys.big_endian then set_int64_ne bstr i (swap64 x)
+  else set_int64_ne bstr i x
+
+let set_int8 = set_uint8
+let set_uint16_ne = set_int16_ne
+let set_uint16_be = set_int16_be
+let set_uint16_le = set_int16_le
+
+external unsafe_sub : t -> (int[@untagged]) -> (int[@untagged]) -> t
+  = "bstr_bytecode_unsafe_sub" "bstr_native_unsafe_sub"
+
+let sub bstr ~off ~len =
+  if off < 0 || len < 0 || off > length bstr - len then invalid_arg "Bstr.sub";
+  unsafe_sub bstr off len
+
+let[@inline always] unsafe_blit src ~src_off dst ~dst_off ~len =
+  unsafe_memmove src src_off dst dst_off len
+
+let blit src ~src_off dst ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > length src - len
+    || dst_off < 0
+    || dst_off > length dst - len
+  then invalid_arg "Bstr.blit";
+  unsafe_blit src ~src_off dst ~dst_off ~len
+
+external unsafe_blit_to_bytes :
+     t
+  -> src_off:(int[@untagged])
+  -> bytes
+  -> dst_off:(int[@untagged])
+  -> len:(int[@untagged])
+  -> unit
+  = "bstr_bytecode_unsafe_blit_to_bytes" "bstr_native_unsafe_blit_to_bytes"
+[@@noalloc]
+
+external unsafe_blit_from_bytes :
+     bytes
+  -> src_off:(int[@untagged])
+  -> t
+  -> dst_off:(int[@untagged])
+  -> len:(int[@untagged])
+  -> unit
+  = "bstr_bytecode_unsafe_blit_from_bytes" "bstr_native_unsafe_blit_from_bytes"
+[@@noalloc]
+
+let blit_from_bytes src ~src_off bstr ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > Bytes.length src - len
+    || dst_off < 0
+    || dst_off > length bstr - len
+  then invalid_arg "Bstr.blit_from_bytes";
+  unsafe_blit_from_bytes src ~src_off bstr ~dst_off ~len
+
+let blit_from_string src ~src_off bstr ~dst_off ~len =
+  blit_from_bytes (Bytes.unsafe_of_string src) ~src_off bstr ~dst_off ~len
+
+let blit_to_bytes bstr ~src_off dst ~dst_off ~len =
+  if
+    len < 0
+    || src_off < 0
+    || src_off > length bstr - len
+    || dst_off < 0
+    || dst_off > Bytes.length dst - len
+  then invalid_arg "Bstr.blit_to_bytes";
+  unsafe_blit_to_bytes bstr ~src_off dst ~dst_off ~len
+
+let of_string str =
+  let len = String.length str in
+  let bstr = create len in
+  unsafe_blit_from_bytes
+    (Bytes.unsafe_of_string str)
+    ~src_off:0 bstr ~dst_off:0 ~len;
+  bstr
+
+let string ?(off = 0) ?len str =
+  let len =
+    match len with Some len -> len | None -> String.length str - off
+  in
+  if off < 0 || len < 0 || off > String.length str - len then
+    invalid_arg "Bstr.string";
+  let bstr = create len in
+  unsafe_blit_from_bytes
+    (Bytes.unsafe_of_string str)
+    ~src_off:off bstr ~dst_off:0 ~len;
+  bstr
+
+let unsafe_sub_string bstr src_off len =
+  let buf = Bytes.create len in
+  unsafe_blit_to_bytes bstr ~src_off buf ~dst_off:0 ~len;
+  Bytes.unsafe_to_string buf
+
+let sub_string bstr ~off ~len =
+  if len < 0 || off < 0 || off > length bstr - len then
+    invalid_arg "Bstr.sub_string";
+  unsafe_sub_string bstr off len
+
+let to_string bstr =
+  if length bstr <= 0 then "" else unsafe_sub_string bstr 0 (length bstr)
+
+let is_empty bstr = length bstr == 0
+
+let is_prefix ~affix bstr =
+  let len_affix = String.length affix in
+  let len_bstr = length bstr in
+  if len_affix > len_bstr then false
+  else
+    let max_idx_affix = len_affix - 1 in
+    let rec go idx =
+      if idx > max_idx_affix then true
+      else if String.unsafe_get affix idx != unsafe_get bstr idx then false
+      else go (idx + 1)
+    in
+    go 0
+
+let starts_with ~prefix bstr =
+  let len_prefix = length prefix in
+  let len_bstr = length bstr in
+  if len_prefix > len_bstr then false
+  else
+    let max_idx_prefix = len_prefix - 1 in
+    let rec go idx =
+      if idx > max_idx_prefix then true
+      else if unsafe_get prefix idx != unsafe_get bstr idx then false
+      else go (idx + 1)
+    in
+    go 0
+
+let is_infix ~affix bstr =
+  let len_affix = String.length affix in
+  let len_bstr = length bstr in
+  if len_affix > len_bstr then false
+  else
+    let max_idx_affix = len_affix - 1 in
+    let max_idx_bstr = len_bstr - len_affix in
+    let rec go idx k =
+      if idx > max_idx_bstr then false
+      else if k > max_idx_affix then true
+      else if k > 0 then
+        if affix.[k] == bstr.{idx + k} then go idx (succ k) else go (succ idx) 0
+      else if affix.[0] = bstr.{idx} then go idx 1
+      else go (idx + 1) 0
+    in
+    go 0 0
+
+let is_suffix ~affix bstr =
+  let max_idx_affix = String.length affix - 1 in
+  let max_idx_bstr = length bstr - 1 in
+  if max_idx_affix > max_idx_bstr then false
+  else
+    let rec go idx =
+      if idx > max_idx_affix then true
+      else if affix.[max_idx_affix - idx] != bstr.{max_idx_bstr - idx} then
+        false
+      else go (idx + 1)
+    in
+    go 0
+
+let ends_with ~suffix bstr =
+  let max_idx_suffix = length suffix - 1 in
+  let max_idx_bstr = length bstr - 1 in
+  if max_idx_suffix > max_idx_bstr then false
+  else
+    let rec go idx =
+      if idx > max_idx_suffix then true
+      else if
+        unsafe_get suffix (max_idx_suffix - idx)
+        != unsafe_get bstr (max_idx_bstr - idx)
+      then false
+      else go (idx + 1)
+    in
+    go 0
+
+exception Break
+
+let for_all sat bstr =
+  try
+    for idx = 0 to length bstr - 1 do
+      if sat (unsafe_get bstr idx) == false then raise_notrace Break
+    done;
+    true
+  with Break -> false
+
+let contains bstr ?(off = 0) ?len chr =
+  let len = match len with Some len -> len | None -> length bstr - off in
+  memchr bstr ~off ~len chr != -1
+
+let index bstr ?(off = 0) ?len chr =
+  let len = match len with Some len -> len | None -> length bstr - off in
+  match memchr bstr ~off ~len chr with -1 -> None | value -> Some value
+
+let compare a b =
+  let len_a = length a and len_b = length b in
+  if len_a < len_b then -1
+  else if len_a > len_b then 1
+  else unsafe_memcmp a 0 b 0 len_a
+
+let equal a b = compare a b == 0
+
+let constant_equal ~len a b =
+  let len1 = len asr 1 in
+  let r = ref 0 in
+  for i = 0 to pred len1 do
+    r :=
+      !r lor (unsafe_get_uint16_ne a (i * 2) lxor unsafe_get_uint16_ne b (i * 2))
+  done;
+  for _ = 1 to len land 1 do
+    r := !r lor (unsafe_get_uint8 a (len - 1) lxor unsafe_get_uint8 b (len - 1))
+  done;
+  !r == 0
+
+let constant_equal a b =
+  let al = length a in
+  let bl = length b in
+  if al != bl then false else constant_equal ~len:al a b
+
+let with_range ?(first = 0) ?(len = max_int) bstr =
+  if len < 0 then invalid_arg "Bstr.with_range";
+  if len == 0 then empty
+  else
+    let bstr_len = length bstr in
+    let max_idx = bstr_len - 1 in
+    let last =
+      match len with
+      | len when len = max_int -> max_idx
+      | len ->
+          let last = first + len - 1 in
+          if last > max_idx then max_idx else last
+    in
+    let first = if first < 0 then 0 else first in
+    if first = 0 && last = max_idx then bstr
+    else unsafe_sub bstr first (last + 1 - first)
+
+let with_index_range ?(first = 0) ?last bstr =
+  let bstr_len = length bstr in
+  let max_idx = bstr_len - 1 in
+  let last =
+    match last with
+    | None -> max_idx
+    | Some last -> if last > max_idx then max_idx else last
+  in
+  let first = if first < 0 then 0 else first in
+  if first > max_idx || last < 0 || first > last then empty
+  else if first == 0 && last == max_idx then bstr
+  else unsafe_sub bstr first (last + 1 - first)
+
+let is_white chr = chr == ' ' || chr == '\t'
+
+let trim ?(drop = is_white) bstr =
+  let len = length bstr in
+  if len == 0 then bstr
+  else
+    let max_idx = len - 1 in
+    let rec left_pos idx =
+      if idx > max_idx then len
+      else if drop bstr.{idx} then left_pos (succ idx)
+      else idx
+    in
+    let rec right_pos idx =
+      if idx < 0 then 0
+      else if drop bstr.{idx} then right_pos (pred idx)
+      else succ idx
+    in
+    let left = left_pos 0 in
+    if left = len then empty
+    else
+      let right = right_pos max_idx in
+      if left == 0 && right == len then bstr
+      else unsafe_sub bstr left (right - left)
+
+let fspan ?(min = 0) ?(max = max_int) ?(sat = Fun.const true) bstr =
+  if min < 0 then invalid_arg "Bstr.fspan";
+  if max < 0 then invalid_arg "Bstr.fspan";
+  if min > max || max == 0 then (empty, bstr)
+  else
+    let len = length bstr in
+    let max_idx = len - 1 in
+    let max_idx =
+      let k = max - 1 in
+      if k > max_idx then max_idx else k
+    in
+    let need_idx = min in
+    let rec go idx =
+      if idx <= max_idx && sat bstr.{idx} then go (succ idx)
+      else if idx < need_idx || idx == 0 then (empty, bstr)
+      else if idx == len then (bstr, empty)
+      else
+        let a = unsafe_sub bstr 0 idx in
+        let b = unsafe_sub bstr idx (len - idx) in
+        (a, b)
+    in
+    go 0
+
+let rspan ?(min = 0) ?(max = max_int) ?(sat = Fun.const true) bstr =
+  if min < 0 then invalid_arg "Bstr.rspan";
+  if max < 0 then invalid_arg "Bstr.rspan";
+  if min > max || max == 0 then (bstr, empty)
+  else
+    let len = length bstr in
+    let max_idx = len - 1 in
+    let min_idx =
+      let k = len - max in
+      if k < 0 then 0 else k
+    in
+    let need_idx = len - min - 1 in
+    let rec go idx =
+      if idx >= min_idx && sat (unsafe_get bstr idx) then go (idx - 1)
+      else if idx > need_idx || idx == max_idx then (bstr, empty)
+      else if idx < 0 then (empty, bstr)
+      else
+        let cut = idx + 1 in
+        let a = unsafe_sub bstr 0 cut in
+        let b = unsafe_sub bstr cut (len - cut) in
+        (a, b)
+    in
+    go max_idx
+
+let span ?(rev = false) ?min ?max ?sat bstr =
+  match rev with
+  | true -> rspan ?min ?max ?sat bstr
+  | false -> fspan ?min ?max ?sat bstr
+
+let take ?(rev = false) ?min ?max ?sat bstr =
+  let a, b = span ~rev ?min ?max ?sat bstr in
+  if rev then b else a
+
+let drop ?(rev = false) ?min ?max ?sat bstr =
+  let a, b = span ~rev ?min ?max ?sat bstr in
+  if rev then a else b
+
+let fcut ~sep bstr =
+  let sep_len = String.length sep in
+  let len = length bstr in
+  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
+      let a = unsafe_sub bstr 0 i in
+      let b = unsafe_sub bstr (i + sep_len) (len - i - sep_len) in
+      Some (a, b)
+    else if unsafe_get bstr (i + k) == String.unsafe_get sep k then
+      check_sep i (k + 1)
+    else scan (i + 1)
+  and scan i =
+    if i > max_s_zidx then None
+    else if unsafe_get bstr i == String.unsafe_get sep 0 then check_sep i 1
+    else scan (i + 1)
+  in
+  scan 0
+
+let rcut ~sep bstr =
+  let sep_len = String.length sep in
+  let len = length bstr in
+  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
+      let a = sub ~off:0 ~len:i bstr in
+      let b = sub ~off:(i + sep_len) ~len:(len - i - sep_len) bstr in
+      Some (a, b)
+    else if unsafe_get bstr (i + k) == String.unsafe_get sep k then
+      check_sep i (k + 1)
+    else rscan (i - 1)
+  and rscan i =
+    if i < 0 then None
+    else if unsafe_get bstr i == String.unsafe_get sep 0 then check_sep i 1
+    else rscan (i - 1)
+  in
+  rscan (max_s_zidx - max_sep_zidx)
+
+let cut ?(rev = false) ~sep bstr =
+  match rev with true -> rcut ~sep bstr | false -> fcut ~sep bstr
+
+let shift bstr off =
+  if off > length bstr || off < 0 then invalid_arg "Bstr.shift";
+  let len = length bstr - off in
+  unsafe_sub bstr off len
+
+let split_on_char sep bstr =
+  let lst = ref [] in
+  let max = ref (length bstr) in
+  for idx = length bstr - 1 downto 0 do
+    if unsafe_get bstr idx == sep then begin
+      lst := sub bstr ~off:(idx + 1) ~len:(!max - idx - 1) :: !lst;
+      max := idx
+    end
+  done;
+  sub bstr ~off:0 ~len:!max :: !lst
+
+let concat sep = function
+  | [] -> empty
+  | x :: r as lst ->
+      let sep_len = String.length sep in
+      let fn acc bstr = acc + sep_len + length bstr in
+      let res_len = List.fold_left fn (length x) r in
+      let res = create res_len in
+      let first = ref true in
+      let dst_off = ref 0 in
+      let fn bstr =
+        let len = length bstr in
+        if !first then begin
+          blit bstr ~src_off:0 res ~dst_off:!dst_off ~len;
+          first := false;
+          dst_off := !dst_off + len
+        end
+        else begin
+          blit_from_string sep ~src_off:0 res ~dst_off:!dst_off ~len:sep_len;
+          dst_off := !dst_off + sep_len;
+          blit bstr ~src_off:0 res ~dst_off:!dst_off ~len;
+          dst_off := !dst_off + len
+        end
+      in
+      List.iter fn lst; res
+
+let ( ++ ) a b =
+  let c = a + b in
+  match (a < 0, b < 0, c < 0) with
+  | true, true, false | false, false, true -> invalid_arg "Bstr.extend"
+  | _ -> c
+
+let extend bstr left right =
+  let len = length bstr ++ left ++ right in
+  let res = make len '\000' in
+  let src_off, dst_off = if left < 0 then (-left, 0) else (0, left) in
+  let copy = Int.min (length bstr - src_off) (len - dst_off) in
+  if copy > 0 then unsafe_blit bstr ~src_off res ~dst_off ~len:copy;
+  res
+
+let iter fn t =
+  for i = 0 to length t - 1 do
+    fn (unsafe_get t i)
+  done
+
+let to_seq bstr =
+  let rec go idx () =
+    if idx == length bstr then Seq.Nil
+    else
+      let chr = unsafe_get bstr idx in
+      Seq.Cons (chr, go (idx + 1))
+  in
+  go 0
+
+let to_seqi bstr =
+  let rec go idx () =
+    if idx == length bstr then Seq.Nil
+    else
+      let chr = unsafe_get bstr idx in
+      Seq.Cons ((idx, chr), go (idx + 1))
+  in
+  go 0
+
+let of_seq seq =
+  let n = ref 0 in
+  let buf = ref (make 0x7ff '\000') in
+  let resize () =
+    let new_len = min (2 * length !buf) Sys.max_string_length in
+    (* TODO(dinosaure): should we keep this limit? *)
+    if length !buf == new_len then failwith "Bstr.of_seq: cannot grow bigstring";
+    let new_buf = make new_len '\000' in
+    Bigarray.Array1.blit !buf (sub new_buf ~off:0 ~len:(length !buf));
+    buf := new_buf
+  in
+  let fn chr =
+    if !n == length !buf then resize ();
+    unsafe_set !buf !n chr;
+    incr n
+  in
+  Seq.iter fn seq; sub !buf ~off:0 ~len:!n

unikernel/duniverse/bstr/lib/bstr.mli

@@ -0,0 +1,605 @@
+(** A small library for manipulating bigstrings.
+
+    A bigstring is a mutable data structure that contains a fixed-length
+    sequence of bytes. Each byte can be indexed in constant time for reading and
+    writing.
+
+    Given a byte sequence [bstr] of length [len], we can access each of the
+    [len] bytes of [bstr] via its index in the sequence. Indexes start at [0],
+    and will call an index valid in [bstr] if it falls within the range
+    [[0...len-1]] (inclusive). A position is the point between two bytes or at
+    the beginning or end of the sequence. We call a position valid in [bstr] if
+    it falls within the range [[0...len]] (inclusive). Note that byte at index
+    [n] is between positions [n] and [n+1].
+
+    Two parameters [off] and [len] are said to designate a valid range of [bstr]
+    if [len >= 0] and [off] and [off+len] are valid positions in [bstr].
+
+    Byte sequences can be modified in place, for instance via the {!val:set} and
+    {!val:blit} functions described below.
+
+    {1:bigarray Bigstrings & Bigarrays.}
+
+    Bigstring is a specialised version of {!module:Bigarray} that not only
+    handles bytes in the form of {!module:Char}acter but also imposes a "C-like"
+    (see {!val:Bigarray.c_layout}) view as described above and allows common
+    functions such as [memcpy(3)] or [memmove(3)] to be offered.
+
+    For more details about Bigstrings and Bigarrays, we invite you to read the
+    {!module:Bigarray} documentation, which offers more general functions that
+    can be applied to Bigstrings.
+
+    {1:bytes Bigstrings & Bytes.}
+
+    Like bytes, a bigstring is a mutable data structure that contains a
+    fixed-length sequence of bytes. However, a bigstring has a few special
+    features that can make it more interesting to use than bytes.
+
+    {2:location Bigstrings and the Garbage Collector.}
+
+    A bigstring is not allocated in the same way as a standard OCaml value. In
+    fact, the byte sequence that the bigstring refers to is found in the
+    {i C heap} (rather than the OCaml heap). This means that the byte sequence
+    can come from a [malloc(3)] or a function requesting a particular memory
+    area from the system such as [Unix.map_file].
+
+    This particularity has an implication with the GC: the byte sequence is
+    {b not relocatable}. That is to say that during the cycle of the Garbage
+    Collector, this byte sequence does not move — in contrast, a [bytes] can be
+    moved by the GC (typically, from the minor heap to the major heap).
+
+    Thus, bigstrings have advantages and disadvantages compared to bytes due to
+    this particularity:
+    - Creating a bigstring can be expensive. Whether it is with
+      [malloc(3)]/{!val:create} or [Unix.map_file], creating a bigstring will
+      always be more expensive than creating bytes with OCaml. For small byte
+      sequences, it is therefore preferable to use bytes.
+    - Since a bigstring cannot be moved, its position can be shared by [Thread]s
+      and/or [Domain]s without interacting with the GC. An example is being able
+      to perform a complex computation in parallel from the bytes of this
+      sequence without {i blocking} the Garbage Collector during this
+      computation.
+
+    Depending on these characteristics, it may be more advantageous to use a
+    bigstring rather than [bytes]. This basically depends on your usage, and the
+    special features of bigstrings can unlock opportunities to outperform byte
+    calculations or analysis.
+
+    {2:sub Bigstring and slice.}
+
+    Another advantage of bigstrings is that copying is avoided when extracting
+    part of a larger bigstring. This is because the {!val:sub} function returns
+    a "proxy" of the original bigstring.
+
+    In this respect, and to be very precise, {!val:sub} avoids copying but the
+    creation of this "proxy" {b remains} costly. In addition, this library is
+    distributed with a new {!module:Slice_bstr} module. The latter offers a new
+    type whose {!val:Slice_bstr.sub} function is much less costly than
+    {!val:sub}.
+
+    {1 Bigstrings.} *)
+
+type t = (char, Bigarray.int8_unsigned_elt, Bigarray.c_layout) Bigarray.Array1.t
+
+(** {2 Constructors.} *)
+
+val empty : t
+(** [empty] is an empty bigstring. *)
+
+val create : int -> t
+(** [create len] returns a new byte sequence of length [len]. The sequence
+    {b is unitialized} and contains arbitrary bytes. *)
+
+val make : int -> char -> t
+(** [make len chr] is {!type:t} of length [len] with each index holding the
+    character [chr]. *)
+
+val copy : t -> t
+(** [copy t] returns a new byte sequence that contains the same bytes as the
+    argument. *)
+
+val init : int -> (int -> char) -> t
+(** [init len fn] returns a fresh byte sequence of length [len], with character
+    [idx] initialized to the result of [fn idx] (in increasing index order). *)
+
+(** {2 Memory-safe Operations.} *)
+
+val of_string : string -> t
+(** [of_string str] returns a new {!type:t} that contains the contents of the
+    given string [str]. *)
+
+val string : ?off:int -> ?len:int -> string -> t
+(** [string ~off ~len str] is the sub-buffer 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 a fresh allocated
+    {!type:t}.
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [str]. *)
+
+val sub_string : t -> off:int -> len:int -> string
+(** [sub_string bstr ~off ~len] returns a string of length [len] containing the
+    bytes of [bstr] starting at [off].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [t]. *)
+
+val to_string : t -> string
+(** [to_string bstr] is equivalent to
+    [sub_string bstr ~off:0 ~len:(length bstr)]. *)
+
+val length : t -> int
+(** [length bstr] is the number of bytes in [bstr]. *)
+
+val get : t -> int -> char
+(** [get bstr i] is the byte of [bstr]' at index [i]. This is equivalent to the
+    [bstr.{i}] notation.
+
+    @raise Invalid_argument if [i] is not an index of [bstr]. *)
+
+val set : t -> int -> char -> unit
+(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with
+    [chr].
+
+    @raise Invalid_argument if [i] is not a valid index in [t]. *)
+
+val unsafe_get : t -> int -> char
+(** [unsafe_get t idx] is like {!val:get} except no bounds checking is
+    performed. *)
+
+val unsafe_set : t -> int -> char -> unit
+(** [unsafe_set t idx chr] is like {!val:set} except no bounds checking is
+    performed. *)
+
+val chop : ?rev:bool -> t -> char option
+(** [chop bstr] returns the first element of [bstr] or the last element if
+    [rev = true]. If [bstr] is empty, it returns [None]. *)
+
+val concat : string -> t list -> t
+(** [concat sep ts] concatenates the list of bigstrings [ts], inserting the
+    separator string [sep] between each. *)
+
+val extend : t -> int -> int -> t
+(** [extend bstr left right] returns a new bigstring that contains the bytes of
+    [bstr], with [left] zero bytes prepended and [right] zero byte appended to
+    it. If [left] or [right] is negative, then bytes are removed (instead of
+    appended) from the corresponding side of [bstr].
+
+    @raise Invalid_argument if the result length is negative *)
+
+(** {2 Copy operation from one byte sequence to another.} *)
+
+val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
+(** [blit src ~src_off dst ~dst_off ~len] copies [len] bytes from byte sequence
+    [src], starting at index [src_off], to byte sequence [dst], starting at
+    index [dst_off]. It works correctly even if [src] and [dst] are (physically)
+    the same byte sequence, and the source and destination intervals overlap.
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val blit_from_string :
+  string -> src_off:int -> t -> dst_off:int -> len:int -> unit
+(** Just like {!val:blit}, but with a string as source one.
+
+    {b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy}
+    is used to do the copy.
+
+    @raise Invalid_argument
+      if [src_pos] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val blit_from_bytes :
+  bytes -> src_off:int -> t -> dst_off:int -> len:int -> unit
+(** Just like {!val:blit}, but with a bytes as source one.
+
+    {b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy}
+    is used to do the copy.
+
+    @raise Invalid_argument
+      if [src_pos] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val blit_to_bytes : t -> src_off:int -> bytes -> dst_off:int -> len:int -> unit
+(** [blit_to_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from
+    [src], starting at index [src_off], to byte sequence [dst], starting at
+    index [dst_off].
+
+    {b Note}: since it is impossible for [src] to overlap [dst], {!val:memcpy}
+    is used to do the copy.
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val memcpy : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
+(** [memcpy src ~src_off dst ~dst_off ~len] copies [len] bytes from [src] to
+    [dst]. [src] {b must not} overlap [dst]. Use {!val:memmove} if [src] & [dst]
+    do overlap.
+
+    You can check whether two buffers overlap using {!val:overlap}. If this
+    returns [None], the two values do not refer to a common memory area — and it
+    is safe to use memcpy.
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val memcpy_mmaped : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
+(** [memcpy_mmaped] is like {!val:memcpy} but [src] and [dst] can be a
+    {i mmaped} bigarray (from [Unix.map_file]). In this specific case, copying
+    from one to the other can take some time because it involves reading/writing
+    to disk. The operation can take longer than if the two bigarrays were
+    allocated via [malloc()]/{!val:Bigarray.Array1.create}.
+
+    It may therefore be worthwhile to release the GC lock so that this specific
+    operation can be carried out in parallel (in a [Thread]) without
+    interruption by the GC.
+
+    Note that the bigarrays do not necessarily need to be {i mmaped}. This
+    function also applies to "normal" bigarrays. It may also be worthwhile to
+    use this function if you know that you are copying a large area and would
+    like to do it in parallel (in a [Thread]). *)
+
+val memmove : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
+(** [memmove src ~src_off dst ~dst_off ~len] copies [len] bytes from [src] to
+    [dst]. [src] and [dst] may overlap: copying takes place as though the bytes
+    in [src] are first copied into a temporary array that does not overlap [src]
+    or [dst], and the bytes are then copied from the temporary array to [dst].
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val memmove_mmaped : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
+(** [memmove_mmaped] is like {!val:memmove} but [src] and [dst] can be a
+    {i mmaped} bigarray (from [Unix.map_file]). In this specific case, copying
+    from one to the other can take some time because it involves reading/writing
+    to disk. The operation can take longer than if the two bigarrays were
+    allocated via [malloc()]/{!val:Bigarray.Array1.create}.
+
+    It may therefore be worthwhile to release the GC lock so that this specific
+    operation can be carried out in parallel (in a [Thread]) without
+    interruption by the GC.
+
+    Note that the bigarrays do not necessarily need to be {i mmaped}. This
+    function also applies to "normal" bigarrays. It may also be worthwhile to
+    use this function if you know that you are copying a large area and would
+    like to do it in parallel (in a [Thread]). *)
+
+val memcmp : t -> src_off:int -> t -> dst_off:int -> len:int -> int
+(** [memcmp s1 ~src_off s2 ~dst_off ~len] compares the first [len] bytes of the
+    memory areas [s1] (starting at [src_off]) and [s2] (starting at [dst_off]).
+
+    [memcmp] returns [0] is [s1] and [s2] don't match.
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val memset : t -> off:int -> len:int -> char -> unit
+(** [memset t ~off ~len chr] fills [len] bytes (starting at [off]) into [t] with
+    the constant byte [chr].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [t]. *)
+
+val fill : t -> ?off:int -> ?len:int -> char -> unit
+(** [fill t off len chr] modifies [t] in place, replacing [len] characters with
+    [chr], starting at [off].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [t]. *)
+
+(** {2 Decode integers from a byte sequence.} *)
+
+val get_int8 : t -> int -> int
+(** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index
+    [i]. *)
+
+val get_uint8 : t -> int -> int
+(** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte index
+    [i]. *)
+
+val get_uint16_ne : t -> int -> int
+(** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_uint16_le : t -> int -> int
+(** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_uint16_be : t -> int -> int
+(** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_ne : t -> int -> int
+(** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_le : t -> int -> int
+(** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_be : t -> int -> int
+(** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer starting
+    at byte index [i]. *)
+
+val get_int32_ne : t -> int -> int32
+(** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int32_le : t -> int -> int32
+(** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int32_be : t -> int -> int32
+(** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at byte
+    index [i]. *)
+
+val get_int64_ne : t -> int -> int64
+(** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_le : t -> int -> int64
+(** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_be : t -> int -> int64
+(** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at byte
+    index [i]. *)
+
+val set_int8 : t -> int -> int -> unit
+(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i]
+    to [v]. *)
+
+val set_uint8 : t -> int -> int -> unit
+(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index
+    [i] to [v]. *)
+
+val set_uint16_ne : t -> int -> int -> unit
+(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_uint16_le : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_uint16_be : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting
+    at byte index [i] to [v]. *)
+
+val set_int16_ne : t -> int -> int -> unit
+(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_int16_le : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_int16_be : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting
+    at byte index [i] to [v]. *)
+
+val set_int32_ne : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int32_le : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int32_be : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte
+    index [i] to [v]. *)
+
+val set_int64_ne : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int64_le : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int64_be : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte
+    index [i] to [v]. *)
+
+val sub : t -> off:int -> len:int -> t
+(** [sub bstr ~off ~len] does not allocate a bigstring, but instead returns a
+    new view into [bstr] starting at [off], and with length [len].
+
+    {b Note} [sub] does not allocate a new buffer, but instead shares the memory
+    area of [bstr] with the newly-returned bigstring. This means that the
+    changes ([set{,_*}] functions) made to the returned bigstring will also be
+    reflected in the [bstr] bigstring given.
+
+    {b Note} [sub] is more expensive than a [Slice.sub] (about 8 times slower).
+    If you want to focus on performance while avoiding copying, it's best to use
+    a [Slice]. *)
+
+val shift : t -> int -> t
+(** [shift bstr n] is [sub bstr n (length bstr - n)] (see {!val:sub} for more
+    details). *)
+
+val overlap : t -> t -> (int * int * int) option
+(** [overlap x y] returns the size (in bytes) of what is physically common
+    between [x] and [y], as well as the position of [y] in [x] and the position
+    of [x] in [y]. *)
+
+(** {2 Predicates and comparaisons.} *)
+
+val is_empty : t -> bool
+(** [is_empty bstr] is [length bstr = 0]. *)
+
+val is_prefix : affix:string -> t -> bool
+(** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all
+    indices [idx] of [affix]. *)
+
+val starts_with : prefix:t -> t -> bool
+(** [starts_with ~prefix t] is like {!val:is_prefix} but the prefix is a
+    {!type:t} (instead of a [string]). *)
+
+val is_infix : affix:string -> t -> bool
+(** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr]
+    such that for all indices [i] of [affix] we have [affix.[i] = bstr.{j + i}].
+*)
+
+val is_suffix : affix:string -> t -> bool
+(** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}] for
+    all indices [idx] of [affix] with [n = String.length affix - 1] and
+    [m = length bstr - 1]. *)
+
+val ends_with : suffix:t -> t -> bool
+(** [ends_with ~suffix t] is like {!val:is_suffix} but the suffix is a {!type:t}
+    (instead of a [string]. *)
+
+val for_all : (char -> bool) -> t -> bool
+(** [for_all p bstr] is [true] iff for all indices [idx] of [bstr],
+    [p bstr.{idx} = true]. *)
+
+val contains : t -> ?off:int -> ?len:int -> char -> bool
+(** [contains bstr ?off ?len chr] is [true] if and only if [chr] appears in
+    [len] byte(s)'s [bstr] after position [off] (defaults to [0]). *)
+
+val equal : t -> t -> bool
+(** [equal a b] is [a = b]. *)
+
+val constant_equal : t -> t -> bool
+(** [constant_equal] gives the same result as {!val:equal} but the execution
+    time of the function, whether or not the two values are equivalent (as long
+    as they have the {b same} size) is the same.
+
+    Indeed, the {!val:equal} function ends as soon as a difference exists. This
+    function continues even if a difference exists. This function is useful when
+    comparing passwords — and avoiding an {i timing attack}. *)
+
+val compare : t -> t -> int
+(** [compare bstr0 bstr1] sorts [bstr0] and [bstr1] in lexicographical order. *)
+
+val index : t -> ?off:int -> ?len:int -> char -> int option
+(** [index bstr ?off ?len chr] is the index of the first occurrence of [chr] in
+    [len] byte(s)'s [bstr] after position [off] (defaults to [0]). If [chr] does
+    not occur in given range of [bstr], we return [None].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [bstr]. *)
+
+val memchr : t -> off:int -> len:int -> char -> int
+(** [memchr t ~off ~len chr] scans [len] bytes (starting at [off]) of [t] for
+    the first instance of [chr]. It returns the position in [t] where the first
+    occurrence of [chr] is found. Otherwise, it returns [-1].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [t]. *)
+
+(** {2 Extracting substrings.} *)
+
+val with_range : ?first:int -> ?len:int -> t -> t
+(** [with_range ~first ~len bstr] are the consecutive bytes of [bstr] whose
+    indices exist in the range \[[first];[first + len - 1]\].
+
+    [first] defaults to [0] and [len] to [max_int]. Note that [first] can be any
+    integer and [len] any positive integer. *)
+
+val with_index_range : ?first:int -> ?last:int -> t -> t
+(** [with_index_range ~first ~last bstr] are the consecutive bytes of [bstr]
+    whose indices exists in the range \[[first];[last]\].
+
+    [first] defaults to [0] and [last] to [length bstr - 1].
+
+    Note that both [first] and [last] can be any integer. If [first > last] the
+    interval is empty and the empty bigstring is returned. *)
+
+val trim : ?drop:(char -> bool) -> t -> t
+(** [trim ~drop bstr] is [bstr] with prefix and suffix bytes satisfying [drop]
+    in [bstr] removed. [drop] defaults to [fun chr -> chr = ' ']. *)
+
+val span :
+  ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t
+(** [span ~rev ~min ~max ~sat bstr] is [(l, r)] where:
+    - if [rev] is [false] (default), [l] is at least [min] and at most [max]
+      consecutive [sat] satisfying initial bytes of [bstr] or {!empty} if there
+      are no such bytes. [r] are the remaining bytes of [bstr].
+    - if [rev] is [true], [r] is at least [min] and at most [max] consecutive
+      [sat] satisfying final bytes of [bstr] or {!empty} if there are no such
+      bytes. [l] are the remaining bytes of [bstr].
+
+    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.const true].
+
+    @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 bstr] is the matching span of {!span} without the
+    remaining one. In other words:
+
+    {[
+      (if rev then snd else fst) (span ~rev ~min ~max ~sat bstr)
+    ]} *)
+
+val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
+(** [drop ~rev ~min ~max ~sat bstr] is the remaining span of {!span} without the
+    matching span. In other words:
+
+    {[
+      (if rev then fst else snd) (span ~rev ~min ~max ~sat bstr)
+    ]} *)
+
+val cut : ?rev:bool -> sep:string -> t -> (t * t) option
+(** [cut ~sep bstr] is either the pair [Some (l, r)] of the two (possibly empty)
+    sub-buffers of [bstr] that are delimited by the first match of the non empty
+    separator string [sep] or [None] if [sep] can't be matched in [bstr].
+    Matching starts from the beginning of [bstr] ([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 Bstr.cut ~sep:":" value with
+      | Some (field_name, field_value) -> ...
+      | None -> invalid_arg "Invalid field"
+    ]}
+
+    @raise Invalid_argument if [sep] is the empty buffer. *)
+
+val split_on_char : char -> t -> t list
+(** [split_on_char sep t] is the list of all (possibly empty)
+    {!val:sub}-bigstrings of [t] that are delimited by the character [sep]. If
+    [t] is empty, the result is the singleton list [[empty]].
+
+    The function's result is specified by the following invariant:
+    - the list is not empty.
+    - concatenating its elements using [sep] as a separator returns a bigstring
+      equal to the input.
+    - no bigstring in the result contains the [sep] character. *)
+
+(** {2 Traversing strings.} *)
+
+val iter : (char -> unit) -> t -> unit
+(** [iter fn t] applies function [fn] in turn to all the characters of [t]. It
+    is equivalent to [fn t.{0}; fn t.{1}; ...; fn t.{length t - 1}; ()]. *)
+
+val to_seq : t -> char Seq.t
+(** Iterate on the bigstring, in increasing index order. Modifications of the
+    bigstring during iteration will be reflected in the sequence. *)
+
+val to_seqi : t -> (int * char) Seq.t
+(** Iterate on the bigstring, in increasing order, yielding indices along chars.
+*)
+
+val of_seq : char Seq.t -> t
+(** Create a bigstring from the generator. *)

unikernel/duniverse/bstr/lib/bstr.mllib

@@ -0,0 +1,2 @@
+lib/bstr.o
+lib/bstr.cmx

unikernel/duniverse/bstr/lib/bytes_labels.ml

@@ -0,0 +1,40 @@
+(*
+ * Copyright (c) 2024 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 Bytes
+
+let[@inline always] blit src ~src_off dst ~dst_off ~len =
+  Bytes.blit src src_off dst dst_off len
+
+let[@inline always] fill t ~off ~len chr = Bytes.fill t off len chr
+
+let[@inline always] blit_to_bytes src ~src_off dst ~dst_off ~len =
+  Bytes.blit src src_off dst dst_off len
+
+let string ?(off = 0) ?len str =
+  let len =
+    match len with Some len -> len | None -> String.length str - off
+  in
+  if len < 0 || off < 0 || off > String.length str - len then
+    invalid_arg "Bytes.string";
+  let buf = String.sub str off len in
+  Bytes.unsafe_of_string buf
+
+let overlap a b = if a == b then Some (Bytes.length a, 0, 0) else None
+let sub t ~off ~len = Bytes.sub t off len
+
+let blit_from_bytes src ~src_off dst ~dst_off ~len =
+  Bytes.blit src src_off dst dst_off len

unikernel/duniverse/bstr/lib/dune

@@ -0,0 +1,54 @@
+(library
+ (name bstr)
+ (modules bstr)
+ (public_name bstr)
+ (foreign_stubs
+  (language c)
+  (names bstr)
+  (flags
+   (:standard -Wcast-align)))
+ (instrumentation
+  (backend bisect_ppx))
+ (wrapped false))
+
+(library
+ (name slice)
+ (modules slice)
+ (public_name slice)
+ (instrumentation
+  (backend bisect_ppx))
+ (wrapped false))
+
+(library
+ (name slice_bytes)
+ (modules bytes_labels slice_bytes)
+ (public_name slice.bytes)
+ (libraries slice)
+ (wrapped false))
+
+(library
+ (name slice_bstr)
+ (modules slice_bstr)
+ (public_name slice.bstr)
+ (libraries bstr slice)
+ (wrapped false))
+
+(rule
+ (target slice_bytes.ml)
+ (action
+  (run ./../bin/generate.exe -m S -n Bytes_labels -i %{dep:slice.ml.in} -o
+    %{target})))
+
+(rule
+ (target slice_bstr.ml)
+ (action
+  (run ./../bin/generate.exe -m S -n Bstr -i %{dep:slice.ml.in} -o %{target})))
+
+(library
+ (name bin)
+ (modules bin)
+ (public_name bin)
+ (libraries bstr slice)
+ (instrumentation
+  (backend bisect_ppx))
+ (wrapped false))

unikernel/duniverse/bstr/lib/slice.ml

@@ -0,0 +1,183 @@
+(*
+ * Copyright (c) 2024 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.
+ *)
+
+type 'a t = { buf: 'a; off: int; len: int }
+
+let unsafe_make ~off ~len buf = { off; len; buf }
+let unsafe_sub { off; buf; _ } off' len' = { off= off + off'; len= len'; buf }
+
+let pp ppf { off; len; _ } =
+  Format.fprintf ppf "@[<hov>{ off=@ %d;@ len=@ %d;@ }@]" off len
+
+let length { len; _ } = len
+let is_empty { len; _ } = len == 0
+
+let sub t ~off ~len =
+  let off' = t.off + off in
+  let top = off' + len in
+  let old = t.off + t.len in
+  if off' >= t.off && top <= old && off' <= top then { t with off= off'; len }
+  else invalid_arg "Slice.sub"
+
+let shift t off =
+  if off > length t || off < 0 then invalid_arg "Slice.shift";
+  let len = length t - off in
+  unsafe_sub t off len
+
+module type R = sig
+  type t
+
+  val make : int -> char -> t
+  val init : int -> (int -> char) -> t
+  val empty : t
+  val length : t -> int
+  val is_empty : t -> bool
+  val chop : ?rev:bool -> t -> char option
+  val hash : t -> int
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+  val get : t -> int -> char
+  val unsafe_get : t -> int -> char
+
+  val get_int8 : t -> int -> int
+  (** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index
+      [i]. *)
+
+  val get_uint8 : t -> int -> int
+  (** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte
+      index [i]. *)
+
+  val get_uint16_ne : t -> int -> int
+  (** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_uint16_le : t -> int -> int
+  (** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_uint16_be : t -> int -> int
+  (** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int16_ne : t -> int -> int
+  (** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int16_le : t -> int -> int
+  (** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int16_be : t -> int -> int
+  (** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int32_ne : t -> int -> int32
+  (** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at
+      byte index [i]. *)
+
+  val get_int32_le : t -> int -> int32
+  (** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at
+      byte index [i]. *)
+
+  val get_int32_be : t -> int -> int32
+  (** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at
+      byte index [i]. *)
+
+  val get_int64_ne : t -> int -> int64
+  (** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at
+      byte index [i]. *)
+
+  val get_int64_le : t -> int -> int64
+  (** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at
+      byte index [i]. *)
+
+  val get_int64_be : t -> int -> int64
+  (** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at
+      byte index [i]. *)
+
+  val filter : (char -> bool) -> t -> t
+  val filter_map : (char -> char option) -> t -> t
+  val map : (char -> char) -> t -> t
+  val mapi : (int -> char -> char) -> t -> t
+  val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a
+  val fold_right : (char -> 'a -> 'a) -> t -> 'a -> 'a
+  val iter : (char -> unit) -> t -> unit
+  val iteri : (int -> char -> unit) -> t -> unit
+  val hex : t -> string
+  val overlap : t -> t -> (int * int * int) option
+  val append : t -> t -> t
+  val starts_with : prefix:string -> t -> bool
+
+  val is_prefix : affix:string -> t -> bool
+  (** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all
+      indices [idx] of [affix]. *)
+
+  val ends_with : suffix:string -> t -> bool
+
+  val is_suffix : affix:string -> t -> bool
+  (** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}]
+      for all indices [idx] of [affix] with [n = String.length affix - 1] and
+      [m = length bstr - 1]. *)
+
+  val is_infix : affix:string -> t -> bool
+  (** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr]
+      such that for all indices [i] of [affix] we have
+      [affix.[i] = bstr.{j + i}]. *)
+
+  val for_all : (char -> bool) -> t -> bool
+  val exists : (char -> bool) -> t -> bool
+  val trim : ?drop:(char -> bool) -> t -> t
+
+  val span :
+    ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t
+
+  val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
+  val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
+  val shift : t -> int -> t
+  val sub : t -> off:int -> len:int -> t
+  val split_on_char : char -> t -> t list
+  val cut : ?rev:bool -> sep:string -> t -> (t * t) option
+  val cuts : ?rev:bool -> ?empty:bool -> sep:string -> t -> t list
+  val index : t -> ?rev:bool -> ?from:int -> char -> int
+  val contains : t -> ?rev:bool -> ?from:int -> char -> bool
+  val concat : t -> t list -> t
+  val copy : t -> t
+  val sub_string : t -> off:int -> len:int -> string
+  val to_string : t -> string
+end
+
+module type W = sig
+  type t
+
+  val set : t -> int -> char -> unit
+  val unsafe_set : t -> int -> char -> unit
+  val set_int8 : t -> int -> int -> unit
+  val set_uint8 : t -> int -> int -> unit
+  val set_uint16_ne : t -> int -> int -> unit
+  val set_uint16_le : t -> int -> int -> unit
+  val set_uint16_be : t -> int -> int -> unit
+  val set_int16_ne : t -> int -> int -> unit
+  val set_int16_le : t -> int -> int -> unit
+  val set_int16_be : t -> int -> int -> unit
+  val set_int32_ne : t -> int -> int32 -> unit
+  val set_int32_le : t -> int -> int32 -> unit
+  val set_int32_be : t -> int -> int32 -> unit
+  val set_int64_ne : t -> int -> int64 -> unit
+  val set_int64_le : t -> int -> int64 -> unit
+  val set_int64_be : t -> int -> int64 -> unit
+  val fill : t -> off:int -> len:int -> char -> unit
+  val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
+end

unikernel/duniverse/bstr/lib/slice.ml.in

@@ -0,0 +1,148 @@
+(*
+ * Copyright (c) 2024 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.
+ *)
+
+type t = S.t Slice.t
+
+external ( < ) : 'a -> 'a -> bool = "%lessthan"
+external ( <= ) : 'a -> 'a -> bool = "%lessequal"
+external ( >= ) : 'a -> 'a -> bool = "%greaterequal"
+external ( > ) : 'a -> 'a -> bool = "%greaterthan"
+
+let ( > ) (x : int) y = x > y [@@inline]
+let ( < ) (x : int) y = x < y [@@inline]
+let ( <= ) (x : int) y = x <= y [@@inline]
+let ( >= ) (x : int) y = x >= y [@@inline]
+let min (a : int) b = if a <= b then a else b [@@inline]
+let max (a : int) b = if a >= b then a else b [@@inline]
+
+open Slice
+
+let make ?(off= 0) ?len buf =
+  let len = match len with
+    | Some len -> len
+    | None -> S.length buf - off in
+  if len < 0
+  || off < 0
+  || off > S.length buf - len
+  then invalid_arg "Slice.make";
+  Slice.unsafe_make ~off ~len buf
+
+let empty = unsafe_make ~off:0 ~len:0 S.empty
+let length { len; _ } = len
+let get { off; buf; _ } idx = S.get buf (off + idx)
+let get_int8 { off; buf; _ } idx = S.get_int8 buf (off + idx)
+let get_uint8 { off; buf; _ } idx = S.get_uint8 buf (off + idx)
+let get_uint16_ne { off; buf; _ } idx = S.get_uint16_ne buf (off + idx)
+let get_uint16_le { off; buf; _ } idx = S.get_uint16_le buf (off + idx)
+let get_uint16_be { off; buf; _ } idx = S.get_uint16_be buf (off + idx)
+let get_int16_ne { off; buf; _ } idx = S.get_int16_ne buf (off + idx)
+let get_int16_le { off; buf; _ } idx = S.get_int16_ne buf (off + idx)
+let get_int16_be { off; buf; _ } idx = S.get_int16_be buf (off + idx)
+let get_int32_ne { off; buf; _ } idx = S.get_int32_ne buf (off + idx)
+let get_int32_le { off; buf; _ } idx = S.get_int32_le buf (off + idx)
+let get_int32_be { off; buf; _ } idx = S.get_int32_be buf (off + idx)
+let get_int64_ne { off; buf; _ } idx = S.get_int64_ne buf (off + idx)
+let get_int64_le { off; buf; _ } idx = S.get_int64_le buf (off + idx)
+let get_int64_be { off; buf; _ } idx = S.get_int64_be buf (off + idx)
+let set { off; buf; _ } idx v = S.set buf (off + idx) v
+let set_int8 { off; buf; _ } idx v = S.set_int8 buf (off + idx) v
+let set_uint8 { off; buf; _ } idx v = S.set_uint8 buf (off + idx) v
+let set_uint16_ne { off; buf; _ } idx v = S.set_uint16_ne buf (off + idx) v
+let set_uint16_le { off; buf; _ } idx v = S.set_uint16_le buf (off + idx) v
+let set_uint16_be { off; buf; _ } idx v = S.set_uint16_be buf (off + idx) v
+let set_int16_ne { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v
+let set_int16_le { off; buf; _ } idx v = S.set_int16_ne buf (off + idx) v
+let set_int16_be { off; buf; _ } idx v = S.set_int16_be buf (off + idx) v
+let set_int32_ne { off; buf; _ } idx v = S.set_int32_ne buf (off + idx) v
+let set_int32_le { off; buf; _ } idx v = S.set_int32_le buf (off + idx) v
+let set_int32_be { off; buf; _ } idx v = S.set_int32_be buf (off + idx) v
+let set_int64_ne { off; buf; _ } idx v = S.set_int64_ne buf (off + idx) v
+let set_int64_le { off; buf; _ } idx v = S.set_int64_le buf (off + idx) v
+let set_int64_be { off; buf; _ } idx v = S.set_int64_be buf (off + idx) v
+
+let blit a b =
+  let len = Int.min a.len b.len in
+  S.blit a.buf ~src_off:a.off b.buf ~dst_off:b.off ~len:len
+
+let blit_from_bytes src ~src_off { Slice.buf; off; _ } ?dst_off len =
+  let dst_off = match dst_off with
+    | Some dst_off -> dst_off + off
+    | None -> off in
+  if len < 0
+  || dst_off < 0
+  || dst_off > S.length buf - len
+  then invalid_arg "Slice.blit_from_bytes";
+  S.blit_from_bytes src ~src_off buf ~dst_off ~len
+
+let blit_to_bytes { Slice.buf; off; _ } ?src_off dst ~dst_off ~len =
+  let src_off = match src_off with
+    | Some src_off -> src_off + off
+    | None -> off in
+  if len < 0
+  || src_off < 0
+  || src_off > S.length buf - len
+  then invalid_arg "Slice.blit_to_bytes";
+  S.blit_to_bytes buf ~src_off dst ~dst_off ~len
+
+let fill { off; len; buf; } ?off:(off'= 0) ?len:len' chr =
+  let len' = match len' with
+    | Some len' -> len'
+    | None -> len - off' in
+  S.fill buf ~off:(off + off') ~len:len' chr
+
+let sub t ~off ~len = Slice.sub t ~off ~len
+let shift t n = Slice.shift t n
+let is_empty t = Slice.is_empty t
+
+let sub_string { Slice.buf; off; _ } ~off:off' ~len =
+  let dst = Bytes.create len in
+  S.blit_to_bytes buf ~src_off:(off + off') dst ~dst_off:0 ~len;
+  Bytes.unsafe_to_string dst
+
+let to_string { Slice.buf; off= src_off; len } =
+  let dst = Bytes.create len in
+  S.blit_to_bytes buf ~src_off dst ~dst_off:0 ~len;
+  Bytes.unsafe_to_string dst
+
+let of_string str =
+  let off = 0 and len = String.length str in
+  Slice.unsafe_make ~off ~len (S.of_string str)
+
+let string ?(off= 0) ?len str =
+  let len = match len with 
+    | None -> String.length str - off 
+    | Some len -> len in
+  Slice.unsafe_make ~off:0 ~len (S.string ~off ~len str)
+
+let overlap ({ buf= buf0; _ } as a) ({ buf= buf1; _ } as b) =
+  match S.overlap buf0 buf1 with
+  | None -> None
+  | Some (_, 0, 0) ->
+      let len =
+        max 0 (min (a.off + a.len) (b.off + b.len)) - max a.off b.off in
+      if a.off >= b.off && a.off < b.off + b.len
+      then
+        let offset = a.off - b.off in Some (len, 0, offset)
+      else if b.off >= a.off && b.off < a.off + a.len
+      then
+        let offset = b.off + a.off in Some (len, offset, 0)
+      else None
+  | Some _ ->
+      let a = S.sub buf0 ~off:a.off ~len:a.len
+      and b = S.sub buf1 ~off:b.off ~len:b.len in
+      S.overlap a b
+      (* TODO(dinosaure): this case appears only for bigstrings, but we could
+         optimize it and avoid [S.sub]. *)

unikernel/duniverse/bstr/lib/slice.mli

@@ -0,0 +1,175 @@
+type 'buf t = private { buf: 'buf; off: int; len: int }
+
+val unsafe_make : off:int -> len:int -> 'buf -> 'buf t
+val pp : Format.formatter -> 'a t -> unit
+val length : 'a t -> int
+val sub : 'a t -> off:int -> len:int -> 'a t
+val shift : 'a t -> int -> 'a t
+val is_empty : 'a t -> bool
+
+module type R = sig
+  type t
+
+  val make : int -> char -> t
+  (** [make len chr] is {!type:t} of length [len] with each index holding the
+      character [chr]. *)
+
+  val init : int -> (int -> char) -> t
+  (** [init len fn] is {!type:t} of length [len] with index [idx] holding the
+      character [fn idx] (called in increasing index order). *)
+
+  val empty : t
+  (** An empty {!type:t}. *)
+
+  val length : t -> int
+  (** [length t] is the length (number of bytes/characters) of [t]. *)
+
+  val is_empty : t -> bool
+  (** [is_empty t] is [length t = 0]. *)
+
+  val chop : ?rev:bool -> t -> char option
+  (** [chop t] is [Some (get t idx)] with [idx = 0] if [rev = false] (default)
+      or [idx = length t - 1] if [rev = true]. [None] is returned if [t] is
+      empty. *)
+
+  val hash : t -> int
+  val equal : t -> t -> bool
+  val compare : t -> t -> int
+  val get : t -> int -> char
+  val unsafe_get : t -> int -> char
+
+  val get_int8 : t -> int -> int
+  (** [get_int8 bstr i] is [bstr]'s signed 8-bit integer starting at byte index
+      [i]. *)
+
+  val get_uint8 : t -> int -> int
+  (** [get_uint8 bstr i] is [bstr]'s unsigned 8-bit integer starting at byte
+      index [i]. *)
+
+  val get_uint16_ne : t -> int -> int
+  (** [get_int16_ne bstr i] is [bstr]'s native-endian unsigned 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_uint16_le : t -> int -> int
+  (** [get_int16_le bstr i] is [bstr]'s little-endian unsigned 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_uint16_be : t -> int -> int
+  (** [get_int16_be bstr i] is [bstr]'s big-endian unsigned 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int16_ne : t -> int -> int
+  (** [get_int16_ne bstr i] is [bstr]'s native-endian signed 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int16_le : t -> int -> int
+  (** [get_int16_le bstr i] is [bstr]'s little-endian signed 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int16_be : t -> int -> int
+  (** [get_int16_be bstr i] is [bstr]'s big-endian signed 16-bit integer
+      starting at byte index [i]. *)
+
+  val get_int32_ne : t -> int -> int32
+  (** [get_int32_ne bstr i] is [bstr]'s native-endian 32-bit integer starting at
+      byte index [i]. *)
+
+  val get_int32_le : t -> int -> int32
+  (** [get_int32_le bstr i] is [bstr]'s little-endian 32-bit integer starting at
+      byte index [i]. *)
+
+  val get_int32_be : t -> int -> int32
+  (** [get_int32_be bstr i] is [bstr]'s big-endian 32-bit integer starting at
+      byte index [i]. *)
+
+  val get_int64_ne : t -> int -> int64
+  (** [get_int64_ne bstr i] is [bstr]'s native-endian 64-bit integer starting at
+      byte index [i]. *)
+
+  val get_int64_le : t -> int -> int64
+  (** [get_int64_le bstr i] is [bstr]'s little-endian 64-bit integer starting at
+      byte index [i]. *)
+
+  val get_int64_be : t -> int -> int64
+  (** [get_int64_be bstr i] is [bstr]'s big-endian 64-bit integer starting at
+      byte index [i]. *)
+
+  val filter : (char -> bool) -> t -> t
+  (** [filter sat t] is a new {!type:t} made of the bytes of [t] that satisfy
+      [sat], in the same order. *)
+
+  val filter_map : (char -> char option) -> t -> t
+  (** [filter_map fn t] is a new {!type:t} made of the bytes of [t] as mapped by
+      [fn], in the same order. *)
+
+  val map : (char -> char) -> t -> t
+  val mapi : (int -> char -> char) -> t -> t
+  val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a
+  val fold_right : (char -> 'a -> 'a) -> t -> 'a -> 'a
+  val iter : (char -> unit) -> t -> unit
+  val iteri : (int -> char -> unit) -> t -> unit
+  val hex : t -> string
+  val overlap : t -> t -> (int * int * int) option
+  val append : t -> t -> t
+  val starts_with : prefix:string -> t -> bool
+
+  val is_prefix : affix:string -> t -> bool
+  (** [is_prefix ~affix bstr] is [true] iff [affix.[idx] = bstr.{idx}] for all
+      indices [idx] of [affix]. *)
+
+  val ends_with : suffix:string -> t -> bool
+
+  val is_suffix : affix:string -> t -> bool
+  (** [is_suffix ~affix bstr] is [true] iff [affix.[n - idx] = bstr.{m - idx}]
+      for all indices [idx] of [affix] with [n = String.length affix - 1] and
+      [m = length bstr - 1]. *)
+
+  val is_infix : affix:string -> t -> bool
+  (** [is_infix ~affix bstr] is [true] iff there exists an index [j] in [bstr]
+      such that for all indices [i] of [affix] we have
+      [affix.[i] = bstr.{j + i}]. *)
+
+  val for_all : (char -> bool) -> t -> bool
+  val exists : (char -> bool) -> t -> bool
+  val trim : ?drop:(char -> bool) -> t -> t
+
+  val span :
+    ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t * t
+
+  val take : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
+  val drop : ?rev:bool -> ?min:int -> ?max:int -> ?sat:(char -> bool) -> t -> t
+  val shift : t -> int -> t
+  val sub : t -> off:int -> len:int -> t
+  val split_on_char : char -> t -> t list
+  val cut : ?rev:bool -> sep:string -> t -> (t * t) option
+  val cuts : ?rev:bool -> ?empty:bool -> sep:string -> t -> t list
+  val index : t -> ?rev:bool -> ?from:int -> char -> int
+  val contains : t -> ?rev:bool -> ?from:int -> char -> bool
+  val concat : t -> t list -> t
+  val copy : t -> t
+  val sub_string : t -> off:int -> len:int -> string
+  val to_string : t -> string
+end
+
+module type W = sig
+  type t
+
+  val set : t -> int -> char -> unit
+  val unsafe_set : t -> int -> char -> unit
+  val set_int8 : t -> int -> int -> unit
+  val set_uint8 : t -> int -> int -> unit
+  val set_uint16_ne : t -> int -> int -> unit
+  val set_uint16_le : t -> int -> int -> unit
+  val set_uint16_be : t -> int -> int -> unit
+  val set_int16_ne : t -> int -> int -> unit
+  val set_int16_le : t -> int -> int -> unit
+  val set_int16_be : t -> int -> int -> unit
+  val set_int32_ne : t -> int -> int32 -> unit
+  val set_int32_le : t -> int -> int32 -> unit
+  val set_int32_be : t -> int -> int32 -> unit
+  val set_int64_ne : t -> int -> int64 -> unit
+  val set_int64_le : t -> int -> int64 -> unit
+  val set_int64_be : t -> int -> int64 -> unit
+  val fill : t -> off:int -> len:int -> char -> unit
+  val blit : t -> src_off:int -> t -> dst_off:int -> len:int -> unit
+end

unikernel/duniverse/bstr/lib/slice_bstr.mli

@@ -0,0 +1,202 @@
+type t = Bstr.t Slice.t
+
+val make : ?off:int -> ?len:int -> Bstr.t -> t
+
+val empty : t
+(** [empty] is an empty slice. *)
+
+val length : t -> int
+(** [length slice] is the number of bytes in [slice]. *)
+
+val get : t -> int -> char
+(** [get slice i] is the byte of [slice]' at index [i].
+
+    @raise Invalid_argument if [i] is not an index of [slice]. *)
+
+val get_int8 : t -> int -> int
+(** [get_int8 slice i] is [slice]'s signed 8-bit integer starting at byte index
+    [i]. *)
+
+val get_uint8 : t -> int -> int
+(** [get_uint8 slice i] is [slice]'s unsigned 8-bit integer starting at byte
+    index [i]. *)
+
+val get_uint16_ne : t -> int -> int
+(** [get_int16_ne slice i] is [slice]'s native-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_uint16_le : t -> int -> int
+(** [get_int16_le slice i] is [slice]'s little-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_uint16_be : t -> int -> int
+(** [get_int16_be slice i] is [slice]'s big-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_ne : t -> int -> int
+(** [get_int16_ne slice i] is [slice]'s native-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_le : t -> int -> int
+(** [get_int16_le slice i] is [slice]'s little-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_be : t -> int -> int
+(** [get_int16_be slice i] is [slice]'s big-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int32_ne : t -> int -> int32
+(** [get_int32_ne slice i] is [slice]'s native-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int32_le : t -> int -> int32
+(** [get_int32_le slice i] is [slice]'s little-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int32_be : t -> int -> int32
+(** [get_int32_be slice i] is [slice]'s big-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_ne : t -> int -> int64
+(** [get_int64_ne slice i] is [slice]'s native-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_le : t -> int -> int64
+(** [get_int64_le slice i] is [slice]'s little-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_be : t -> int -> int64
+(** [get_int64_be slice i] is [slice]'s big-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val set : t -> int -> char -> unit
+(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with
+    [chr].
+
+    @raise Invalid_argument if [i] is not a valid index in [t]. *)
+
+val set_int8 : t -> int -> int -> unit
+(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i]
+    to [v]. *)
+
+val set_uint8 : t -> int -> int -> unit
+(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index
+    [i] to [v]. *)
+
+val set_uint16_ne : t -> int -> int -> unit
+(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_uint16_le : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_uint16_be : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting
+    at byte index [i] to [v]. *)
+
+val set_int16_ne : t -> int -> int -> unit
+(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_int16_le : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_int16_be : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting
+    at byte index [i] to [v]. *)
+
+val set_int32_ne : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int32_le : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int32_be : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte
+    index [i] to [v]. *)
+
+val set_int64_ne : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int64_le : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int64_be : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte
+    index [i] to [v]. *)
+
+val blit : t -> t -> unit
+(** [blit src dst] copies all bytes of [src] into [dst]. *)
+
+val blit_from_bytes : bytes -> src_off:int -> t -> ?dst_off:int -> int -> unit
+(** [blit_from_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from
+    byte sequence [src], starting at index [src_off], to slice [dst], starting
+    at index [dst_off].
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val blit_to_bytes : t -> ?src_off:int -> bytes -> dst_off:int -> len:int -> unit
+(** Just like {!val:blit_from_bytes}, but the source is a slice and the
+    destination is a [byte]s sequence.
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val fill : t -> ?off:int -> ?len:int -> char -> unit
+(** [fill t off len chr] modifies [t] in place, replacing [len] characters with
+    [chr], starting at [off].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [t]. *)
+
+val sub : t -> off:int -> len:int -> t
+(** [sub slice ~off ~len] does not allocate a new [bigstring], but instead
+    returns a new view into [t.buf] starting at [off], and with length [len].
+
+    {b Note} that this does not allocate a new buffer, but instead shares the
+    buffer of [t.buf] with the newly-returned slice. *)
+
+val shift : t -> int -> t
+(** [shift slice n] is [sub slice n (length slice - n)] (see {!val:sub} for more
+    details). *)
+
+val sub_string : t -> off:int -> len:int -> string
+(** [sub_string slice ~off ~len] returns a string of length [len] containing the
+    bytes of [slice] starting at [off].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [t]. *)
+
+val to_string : t -> string
+(** [to_string slice] is equivalent to
+    [sub_string slice ~off:0 ~len:(length slice)]. *)
+
+val is_empty : t -> bool
+(** [is_empty bstr] is [length bstr = 0]. *)
+
+val of_string : string -> t
+(** [of_string str] returns a new {!type:t} that contains the contents of the
+    given string [str]. *)
+
+val string : ?off:int -> ?len:int -> string -> t
+(** [string ~off ~len str] is the sub-buffer 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 a fresh allocated
+    {!type:t}.
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [str]. *)
+
+val overlap : t -> t -> (int * int * int) option
+(** [overlap x y] returns the size (in bytes) of what is physically common
+    between [x] and [y], as well as the position of [y] in [x] and the position
+    of [x] in [y]. *)

unikernel/duniverse/bstr/lib/slice_bytes.mli

@@ -0,0 +1,196 @@
+type t = bytes Slice.t
+
+val make : ?off:int -> ?len:int -> bytes -> t
+
+val empty : t
+(** [empty] is an empty slice. *)
+
+val length : t -> int
+(** [length slice] is the number of bytes in [slice]. *)
+
+val get : t -> int -> char
+(** [get slice i] is the byte of [slice]' at index [i].
+
+    @raise Invalid_argument if [i] is not an index of [slice]. *)
+
+val get_int8 : t -> int -> int
+(** [get_int8 slice i] is [slice]'s signed 8-bit integer starting at byte index
+    [i]. *)
+
+val get_uint8 : t -> int -> int
+(** [get_uint8 slice i] is [slice]'s unsigned 8-bit integer starting at byte
+    index [i]. *)
+
+val get_uint16_ne : t -> int -> int
+(** [get_int16_ne slice i] is [slice]'s native-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_uint16_le : t -> int -> int
+(** [get_int16_le slice i] is [slice]'s little-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_uint16_be : t -> int -> int
+(** [get_int16_be slice i] is [slice]'s big-endian unsigned 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_ne : t -> int -> int
+(** [get_int16_ne slice i] is [slice]'s native-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_le : t -> int -> int
+(** [get_int16_le slice i] is [slice]'s little-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int16_be : t -> int -> int
+(** [get_int16_be slice i] is [slice]'s big-endian signed 16-bit integer
+    starting at byte index [i]. *)
+
+val get_int32_ne : t -> int -> int32
+(** [get_int32_ne slice i] is [slice]'s native-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int32_le : t -> int -> int32
+(** [get_int32_le slice i] is [slice]'s little-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int32_be : t -> int -> int32
+(** [get_int32_be slice i] is [slice]'s big-endian 32-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_ne : t -> int -> int64
+(** [get_int64_ne slice i] is [slice]'s native-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_le : t -> int -> int64
+(** [get_int64_le slice i] is [slice]'s little-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val get_int64_be : t -> int -> int64
+(** [get_int64_be slice i] is [slice]'s big-endian 64-bit integer starting at
+    byte index [i]. *)
+
+val set : t -> int -> char -> unit
+(** [set t i chr] modifies [t] in place, replacing the byte at index [i] with
+    [chr].
+
+    @raise Invalid_argument if [i] is not a valid index in [t]. *)
+
+val set_int8 : t -> int -> int -> unit
+(** [set_int8 t i v] sets [t]'s signed 8-bit integer starting at byte index [i]
+    to [v]. *)
+
+val set_uint8 : t -> int -> int -> unit
+(** [set_uint8 t i v] sets [t]'s unsigned 8-bit integer starting at byte index
+    [i] to [v]. *)
+
+val set_uint16_ne : t -> int -> int -> unit
+(** [set_uint16_ne t i v] sets [t]'s native-endian unsigned 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_uint16_le : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s little-endian unsigned 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_uint16_be : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s big-endian unsigned 16-bit integer starting
+    at byte index [i] to [v]. *)
+
+val set_int16_ne : t -> int -> int -> unit
+(** [set_uint16_ne t i v] sets [t]'s native-endian signed 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_int16_le : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s little-endian signed 16-bit integer
+    starting at byte index [i] to [v]. *)
+
+val set_int16_be : t -> int -> int -> unit
+(** [set_uint16_le t i v] sets [t]'s big-endian signed 16-bit integer starting
+    at byte index [i] to [v]. *)
+
+val set_int32_ne : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s native-endian 32-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int32_le : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s little-endian 32-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int32_be : t -> int -> int32 -> unit
+(** [set_int32_ne t i v] sets [t]'s big-endian 32-bit integer starting at byte
+    index [i] to [v]. *)
+
+val set_int64_ne : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s native-endian 64-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int64_le : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s little-endian 64-bit integer starting at
+    byte index [i] to [v]. *)
+
+val set_int64_be : t -> int -> int64 -> unit
+(** [set_int32_ne t i v] sets [t]'s big-endian 64-bit integer starting at byte
+    index [i] to [v]. *)
+
+val blit : t -> t -> unit
+(** [blit src dst] copies all bytes of [src] into [dst]. *)
+
+val blit_from_bytes : bytes -> src_off:int -> t -> ?dst_off:int -> int -> unit
+(** [blit_from_bytes src ~src_off dst ~dst_off ~len] copies [len] bytes from
+    byte sequence [src], starting at index [src_off], to slice [dst], starting
+    at index [dst_off].
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val blit_to_bytes : t -> ?src_off:int -> bytes -> dst_off:int -> len:int -> unit
+(** Just like {!val:blit_from_bytes}, but the source is a slice and the
+    destination is a [byte]s sequence.
+
+    @raise Invalid_argument
+      if [src_off] and [len] do not designate a valid range of [src], or if
+      [dst_off] and [len] do not designate a valid range of [dst]. *)
+
+val fill : t -> ?off:int -> ?len:int -> char -> unit
+(** [fill t off len chr] modifies [t] in place, replacing [len] characters with
+    [chr], starting at [off].
+
+    @raise Invalid_argument
+      if [off] and [len] do not designate a valid range of [t]. *)
+
+val sub : t -> off:int -> len:int -> t
+(** [sub slice ~off ~len] does not allocate a new [bytes], but instead returns a
+    new view into [t.buf] starting at [off], and with length [len].
+
+    {b Note} that this does not allocate a new buffer, but instead shares the
+    buffer of [t.buf] with the newly-returned slice. *)
+
+val shift : t -> int -> t
+(** [shift slice n] is [sub slice n (length slice - n)] (see {!val:sub} for more
+    details). *)
+
+val sub_string : t -> off:int -> len:int -> string
+(** [sub_string slice ~off ~len] returns a string of length [len] containing the
+    bytes of [slice] starting at [off]. *)
+
+val to_string : t -> string
+(** [to_string slice] is equivalent to
+    [sub_string slice ~off:0 ~len:(length slice)]. *)
+
+val is_empty : t -> bool
+(** [is_empty bstr] is [length bstr = 0]. *)
+
+val of_string : string -> t
+(** [of_string str] returns a new {!type:t} that contains the contents of the
+    given string [str]. *)
+
+val string : ?off:int -> ?len:int -> string -> t
+(** [string ~off ~len str] is the sub-buffer 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 a fresh allocated
+    {!type:t}. *)
+
+val overlap : t -> t -> (int * int * int) option
+(** [overlap x y] returns the size (in bytes) of what is physically common
+    between [x] and [y], as well as the position of [y] in [x] and the position
+    of [x] in [y]. *)

unikernel/duniverse/bstr/slice.opam

@@ -0,0 +1,21 @@
+version: "0.0.2"
+opam-version: "2.0"
+name:         "slice"
+maintainer:   [ "Romain Calascibetta <romain.calascibetta@gmail.com>" ]
+authors:      [ "Romain Calascibetta <romain.calascibetta@gmail.com>" ]
+homepage:     "https://git.robur.coop/robur/bstr"
+bug-reports:  "https://git.robur.coop/robur/bstr"
+dev-repo:     "git+https://github.com/robur-coop/bstr"
+doc:          "https://robur-coop.github.io/bstr/"
+license:      "MIT"
+synopsis:     "A Slice type for bigstrings and bytes"
+
+build: [ "dune" "build" "-p" name "-j" jobs ]
+run-test: [ "dune" "runtest" "-p" name "-j" jobs ]
+
+depends: [
+  "ocaml"       {>= "4.14.0"}
+  "dune"        {>= "3.5.0"}
+  "bstr"        {= version}
+]
+x-maintenance-intent: [ "(latest)" ]

unikernel/duniverse/bstr/test/b.ml

@@ -0,0 +1,53 @@
+open Test
+
+let test01 =
+  let descr = {text|cstring|text} in
+  Test.test ~title:"cstring" ~descr @@ fun () ->
+  let buf = Bstr.create 0x7ff in
+  let test str =
+    let pos = ref 0 in
+    let len = String.length str in
+    Bin.encode_bstr Bin.cstring str buf pos;
+    check (!pos == len + 1);
+    check (Bstr.get_uint8 buf len == 0);
+    check (Bstr.sub_string buf ~off:0 ~len = str);
+    pos := 0;
+    let str' = Bin.decode_bstr Bin.cstring buf pos in
+    check (!pos == len + 1);
+    check (str = str')
+  in
+  test "foo"; test "bar"
+
+let test02 =
+  let descr = {text|varint|text} in
+  Test.test ~title:"varint" ~descr @@ fun () ->
+  let buf = Bstr.create 0x7ff in
+  let test value expected =
+    let pos = ref 0 in
+    Bin.encode_bstr Bin.varint value buf pos;
+    let len = String.length expected in
+    check (!pos == len);
+    check (Bstr.sub_string buf ~off:0 ~len = expected);
+    pos := 0;
+    let value' = Bin.decode_bstr Bin.varint buf pos in
+    check (!pos == len);
+    check (value == value')
+  in
+  test 0 "\000";
+  test 127 "\127";
+  test 128 "\128\001";
+  test 16384 "\128\128\001";
+  test 88080384 "\128\128\128\042"
+
+let ( / ) = Filename.concat
+
+let () =
+  let tests = [ test01; test02 ] in
+  let ({ Test.directory } as runner) = Test.runner (Sys.getcwd () / "_tests") in
+  let run idx test =
+    Format.printf "test%03d: %!" (succ idx);
+    Test.run runner test;
+    Format.printf "ok\n%!"
+  in
+  Format.printf "Run tests into %s\n%!" directory;
+  List.iteri run tests

unikernel/duniverse/bstr/test/dune

@@ -0,0 +1,22 @@
+(library
+ (name test)
+ (modules test)
+ (libraries unix))
+
+(test
+ (name t)
+ (modules t)
+ (package bstr)
+ (libraries bstr test))
+
+(test
+ (name b)
+ (modules b)
+ (package bin)
+ (libraries bin bstr test))
+
+(test
+ (name s)
+ (modules s)
+ (package slice)
+ (libraries slice.bstr test))

unikernel/duniverse/bstr/test/s.ml

@@ -0,0 +1,83 @@
+open Test
+module S = Slice_bstr
+
+let test01 =
+  let descr = {text|String.Sub misc. base functions|text} in
+  Test.test ~title:"misc" ~descr @@ fun () ->
+  let eq sbstr str = String.equal (S.to_string sbstr) str |> check in
+  let err v =
+    match Lazy.force v with
+    | exception Invalid_argument _ -> check true
+    | _ -> check false
+  in
+  eq S.empty "";
+  eq (S.of_string "abc") "abc";
+  eq (S.string "abc" ~off:0 ~len:1) "a";
+  eq (S.string "abc" ~off:1 ~len:1) "b";
+  eq (S.string "abc" ~off:1 ~len:2) "bc";
+  eq (S.string "abc" ~off:2 ~len:1) "c";
+  eq (S.string "abc" ~off:2 ~len:0) "";
+  let v = S.string "abc" ~off:2 ~len:1 in
+  lazy (S.get v 3) |> err;
+  lazy (S.get v 2) |> err;
+  lazy (S.get v 1) |> err;
+  check (S.get v 0 == 'c')
+
+let test02 =
+  let descr = {text|overlap|text} in
+  Test.test ~title:"overlap" ~descr @@ fun () ->
+  let test value expected =
+    match (value, expected) with
+    | None, None -> check true
+    | Some (len, a, b), Some (len', x, y) ->
+        Format.eprintf "len:%d, a:%d, b:%d\n%!" len a b;
+        check (a == x && b == y && len == len')
+    | _ -> check false
+  in
+  let t = S.string (String.make 10 '\000') in
+  let ab = S.sub t ~off:5 ~len:5 in
+  let cd = S.sub t ~off:0 ~len:5 in
+  test (S.overlap ab cd) None;
+  let ab = S.sub t ~off:0 ~len:5 in
+  let cd = S.sub t ~off:5 ~len:5 in
+  test (S.overlap ab cd) None;
+  let ab = S.sub t ~off:0 ~len:6 in
+  let cd = S.sub t ~off:5 ~len:5 in
+  test (S.overlap ab cd) (Some (1, 5, 0));
+  let ab = S.sub t ~off:5 ~len:5 in
+  let cd = S.sub t ~off:0 ~len:6 in
+  test (S.overlap ab cd) (Some (1, 0, 5));
+  let ab = S.sub t ~off:0 ~len:8 in
+  let cd = S.sub t ~off:2 ~len:8 in
+  test (S.overlap ab cd) (Some (6, 2, 0));
+  let ab = S.sub t ~off:0 ~len:10 in
+  let cd = S.sub t ~off:2 ~len:8 in
+  test (S.overlap ab cd) (Some (8, 2, 0));
+  let ab = S.sub t ~off:0 ~len:10 in
+  let cd = S.sub t ~off:2 ~len:6 in
+  test (S.overlap ab cd) (Some (6, 2, 0));
+  let ab = S.sub t ~off:0 ~len:8 in
+  let cd = S.sub t ~off:0 ~len:10 in
+  test (S.overlap ab cd) (Some (8, 0, 0));
+  let ab = S.sub t ~off:2 ~len:6 in
+  let cd = S.sub t ~off:0 ~len:10 in
+  test (S.overlap ab cd) (Some (6, 0, 2));
+  let ab = S.sub t ~off:2 ~len:8 in
+  let cd = S.sub t ~off:0 ~len:10 in
+  test (S.overlap ab cd) (Some (8, 0, 2));
+  let ab = S.sub t ~off:2 ~len:8 in
+  let cd = S.sub t ~off:0 ~len:8 in
+  test (S.overlap ab cd) (Some (6, 0, 2))
+
+let ( / ) = Filename.concat
+
+let () =
+  let tests = [ test01; test02 ] in
+  let ({ Test.directory } as runner) = Test.runner (Sys.getcwd () / "_tests") in
+  let run idx test =
+    Format.printf "test%03d: %!" (succ idx);
+    Test.run runner test;
+    Format.printf "ok\n%!"
+  in
+  Format.printf "Run tests into %s\n%!" directory;
+  List.iteri run tests

unikernel/duniverse/bstr/test/test.ml

@@ -0,0 +1,75 @@
+let strf fmt = Format.asprintf fmt
+let ( / ) = Filename.concat
+
+let check test =
+  let bt = Printexc.get_callstack max_int in
+  try
+    assert test;
+    print_string ".";
+    flush stdout
+  with exn ->
+    print_string "x";
+    flush stdout;
+    Printexc.raise_with_backtrace exn bt
+
+type t = { title: string; descr: string; fn: unit -> unit }
+
+let test ~title ~descr fn = { title; descr; fn }
+
+type runner = { directory: string }
+
+let rec mkdir_p path perm =
+  if path <> "" then begin
+    try Unix.mkdir path perm with
+    | Unix.Unix_error (EEXIST, _, _) when Sys.is_directory path -> ()
+    | Unix.Unix_error (ENOENT, _, _) ->
+        mkdir_p (Filename.dirname path) perm;
+        Unix.mkdir path perm
+  end
+
+let mkdir ({ directory } as runner) = mkdir_p directory 0o755; runner
+
+type ('a, 'b) str = ('a -> 'b, Format.formatter, unit, string) format4
+
+let runner ?(g = Random.State.make_self_init ())
+    ?(fmt : ('a, 'b) str = "run-%s") root =
+  let random_string len =
+    let res = Bytes.create len in
+    for i = 0 to len - 1 do
+      let chr =
+        match Random.State.int g (26 + 26 + 10) with
+        | n when n < 26 -> Char.chr (Char.code 'a' + n)
+        | n when n < 26 + 26 -> Char.chr (Char.code 'A' + n - 26)
+        | n -> Char.chr (Char.code '0' + n - 26 - 26)
+      in
+      Bytes.set res i chr
+    done;
+    Bytes.unsafe_to_string res
+  in
+  let rec go retry =
+    if retry >= 10 then failwith "Impossible to create a test directory";
+    let directory = root / strf fmt (random_string 4) in
+    if Sys.file_exists directory then go (succ retry) else mkdir { directory }
+  in
+  go 0
+
+let run { directory= dir } { title; fn; _ } =
+  let old_stderr = Unix.dup Unix.stderr in
+  let new_stderr = open_out_bin (dir / strf "%s.stderr" title) in
+  Unix.dup2 (Unix.descr_of_out_channel new_stderr) Unix.stderr;
+  let finally () =
+    flush stderr;
+    Unix.dup2 old_stderr Unix.stderr;
+    Unix.close old_stderr;
+    close_out new_stderr
+  in
+  Format.eprintf "*** %s ***\n%!" title;
+  try Fun.protect ~finally fn
+  with exn ->
+    let ic = open_in_bin (dir / strf "%s.stderr" title) in
+    let ln = in_channel_length ic in
+    let rs = Bytes.create ln in
+    really_input ic rs 0 ln;
+    Format.printf "Terminated with: %S\n%!" (Printexc.to_string exn);
+    Format.printf "%s\n%!" (Bytes.unsafe_to_string rs);
+    exit 1

unikernel/duniverse/bstr/test/test.mli

@@ -0,0 +1,8 @@
+type t
+type runner = private { directory: string }
+type ('a, 'b) str = ('a -> 'b, Format.formatter, unit, string) format4
+
+val check : bool -> unit
+val test : title:string -> descr:string -> (unit -> unit) -> t
+val runner : ?g:Random.State.t -> ?fmt:(string, string) str -> string -> runner
+val run : runner -> t -> unit