From 04be611be6ab6bcfa7617365ab824ca2b1dc2f9b Mon Sep 17 00:00:00 2001
From: Philipp Gesang <phg@phi-gamma.net>
Date: Thu, 25 Oct 2018 01:10:17 +0200
Subject: =?UTF-8?q?sid:=20implement=20decoder=20for=20=E2=80=9Cpacket=20re?=
 =?UTF-8?q?presentation=E2=80=9D?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 sid.ml | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 50 insertions(+), 5 deletions(-)

(limited to 'sid.ml')

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
-- 
cgit v1.2.3