sid: sid_test: add current state to repo

2 files changed, 294 insertions, 0 deletions

diff --git a/sid.ml b/sid.ml
new file mode 100644
index 0000000..bd8f9fb
--- /dev/null
+++ b/sid.ml
@@ -0,0 +1,199 @@
+module U64 = Stdint.Uint64
+module U32 = Stdint.Uint32
+
+type sid =
+  { sid_ident_auth : U64.t (* 6 B *)
+  ; sid_sub_auths  : U32.t array (* max. 15 × *)
+  }
+and sub_auths = U32.t array
+
+let sub_auth_max = 15
+
+let sizeof_sub_auth = 4
+
+let create_unsafe sa ia =
+  { sid_ident_auth = ia
+  ; sid_sub_auths  = sa }
+
+(* There isn’t much to validate to begin with except for the hard cap on
+   the number of subauths. *)
+let create ?(sa=[||]) ia =
+  if Array.length sa > max_subauth_count then None else
+  Some (create_unsafe sa ia)
+
+exception Nope
+
+let equal_sub_auths saa sab =
+  try
+    Array.iter2
+      (fun saa sab -> if U32.compare saa sab <> 0 then raise Nope)
+      saa sab;
+    true
+  with Nope -> false
+
+let equal a b =
+  U64.compare a.sid_ident_auth b.sid_ident_auth = 0
+  && 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 =
+    if s.[p] = c then () else
+    raise
+      (Invalid_argument
+         (Printf.sprintf
+            "Invalid SID [%s]: expected ‘%c’ at position %d, found ‘%c’"
+            s c p s.[p]))
+
+  let is_digit c = '0' <= c && c <= '9'
+
+  let read_decimal_string f s p =
+    let n = String.length s in
+    assert (p < n);
+    let p' = ref p in
+    let b = Buffer.create 16 in
+    while !p' < n && is_digit s.[!p'] do
+      Buffer.add_char b s.[!p'];
+      incr p'
+    done;
+    let nb = Buffer.length b in
+    if nb = 0 then
+      raise (Invalid_argument
+               (Printf.sprintf
+                  "Invalid SID [%s]: expected decimal at position %d" s p))
+    else
+      p + nb,
+      f (Buffer.contents b)
+
+  let read_decimal_u64 = read_decimal_string U64.of_string
+  let read_decimal_u32 = read_decimal_string U32.of_string
+   
+  (*
+   * The spec ([MS-DTYP]):
+   *
+   *    2.4.2.1: SID= "S-1-" IdentifierAuthority 1*SubAuthority
+   *)
+  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))
+    else
+    expect_char s 'S' 0;
+    expect_char s '-' 1;
+    expect_char s '1' 2;
+    expect_char s '-' 3;
+    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
+      expect_char s '-' !p';
+      let np, d = read_decimal_u32 s (!p' + 1) in
+      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
+
+  let fmt_ident_auth b ia =
+    Buffer.add_string b (U64.to_string ia)
+
+  let fmt_sub_auths b sas =
+    Array.iter
+      (fun sa ->
+         Buffer.add_char b '-';
+         Buffer.add_string b (U32.to_string sa))
+      sas
+
+  let encode s =
+    let b = Buffer.create 16 in
+    Buffer.add_string b "S-1-";
+    fmt_ident_auth b s.sid_ident_auth;
+    fmt_sub_auths  b s.sid_sub_auths;
+    Buffer.contents b
+
+end (* [module StringFmt] *)
+
+module PacketRep = struct (* [MS-DTYP] 2.4.22 *)
+
+  let encode s =
+    let nsa = Array.length s.sid_sub_auths in
+    let l = 8 + nsa * sizeof_sub_auth in
+    let b = Buffer.create l in
+
+    assert (0 <= nsa && nsa <= 15);
+
+    let pushbyte c = char_of_int c |> Buffer.add_char b in
+
+    pushbyte 1;
+    pushbyte nsa;
+
+    let getia n =
+      pushbyte (U64.to_int (U64.shift_right s.sid_ident_auth n) land 0xff)
+    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)
+      s.sid_sub_auths;
+    Bytes.unsafe_of_string (Buffer.contents b)
+
+end (* [module PacketRep] *)
+
+module WellKnown = struct
+  (*
+   * see also
+   * https://docs.microsoft.com/en-us/windows/desktop/secauthz/well-known-sids
+   *)
+
+  let null = create_unsafe [| U32.zero |] U64.zero
+  let everyone = create_unsafe [| U32.zero |] U64.one
+  let world = everyone
+  let local = create_unsafe [| U32.zero |] (U64.of_int 2)
+  let creator_owner_id = create_unsafe [| U32.zero |] (U64.of_int 3)
+  let creator_group_id = create_unsafe [| U32.one |] (U64.of_int 3)
+  let elite = create_unsafe [| U32.of_int 3 ; U32.of_int 3; U32.of_int 7 |] U64.one
+
+  module Prefix = struct
+    let security_null_sid_authority    ?(sa=[||]) () = create ~sa (U64.of_int 0)
+    let security_world_sid_authority   ?(sa=[||]) () = create ~sa (U64.of_int 1)
+    let security_local_sid_authority   ?(sa=[||]) () = create ~sa (U64.of_int 2)
+    let security_creator_sid_authority ?(sa=[||]) () = create ~sa (U64.of_int 3)
+    let security_nt_authority          ?(sa=[||]) () = create ~sa (U64.of_int 5)
+  end
+end
+
+let of_string = StringFmt.decode
+let to_string = StringFmt.encode
+
+type t = sid
diff --git a/sid_test.ml b/sid_test.ml
new file mode 100644
index 0000000..9812152
--- /dev/null
+++ b/sid_test.ml
@@ -0,0 +1,95 @@
+open OUnit
+
+(* 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
+         [| Uint32.zero      ; Uint32.one       ; Uint32.of_int  2
+          ; Uint32.of_int  3 ; Uint32.of_int  4 ; Uint32.of_int  5
+          ; Uint32.of_int  6 ; Uint32.of_int  7 ; Uint32.of_int  8
+          ; Uint32.of_int  9 ; Uint32.of_int 10 ; Uint32.of_int 11
+          ; Uint32.of_int 12 ; Uint32.of_int 13 ; Uint32.of_int 14
+         |]
+         Uint64.one
+    )
+
+let sf_parse_ok () =
+  let s = Sid.of_string "S-1-1-0" in
+  let z = Stdint.((Sid.create_unsafe [| Uint32.zero |] Uint64.one)) in
+  assert_bool
+    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string z))
+    (Sid.equal s z);
+  let w = Sid.WellKnown.world in
+  assert_bool
+    (Printf.sprintf "[%s] ≠ [well known: %s]"
+       (Sid.to_string s) (Sid.to_string w))
+    (Sid.equal s w)
+
+let sf_parse_empty_fail () =
+  assert_raises
+    (Invalid_argument
+       "Invalid SID: ‘’ too short to be a SID in string format")
+    (fun () -> Sid.of_string "")
+
+let sf_parse_junk_fail () =
+  assert_raises
+    (Invalid_argument
+       "Invalid SID [not a sid]: expected ‘S’ at position 0, found ‘n’")
+    (fun () -> Sid.of_string "not a sid")
+
+let sf_parse_ia_junk_fail () =
+  assert_raises
+    (Invalid_argument
+       "Invalid SID [not a sid]: expected ‘1’ at position 2, found ‘I’")
+    (fun () -> Sid.of_string "S-I-3-3-7")
+
+let sf_parse_opt_ok () =
+  let s = Sid.StringFmt.from_string_opt "S-1-1-0" in
+  assert_bool "failure parsing [S-1-1-0] with option" (s <> None)
+
+let sf_parse_opt_fail () =
+  let s = Sid.StringFmt.from_string_opt "not a sid" in
+  assert_bool "unexpected success parsing garbage with option" (s = None)
+
+let is_error = function Error _ -> true | _ -> false
+
+let sf_parse_result_ok () =
+  let s = Sid.StringFmt.from_string_res "S-1-1-0" in
+  assert_bool "failure parsing [S-1-1-0] with result" (not (is_error s))
+
+let sf_parse_result_fail () =
+  let s = Sid.StringFmt.from_string_res "not a sid" in
+  assert_bool "unexpected success parsing garbage with result" (is_error s)
+
+let sf_parse_long_ok () =
+  let s = Sid.of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14"
+  and l = max_sid in
+  assert_bool
+    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string l))
+    (Sid.equal s l)
+
+let sf_parse_too_long_ok () =
+  (* must ignore trailing subauths *)
+  let s1 = Sid.of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15"
+  and s2 = Sid.of_string "S-1-1-0-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15-16-17"
+  and l = max_sid in
+  assert_bool
+    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s1) (Sid.to_string l))
+    (Sid.equal s1 l);
+  assert_bool
+    (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s2) (Sid.to_string l))
+    (Sid.equal s2 l)
+
+let test = "string-format-syntax" >:::
+  [ "parse-ok"              >:: sf_parse_ok
+  ; "parse-empty-fail"      >:: sf_parse_empty_fail
+  ; "parse-junk-fail"       >:: sf_parse_junk_fail
+  ; "parse-opt-ok"          >:: sf_parse_opt_ok
+  ; "parse-opt-fail"        >:: sf_parse_opt_fail
+  ; "parse-result-ok"       >:: sf_parse_result_ok
+  ; "parse-result-fail"     >:: sf_parse_result_fail
+  ; "parse-long-ok"         >:: sf_parse_long_ok
+  ; "parse-too-long-ok"     >:: sf_parse_too_long_ok
+  ]
+
+let () = ignore (run_test_tt_main test)
+