summaryrefslogtreecommitdiff
path: root/sid.ml
diff options
context:
space:
mode:
Diffstat (limited to 'sid.ml')
-rw-r--r--sid.ml199
1 files changed, 199 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