xxd: add binary-text conversion helper

3 files changed, 112 insertions, 19 deletions

diff --git a/sid.ml b/sid.ml
index bd8f9fb..f3fb77d 100644
--- a/sid.ml
+++ b/sid.ml
@@ -21,6 +21,9 @@ let create ?(sa=[||]) ia =
   if Array.length sa > max_subauth_count then None else
   Some (create_unsafe sa ia)
 
+let get_ident_auth s = s.sid_ident_auth
+let get_sub_auths s = s.sid_sub_auths
+
 exception Nope
 
 let equal_sub_auths saa sab =
@@ -36,25 +39,6 @@ let equal a b =
   && Array.length a.sid_sub_auths = Array.length b.sid_sub_auths
   && equal_sub_auths a.sid_sub_auths b.sid_sub_auths
 
-module type Xtract = sig
-  type t
-  val nth_byte : t -> int -> int
-end
-
-module MkExtract (INTTYPE : Stdint.Int) = struct
-  type t = INTTYPE.t
-
-  let ilsr  = INTTYPE.shift_left
-  let iland = INTTYPE.logand
-  let ixff  = INTTYPE.of_string "255"
-
-  let nth_byte n i =
-    (ilsr n i) |> iland ixff |> INTTYPE.to_int
-end
-
-module U32Extract = MkExtract (U32)
-module U64Extract = MkExtract (U64)
-
 module StringFmt = struct
 
   let expect_char s c p =
diff --git a/sid.mli b/sid.mli
index d387aa0..9a7e8b0 100644
--- a/sid.mli
+++ b/sid.mli
@@ -5,6 +5,8 @@ val create_unsafe : Stdint.Uint32.t array -> Stdint.Uint64.t -> t
 val create : ?sa:Stdint.Uint32.t array -> Stdint.Uint64.t -> t
 val equal_sub_auths : Stdint.Uint32.t array -> Stdint.Uint32.t array -> bool
 val equal : t -> t -> bool
+val get_ident_auth : t -> Stdint.Uint64.t
+val get_sub_auths : t -> sub_auths
 
 module StringFmt :
   sig
diff --git a/xxd.ml b/xxd.ml
new file mode 100644
index 0000000..7d3ab16
--- /dev/null
+++ b/xxd.ml
@@ -0,0 +1,107 @@
+let (!!) = Bytes.unsafe_of_string
+let (??) = Bytes.unsafe_to_string
+
+module U64 = Stdint.Uint64
+module U32 = Stdint.Uint32
+
+module type Xtract = sig
+  type t
+  val nth_byte : t -> int -> int
+end
+
+module MkExtract (INTTYPE : Stdint.Int) = struct
+  type t = INTTYPE.t
+
+  let ilsr  = INTTYPE.shift_left
+  let iland = INTTYPE.logand
+  let ixff  = INTTYPE.of_string "255"
+
+  let nth_byte n i =
+    (ilsr n i) |> iland ixff |> INTTYPE.to_int
+end
+
+module U32Extract = MkExtract (U32)
+module U64Extract = MkExtract (U64)
+
+let string_of_sid s =
+  let b = Buffer.create 16 in
+  let pushbuf = Buffer.add_string b in
+  let ia_nth = U64Extract.nth_byte (Sid.get_ident_auth s) in
+  pushbuf
+    (Printf.sprintf "01%0.2x %0.2x%0.2x %0.2x%0.2x %0.2x%0.2x"
+       (Array.length (Sid.get_sub_auths s))
+       (ia_nth 0) (ia_nth 1) (ia_nth 2) (ia_nth 3) (ia_nth 4) (ia_nth 5));
+  Array.iter
+    (fun sa ->
+       let sa_nth = U32Extract.nth_byte sa in
+       pushbuf
+         (Printf.sprintf "%0.2x%0.2x %0.2x%0.2x"
+            (sa_nth 0) (sa_nth 1) (sa_nth 2) (sa_nth 3)))
+    (Sid.get_sub_auths s);
+  Buffer.contents b
+
+let xdigit_table =
+  let t = Array.make 256 !!"\x00\x00" in
+  let xd n = Printf.sprintf "%0.2x" (n land 0xff) |> (!!) in
+  for i = 0 to 255 do t.(i) <- xd i done;
+  t
+
+let xdigit n = xdigit_table.(n land 0xff)
+
+let nope _ = false
+let every n i = i > 0 && i mod n = 0
+
+(* result length can be calculated in advance so we can do
+   this without realloc() *)
+let xxd_of_bytes ?(blocklen=0) src =
+  let ls = Bytes.length src in
+  if ls = 0 then "" else
+  let ld = 2 * ls + if blocklen = 0 then 0 else (ls - 1) / blocklen in
+  let dst = Bytes.create ld in
+  let spacep = if blocklen = 0 then nope else every blocklen in
+  let rec aux is id =
+    if is = ls then ??dst else
+    let id' =
+      if not (spacep is) then id
+      else (Bytes.set dst id ' '; id + 1)
+    in
+    assert (id' < ld - 1);
+    Bytes.blit (Bytes.get src is |> int_of_char |> xdigit) 0 dst id' 2;
+    aux (is+1) (id'+2)
+  in
+  aux 0 0
+
+let bufsiz = 4096
+
+let base_decimal = int_of_char '0'
+let base_lower   = int_of_char 'a' - 10
+let base_upper   = int_of_char 'A' - 10
+
+let int_of_nibble c =
+  if '0' <= c && c <= '9' then Some (int_of_char c - base_decimal) else
+  if 'a' <= c && c <= 'f' then Some (int_of_char c - base_lower  ) else
+  if 'A' <= c && c <= 'F' then Some (int_of_char c - base_upper  ) else
+  None
+
+let bytes_of_xxd src =
+  let ls = String.length src in
+  if ls = 0 then Bytes.empty else
+  let buf = Buffer.create bufsiz in
+  let rec aux hi is =
+    if is = ls then
+      if hi = None then (Buffer.contents buf |> (!!)) else
+      raise (Invalid_argument
+               "bytes_of_xxd: odd number of hex digits in input")
+    else
+      match String.get src is |> int_of_nibble with
+        | None -> aux hi (is+1)
+        | Some c -> begin
+            match hi with
+              | None -> aux (Some (c lsl 4)) (is+1)
+              | Some hi ->
+                Buffer.add_char buf (hi lor c |> char_of_int);
+                aux None (is+1)
+          end
+  in
+  aux None 0
+