sid: optionally handle big endian in packet format codec

Oddly enough this only has an effect on the sub_auths since the 48 bits
of “identifier authority” are always handled in big endian.

3 files changed, 97 insertions, 37 deletions

diff --git a/sid.ml b/sid.ml
index 9f1e591..ddfb8e1 100644
--- a/sid.ml
+++ b/sid.ml
@@ -80,10 +80,9 @@ module StringFmt = struct
   let decode s =
     let n = String.length s in
     if n <= 4 then
-      raise
-        (Invalid_argument
-          (Printf.sprintf
-             "Invalid SID: ‘%s’ too short to be a SID in string format" s))
+      Error
+        (Printf.sprintf
+           "Invalid SID: ‘%s’ too short to be a SID in string format" s)
     else
     expect_char s 'S' 0;
     expect_char s '-' 1;
@@ -98,15 +97,9 @@ module StringFmt = struct
       sa := d :: !sa;
       p' := np
     done;
-    { sid_ident_auth = ia
-    ; sid_sub_auths  = Array.of_list (List.rev !sa)
-    }
-
-  let from_string_res s =
-    try Ok (decode s) with Invalid_argument msg -> Error msg
-
-  let from_string_opt s =
-    try Some (decode s) with Invalid_argument _ -> None
+    Ok { sid_ident_auth = ia
+       ; sid_sub_auths  = Array.of_list (List.rev !sa)
+       }
 
   let fmt_ident_auth b ia =
     Buffer.add_string b (U64.to_string ia)
@@ -129,17 +122,24 @@ end (* [module StringFmt] *)
 
 module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
 
-  (* XXX configurable endianness *)
+  type endian = Big | Little
 
-  let encode s =
+  let wordlen        = 4 (* sizeof int *)
+  let min_pktrep_len = 1 + 1 + sizeof_ident_auth
+  let max_pktrep_len = 1 + 1
+                     + sizeof_ident_auth
+                     + max_subauth_count * sizeof_sub_auth
+  let pktrep_sa_off  = min_pktrep_len
+
+  let encode ?(endian=Little) s =
     let nsa = Array.length s.sid_sub_auths in
     let l = 8 + nsa * sizeof_sub_auth in
-    let b = Buffer.create l in
+    let b = Bytes.create l in
+    let o = ref 0 in
+    let pushbyte c = char_of_int c |> Bytes.set b !o; incr o in
 
     assert (0 <= nsa && nsa <= 15);
 
-    let pushbyte c = char_of_int c |> Buffer.add_char b in
-
     pushbyte 1;
     pushbyte nsa;
 
@@ -148,20 +148,19 @@ module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
     in (* big endian!, cf. [MS-DTYP] 2.4.1.1 *)
     getia 5; getia 4; getia 3; getia 2; getia 1; getia 0;
 
