sid: implement decoder for “packet representation”

3 files changed, 164 insertions, 10 deletions

diff --git a/sid.ml b/sid.ml
index f3fb77d..9f1e591 100644
--- a/sid.ml
+++ b/sid.ml
@@ -7,9 +7,9 @@ type sid =
   }
 and sub_auths = U32.t array
 
-let sub_auth_max = 15
-
-let sizeof_sub_auth = 4
+let sizeof_ident_auth = 6
+let sizeof_sub_auth   = 4
+let max_subauth_count = 15
 
 let create_unsafe sa ia =
   { sid_ident_auth = ia
@@ -71,7 +71,7 @@ module StringFmt = struct
 
   let read_decimal_u64 = read_decimal_string U64.of_string
   let read_decimal_u32 = read_decimal_string U32.of_string
-   
+
   (*
    * The spec ([MS-DTYP]):
    *
@@ -92,7 +92,7 @@ module StringFmt = struct
     let p = 4 in
     let p, ia = read_decimal_u64 s p in
     let sa = ref [] and p' = ref p in
-    while !p' < n && List.length !sa < sub_auth_max do
+    while !p' < n && List.length !sa < max_subauth_count do
       expect_char s '-' !p';
       let np, d = read_decimal_u32 s (!p' + 1) in
       sa := d :: !sa;
@@ -129,6 +129,8 @@ end (* [module StringFmt] *)
 
 module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
 
+  (* XXX configurable endianness *)
+
   let encode s =
     let nsa = Array.length s.sid_sub_auths in
     let l = 8 + nsa * sizeof_sub_auth in
@@ -152,6 +154,49 @@ module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
       s.sid_sub_auths;
     Bytes.unsafe_of_string (Buffer.contents 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 l = Bytes.length b in
+    if l < min_pktrep_len || max_pktrep_len < l then
+      Error (Printf.sprintf
+               "bad input size: expected %d–%d B, got %d B"
+               min_pktrep_len max_pktrep_len l) else
+    if l mod wordlen <> 0 then
+      Error (Printf.sprintf
+               "bad input size: not divisible by word length (%d)"
+               wordlen) else
+    let v = Bytes.get b 0 |> int_of_char in
+    if v <> 0x01 then
+      Error (Printf.sprintf
+               "input malformed: expected SID version=0x01, got 0x%0.2x" v) else
+    let nsa = Bytes.get b 1 |> int_of_char in
+    if max_subauth_count < nsa then
+      Error (Printf.sprintf
+               "input malformed: up to %d subAuthority elements permitted, \
+                %d specified"
+               max_subauth_count nsa) else
+    let getbyte n ia = (* b[n] << (5 - (n - 2)) *)
+      U64.logor ia
+          (U64.shift_left (Bytes.get b n |> int_of_char |> U64.of_int) (5 - (n - 2)))
+    in
+    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
+    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
+    done;
+    Ok { sid_ident_auth = ia
+       ; sid_sub_auths  = sas
+       }
+
 end (* [module PacketRep] *)
 
 module WellKnown = struct
diff --git a/sid.mli b/sid.mli
index 9a7e8b0..7c0451c 100644
--- a/sid.mli
+++ b/sid.mli
@@ -1,6 +1,5 @@
 type t
 type sub_auths = Stdint.Uint32.t array
-val sub_auth_max : int
 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
@@ -19,6 +18,7 @@ module StringFmt :
 module PacketRep :
   sig
     val encode : t -> bytes
+    val decode : bytes -> (t, string) result
   end
 
 module WellKnown :
diff --git a/sid_test.ml b/sid_test.ml
index 137575e..aaee961 100644
--- a/sid_test.ml
+++ b/sid_test.ml
@@ -1,5 +1,9 @@
 open OUnit
 
+(*
+let () = Printexc.record_backtrace true ;;
+ *)
+
 (* S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14 *)
 let max_sid = Stdint.(
       Sid.create_unsafe
@@ -82,7 +86,7 @@ let sf_parse_too_long_ok () =
 let pr_encode_null_ok () =
   let x =
     Sid.WellKnown.null
-    |> Sid.PacketRep.encode 
+    |> Sid.PacketRep.encode
     |> Xxd.xxd_of_bytes ~blocklen:2
   in
   let expect = "0101 0000 0000 0000 0000 0000" in
@@ -94,7 +98,7 @@ let pr_encode_null_ok () =
 let pr_encode_all_ok () =
   let x =
     Sid.WellKnown.everyone
-    |> Sid.PacketRep.encode 
+    |> Sid.PacketRep.encode
     |> Xxd.xxd_of_bytes ~blocklen:2
   in
   let expect = "0101 0000 0000 0001 0000 0000" in
@@ -103,6 +107,105 @@ let pr_encode_all_ok () =
     ~msg:(Printf.sprintf "[%s] ≠ [%s]" x expect)
     x expect
 
+let pr_decode_all_ok () =
+  let s =
+    match
+      Xxd.bytes_of_xxd "0101 0000 0000 0001 0000 0000"
+      (*                vvcc iiii iiii iiii ssss ssss *)
+      |> Sid.PacketRep.decode
+    with
+      | Ok s -> s
+      | Error e ->
+        assert_failure
+          (Printf.sprintf "error decoding SID: %s" e)
+  in
+  let w = Sid.WellKnown.world in
+  assert_bool
+    (Printf.sprintf "[%s] ≠ [%s]"
+       (Sid.to_string s) (Sid.to_string w))
+    (Sid.equal s w)
+
+let pr_decode_version_fail () =
+  let b = Xxd.bytes_of_xxd "0201 0000 0000 0001 0000 0000" in
+  (*                        vvcc iiii iiii iiii ssss ssss *)
+  match Sid.PacketRep.decode b with
+    | Error e ->
+      let expect = "input malformed: expected SID version=0x01, got 0x02" in
+      assert_equal
+        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
+        e expect
+    | Ok s ->
+      assert_failure
+        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
+           (Sid.to_string s))
+
+let pr_decode_sacount_fail () =
+  let b = Xxd.bytes_of_xxd "0110 0000 0000 0001 0000 0000" in
+  (*                        vvcc iiii iiii iiii ssss ssss *)
+  match Sid.PacketRep.decode b with
+    | Error e ->
+      let expect = "input malformed: up to 15 subAuthority elements \
+                    permitted, 16 specified" in
+      assert_equal
+        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
+        e expect
+    | Ok s ->
+      assert_failure
+        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
+           (Sid.to_string s))
+
+let pr_decode_short_fail () =
+  let b = Xxd.bytes_of_xxd "0105 0000 0000 00" in
+  (*                        vvcc iiii iiii ii…… *)
+  match Sid.PacketRep.decode b with
+    | Error e ->
+      let expect = "bad input size: expected 8–68 B, got 7 B" in
+      assert_equal
+        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
+        e expect
+    | Ok s ->
+      assert_failure
+        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
+           (Sid.to_string s))
+
+let pr_decode_long_fail () =
+  let r =
+    "010e 0000 0000 0000 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 1000 0000"
+  in
+  let b = Xxd.bytes_of_xxd r in
+  match Sid.PacketRep.decode b with
+    | Error e ->
+      let expect = "bad input size: expected 8–68 B, got 72 B" in
+      assert_equal
+        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
+        e expect
+    | Ok s ->
+      assert_failure
+        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
+           (Sid.to_string s))
+
+let pr_decode_odd_fail () =
+  match
+    Xxd.bytes_of_xxd "0101 0000 0000 0000 0100 0000 0200"
+    (*                vvcc iiii iiii iiii ssss ssss ssss …
+                      upper half word missing *)
+    |> Sid.PacketRep.decode
+  with
+    | Error e ->
+      let expect = "bad input size: not divisible by word length (4)" in
+      assert_equal
+        ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect)
+        e expect
+    | Ok s ->
+      assert_failure
+        (Printf.sprintf "malformed SID decoded unexpectedly: %s"
+           (Sid.to_string s))
+
+
 let string_format_test = "string-format-syntax" >:::
   [ "parse-ok"              >:: sf_parse_ok
   ; "parse-empty-fail"      >:: sf_parse_empty_fail
@@ -117,8 +220,14 @@ 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-null-ok"        >:: pr_encode_null_ok
+  ; "encode-all-ok"         >:: pr_encode_all_ok
+  ; "decode-all-ok"         >:: pr_decode_all_ok
+  ; "decode-version-fail"   >:: pr_decode_version_fail
+  ; "decode-sacount-fail"   >:: pr_decode_sacount_fail
+  ; "decode-short-fail"     >:: pr_decode_short_fail
+  ; "decode-long-fail"      >:: pr_decode_long_fail
+  ; "decode-odd-fail"       >:: pr_decode_odd_fail
   ]
 
 let () =