unikernel/duniverse/ohex/CHANGES.md

@@ -0,0 +1,8 @@
+## v0.2.0 (2024-03-18)
+
+* Rename pp to pp_hexdump
+* Add a pp which just prints the hex with some spaces, but no newlines
+
+## v0.1.0 (2024-03-14)
+
+* Initial release

unikernel/duniverse/ohex/LICENSE.md

@@ -0,0 +1,23 @@
+Copyright (c) 2024, Hannes Mehnert
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+* Redistributions of source code must retain the above copyright notice, this
+  list of conditions and the following disclaimer.
+
+* Redistributions in binary form must reproduce the above copyright notice, this
+  list of conditions and the following disclaimer in the documentation and/or
+  other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

unikernel/duniverse/ohex/README.md

@@ -0,0 +1,10 @@
+## oHEX
+
+This package with minimal dependency cone provides functionality to decode and
+encode strings into hexadecimal representation.
+
+As example, `Ohex.decode "4142" = "AB"`. And `Ohex.encode "AB" = "4142"`.
+
+There's even the property, for all strings s: `Ohex.(decode (encode s)) = s`.
+
+A pretty-printer is provided as well.

unikernel/duniverse/ohex/dune

@@ -0,0 +1,9 @@
+(library
+  (name ohex)
+  (public_name ohex)
+  (modules ohex))
+
+(test
+  (name tests)
+  (modules tests)
+  (libraries alcotest ohex))

unikernel/duniverse/ohex/dune-project

@@ -0,0 +1,3 @@
+(lang dune 2.7)
+(name ohex)
+(formatting disabled)

unikernel/duniverse/ohex/ohex.ml

@@ -0,0 +1,121 @@
+
+let string_fold f acc str =
+  let st = ref acc in
+  String.iter (fun c -> st := f !st c) str;
+  !st
+
+let is_space = function
+  | ' ' | '\n' | '\r' | '\t' -> true
+  | _ -> false
+
+let digit = function
+  | '0'..'9' as c -> int_of_char c - 0x30
+  | 'A'..'F' as c -> int_of_char c - 0x41 + 10
+  | 'a'..'f' as c -> int_of_char c - 0x61 + 10
+  | _ -> invalid_arg "bad character"
+
+let required_length ?(skip_whitespace = true) src =
+  let req =
+    string_fold (fun r c ->
+        if skip_whitespace && is_space c then
+          r
+        else (
+          ignore (digit c);
+          succ r))
+      0 src
+  in
+  if req mod 2 = 0 then
+    req / 2
+  else
+    invalid_arg "leftover byte in hex string"
+
+let decode_into ?(skip_whitespace = true) src tgt ?(off = 0) () =
+  let fold f acc str =
+    let st = ref acc in
+    String.iter (fun c -> st := f !st c) str;
+    !st
+  in
+  let chars, leftover =
+    fold (fun (chars, leftover) c ->
+        if skip_whitespace && is_space c then
+          chars, leftover
+        else
+          let c = digit c in
+          match leftover with
+          | None -> chars, Some (c lsl 4)
+          | Some c' -> (c' lor c) :: chars, None)
+      ([], None) src
+  in
+  let chars = List.rev chars in
+  if leftover <> None then
+    invalid_arg "leftover byte in hex string";
+  List.iteri (fun idx c -> Bytes.set_uint8 tgt (off + idx) c) chars
+
+let decode ?(skip_whitespace = true) src =
+  let len = required_length ~skip_whitespace src in
+  let buf = Bytes.create len in
+  decode_into ~skip_whitespace src buf ();
+  Bytes.unsafe_to_string buf
+
+let hex_map = "0123456789abcdef"
+
+let encode_into src tgt ?(off = 0) () =
+  String.iteri (fun idx c ->
+      let hi, lo =
+        let i = int_of_char c in
+        hex_map.[i lsr 4], hex_map.[i land 0x0F]
+      in
+      Bytes.set tgt (idx * 2 + off) hi;
+      Bytes.set tgt (idx * 2 + off + 1) lo)
+    src
+
+let encode src =
+  let buf = Bytes.create (String.length src * 2) in
+  encode_into src buf ();
+  Bytes.unsafe_to_string buf
+
+let printable_ascii c =
+  let i = int_of_char c in
+  not (i < 0x20 || i >= 0x7f)
+
+let pp ppf s =
+  String.iteri (fun idx c ->
+      Format.fprintf ppf "%02x" (int_of_char c);
+      if idx mod 2 = 1 then
+        Format.pp_print_string ppf " ";
+      if idx mod 8 = 7 then
+        Format.pp_print_string ppf " ")
+    s
+
+let pp_hexdump ?(row_numbers = true) ?(chars = true) () ppf s =
+  String.iteri (fun idx c ->
+      if idx mod 16 = 0 && row_numbers then
+        Format.fprintf ppf "%06x  " idx;
+      Format.fprintf ppf "%02x" (int_of_char c);
+      if idx mod 2 = 1 then
+        Format.pp_print_string ppf " ";
+      if idx mod 8 = 7 then
+        Format.pp_print_string ppf " ";
+      if idx mod 16 = 15 && chars then
+        String.iter (fun c ->
+            Format.pp_print_char ppf (if printable_ascii c then c else '.'))
+          (String.sub s (idx - 15) 16);
+      if idx mod 16 = 15 then
+        Format.pp_print_string ppf "\n")
+    s;
+  (if chars then
+     let last_n, pad =
+       let l = String.length s in
+       let pad = 16 - (l mod 16) in
+       let pad = if pad = 16 then 0 else pad in
+       String.sub s (l - (l mod 16)) (l mod 16),
+       pad
+     in
+     if pad > 0 then
+       let pad_chars = pad * 2 + (pad + 1) / 2 + (if pad > 8 then 1 else 0) + 1 in
+       Format.pp_print_string ppf (String.make pad_chars ' ');
+       String.iter (fun c ->
+           Format.pp_print_char ppf (if printable_ascii c then c else '.'))
+         last_n);
+  if String.length s mod 16 <> 0 then
+    Format.pp_print_string ppf "\n"