-    let getsa sa n = pushbyte (U32.to_int (U32.shift_right sa n) land 0xff) in
-    Array.iter
-      (fun sa -> getsa sa 0; getsa sa 1; getsa sa 2; getsa sa 3)
+    let write_u32 =
+      match endian with
+        | Big    -> U32.to_bytes_big_endian
+        | Little -> U32.to_bytes_little_endian
+    in
+    Array.iteri
+      (fun i sa ->
+         let o' = !o + i * wordlen in
+         write_u32 sa b o')
       s.sid_sub_auths;
-    Bytes.unsafe_of_string (Buffer.contents b)
+    b
 
-  let wordlen        = 4 (* sizeof int *)
-  let min_pktrep_len = 1 + 1 + sizeof_ident_auth
-  let max_pktrep_len = 1 + 1
-                     + sizeof_ident_auth
-                     + max_subauth_count * sizeof_sub_auth
-  let pktrep_sa_off  = min_pktrep_len
-
-  let decode b =
+  let decode ?(endian=Little) b =
     let l = Bytes.length b in
     if l < min_pktrep_len || max_pktrep_len < l then
       Error (Printf.sprintf
@@ -188,10 +187,15 @@ module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
     let ia = U64.zero
              |> getbyte 2 |> getbyte 3 |> getbyte 4
              |> getbyte 5 |> getbyte 6 |> getbyte 7 in
-    let sas = Array.make nsa (U32.zero) in
+    let sas = Array.make nsa (U32.zero)
+    and read_u32 =
+      match endian with
+        | Big    -> U32.of_bytes_big_endian
+        | Little -> U32.of_bytes_little_endian
+    in
     for i = 0 to (nsa - 1) do
       let off = pktrep_sa_off + i * sizeof_sub_auth in
-      sas.(i) <- U32.of_bytes_little_endian b off
+      sas.(i) <- read_u32 b off
     done;
     Ok { sid_ident_auth = ia
        ; sid_sub_auths  = sas
diff --git a/sid.mli b/sid.mli
index 7c0451c..12d31a9 100644
--- a/sid.mli
+++ b/sid.mli
@@ -9,16 +9,15 @@ val get_sub_auths : t -> sub_auths
 
 module StringFmt :
   sig
-    val decode : string -> t
-    val from_string_res : string -> (t, string) result
-    val from_string_opt : string -> t option
+    val decode : string -> (t, string result)
     val encode : t -> string
   end
 
 module PacketRep :
   sig
-    val encode : t -> bytes
-    val decode : bytes -> (t, string) result
+    type endian = Big | Little
+    val encode : ?endian:endian -> t -> bytes
+    val decode : ?endian:endian -> bytes -> (t, string) result
   end
 
 module WellKnown :
diff --git a/sid_test.ml b/sid_test.ml
index aaee961..5f9f0b2 100644
--- a/sid_test.ml
+++ b/sid_test.ml
@@ -95,6 +95,25 @@ let pr_encode_null_ok () =
     ~msg:(Printf.sprintf "[%s] ≠ [%s]" x expect)
     x expect
 
+let pr_encode_be_ok () =
+  let sid = "S-1-0-42" in
+  let sle = Sid.of_string sid
+    |> Sid.PacketRep.encode
+    |> Xxd.xxd_of_bytes ~blocklen:2
+  and sbe = Sid.of_string sid
+    |> Sid.PacketRep.encode ~endian:Big
+    |> Xxd.xxd_of_bytes ~blocklen:2
+  in
+  let expect_le = "0101 0000 0000 0000 2a00 0000"
+  and expect_be = "0101 0000 0000 0000 0000 002a" in
+  (*               vvcc iiii iiii iiii ssss ssss *)
+  assert_equal
+    ~msg:(Printf.sprintf "[%s] ≠ [%s]" sle expect_le)
+    sle expect_le;
+  assert_equal
+    ~msg:(Printf.sprintf "[%s] ≠ [%s]" sbe expect_be)
+    sbe expect_be
+
 let pr_encode_all_ok () =
   let x =
     Sid.WellKnown.everyone
@@ -125,6 +144,42 @@ let pr_decode_all_ok () =
        (Sid.to_string s) (Sid.to_string w))
     (Sid.equal s w)
 
+let pr_decode_be_ok () =
+  let sid = Sid.of_string "S-1-1-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15"
+  and sle =
+    match Xxd.bytes_of_xxd
+            "010f 0000 0000 0001 \
+             0100 0000 0200 0000 0300 0000 0400 0000 \
+             0500 0000 0600 0000 0700 0000 0800 0000 \
+             0900 0000 0a00 0000 0b00 0000 0c00 0000 \
+             0d00 0000 0e00 0000 0f00 0000"
+      |> Sid.PacketRep.decode
+    with
+      | Ok s -> s
+      | Error e ->
+        assert_failure
+          (Printf.sprintf "error decoding SID: %s" e)
+  and sbe =
+    match Xxd.bytes_of_xxd
+            "010f 0000 0000 0001 \
+             0000 0001 0000 0002 0000 0003 0000 0004 \
+             0000 0005 0000 0006 0000 0007 0000 0008 \
+             0000 0009 0000 000a 0000 000b 0000 000c \
+             0000 000d 0000 000e 0000 000f"
+      |> Sid.PacketRep.decode ~endian:Big
+    with
+      | Ok s -> s
+      | Error e ->
+        assert_failure
+          (Printf.sprintf "error decoding SID: %s" e)
+  in
+  assert_bool
+    (Printf.sprintf "le: [%s] ≠ [%s]" (Sid.to_string sid) (Sid.to_string sle))
+    (Sid.equal sid sle);
+  assert_bool
+    (Printf.sprintf "be: [%s] ≠ [%s]" (Sid.to_string sid) (Sid.to_string sbe))
+    (Sid.equal sid sbe)
+
 let pr_decode_version_fail () =
   let b = Xxd.bytes_of_xxd "0201 0000 0000 0001 0000 0000" in
   (*                        vvcc iiii iiii iiii ssss ssss *)
@@ -222,7 +277,9 @@ let string_format_test = "string-format-syntax" >:::
 let packet_rep_test = "packet-rep" >:::
   [ "encode-null-ok"        >:: pr_encode_null_ok
   ; "encode-all-ok"         >:: pr_encode_all_ok
+  ; "encode-be-ok"          >:: pr_encode_be_ok
   ; "decode-all-ok"         >:: pr_decode_all_ok
+  ; "decode-be-ok"          >:: pr_decode_be_ok
   ; "decode-version-fail"   >:: pr_decode_version_fail
   ; "decode-sacount-fail"   >:: pr_decode_sacount_fail
   ; "decode-short-fail"     >:: pr_decode_short_fail