unikernel/duniverse/ohex/ohex.mli

@@ -0,0 +1,54 @@
+(** Convert from and to hexadecimal representation. *)
+
+val required_length : ?skip_whitespace:bool -> string -> int
+(** [required_length ~skip_whitespace s] returns the length needed when the
+    hex string [s] would be decoded into a sequence of octets. The argument
+    [skip_whitespace] defaults to [true], and skips any whitespace characters
+    (' ', '\n', '\r', '\t'). This function is useful for estimating the space
+    required for [decode_into].
+
+    @raise Invalid_argument if any character in [s] is not a hex character, or
+    an odd amount of characters are present. *)
+
+val decode : ?skip_whitespace:bool -> string -> string
+(** [decode ~skip_whitespace s] decodes a hex string [s] into a sequence of
+    octets. The argument [skip_whitespace] defaults to [true], and skips any
+    whitespace characters in [s] (' ', '\n', '\r', '\t'). An example:
+    [decode "4142" = "AB"].
+
+    @raise Invalid_argument if any character in [s] is not a hex character, or
+    an odd amount of characters are present. *)
+
+val decode_into : ?skip_whitespace:bool -> string -> bytes -> ?off:int -> unit
+  -> unit
+(** [decode_into ~skip_whitespace s dst ~off ()] decodes [s] into [dst]
+    starting at [off] (defaults to 0). The argument [skip_whitespace] defaults
+    to [true] and skips any whitespace characters.
+
+    @raise Invalid_argument if any character in [s] is not a hex character, an
+    odd amount of characters are present, or [dst] does not contain enough
+    space. *)
+
+val encode : string -> string
+(** [encode s] encodes [s] into a freshly allocated string of double size, where
+    each character in [s] is encoded as two hex digits in the returned string.
+    An example: [encode "AB" = "4142"].
+*)
+
+val encode_into : string -> bytes -> ?off:int -> unit -> unit
+(** [encode_into s dst ~off ()] encodes [s] into [dst] starting at [off]
+    (defaults to 0). Each character is encoded as two hex digits in [dst].
+
+    @raise Invalid_argument if [dst] does not contain enough space. *)
+
+val pp : Format.formatter -> string -> unit
+(** [pp ppf s] pretty-prints the string [s] in hexadecimal. Some spaces are
+    emitted for easier readability. No newline is emitted. *)
+
+val pp_hexdump : ?row_numbers:bool -> ?chars:bool -> unit ->
+  Format.formatter -> string -> unit
+(** [pp_hexdump ~row_numbers ~chars () ppf s] pretty-prints the string [s] in
+    hexadecimal (similar to [hexdump -C]). If [row_numbers] is provided
+    (defaults to [true]), each output line is prefixed with the row number.
+    If [chars] is provided (defaults to [true]), in the last column the ASCII
+    string is printed (non-printable characters are printed as '.'). *)

unikernel/duniverse/ohex/ohex.opam

@@ -0,0 +1,22 @@
+opam-version: "2.0"
+maintainer: "Hannes Mehnert <hannes@mehnert.org>"
+authors: "Hannes Mehnert <hannes@mehnert.org>"
+license: "BSD-2-Clause"
+homepage: "https://git.robur.coop/robur/ohex"
+doc: "https://robur-coop.github.io/ohex/doc"
+bug-reports: "https://git.robur.coop/robur/ohex/issues"
+depends: [
+  "ocaml" {>= "4.08.0"}
+  "dune" {>= "2.7"}
+  "alcotest" {with-test}
+]
+build: [
+  ["dune" "subst"] {dev}
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
+]
+dev-repo: "git+https://git.robur.coop/robur/ohex.git"
+synopsis: "Hexadecimal encoding and decoding"
+description: """
+A library to encode and decode hexadecimal byte sequences.
+"""

unikernel/duniverse/ohex/tests.ml

@@ -0,0 +1,102 @@
+
+let tests = [
+  "", 0, "";
+  "41", 1, "A";
+  "41 41", 2, "AA";
+  " 41 41 ", 2, "AA";
+  "   414  1", 2, "AA";
+]
+
+let len_dec_tests =
+  List.mapi (fun i (s, len, v) ->
+      string_of_int i ^ " is correct", `Quick,
+      (fun () ->
+         Alcotest.(check int "required length" len (Ohex.required_length s));
+         Alcotest.(check string "decode works fine" v (Ohex.decode s))))
+    tests
+
+let bad_char_input = [ "W" ; "AAWW" ; "WWAA" ]
+
+let leftover_input = [ "AAA" ; "A" ]
+
+let bad_input_ws = [ " "; " AA" ; "AA " ; "A A" ]
+
+let bad_len_dec_tests =
+  (List.mapi (fun i s ->
+       string_of_int i ^ " fails (bad character)", `Quick,
+       (fun () ->
+          Alcotest.(check_raises "required length raises"
+                      (Invalid_argument "bad character")
+                      (fun () -> ignore (Ohex.required_length s)));
+          Alcotest.(check_raises "decode raises"
+                      (Invalid_argument "bad character")
+                      (fun () -> ignore (Ohex.decode s)))))
+      bad_char_input) @
+  (List.mapi (fun i s ->
+       string_of_int i ^ " fails (leftover)", `Quick,
+       (fun () ->
+          Alcotest.(check_raises "required length raises"
+                      (Invalid_argument "leftover byte in hex string")
+                      (fun () -> ignore (Ohex.required_length ~skip_whitespace:false s)));
+          Alcotest.(check_raises "decode raises"
+                      (Invalid_argument "leftover byte in hex string")
+                      (fun () -> ignore (Ohex.decode ~skip_whitespace:false s)))))
+      leftover_input) @
+  (List.mapi (fun i s ->
+       string_of_int i ^ " fails (skip_whitespace = false)", `Quick,
+       (fun () ->
+          Alcotest.(check_raises "required length raises"
+                      (Invalid_argument "bad character")
+                      (fun () -> ignore (Ohex.required_length ~skip_whitespace:false s)));
+          Alcotest.(check_raises "decode raises"
+                      (Invalid_argument "bad character")
+                      (fun () -> ignore (Ohex.decode ~skip_whitespace:false s)))))
+      bad_input_ws)
+
+let enc_tests = [
+  "A", "41", 2;
+  "AA", "4141", 4;
+  "AAA", "414141", 6;
+]
+
+let enc_tests =
+  List.mapi (fun i (v, hex, l) ->
+      string_of_int i ^ " is correct", `Quick,
+      (fun () ->
+         Alcotest.(check string "encode works" hex (Ohex.encode v));
+         let buf = Bytes.create l in
+         Ohex.encode_into v buf ~off:0 ();
+         Alcotest.(check string "encode_into works" hex (Bytes.unsafe_to_string buf))))
+    enc_tests
+
+let dec_enc () =
+  let random_string () =
+    let size = Random.int 128 in
+    let buf = Bytes.create size in
+    for i = 0 to size - 1 do
+      Bytes.set_uint8 buf i (Random.int 256)
+    done;
+    Bytes.unsafe_to_string buf
+  in
+  for i = 0 to 10_000 do
+    let input = random_string () in
+    Alcotest.(check string ("dec (enc s) = s " ^ string_of_int i)
+                input Ohex.(decode (encode input)));
+    Alcotest.(check string ("dec ~skip_ws:false (enc s) = s " ^ string_of_int i)
+                input Ohex.(decode ~skip_whitespace:false (encode input)));
+    let buf = Bytes.create (String.length input * 2) in
+    Ohex.encode_into input buf ~off:0 ();
+    let out = Bytes.create (String.length input) in
+    Ohex.decode_into (Bytes.unsafe_to_string buf) out ~off:0 ();
+    Alcotest.(check string ("dec_into (enc_into s) = s " ^ string_of_int i)
+                input (Bytes.unsafe_to_string out))
+  done
+
+let suites = [
+  "length and decode pass", len_dec_tests ;
+  "bad input", bad_len_dec_tests ;
+  "encode tests", enc_tests ;
+  "decode encode", [ "decode (encode s) = s", `Quick, dec_enc ];
+]
+
+let () = Alcotest.run "hex tests" suites