(* SPDX-License-Identifier: LGPL-3.0-only *) 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 sizeof_ident_auth = 6 let sizeof_sub_auth = 4 let max_subauth_count = 15 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) let get_ident_auth s = s.sid_ident_auth let get_sub_auths s = s.sid_sub_auths 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 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 Error (Printf.sprintf "Invalid SID: ‘%s’ too short to be a SID in string format" s) else begin try 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 - 1 && List.length !sa < max_subauth_count do expect_char s '-' !p'; let np, d = read_decimal_u32 s (!p' + 1) in sa := d :: !sa; p' := np done; Ok { sid_ident_auth = ia ; sid_sub_auths = Array.of_list (List.rev !sa) } with Invalid_argument e -> Error e; end 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 *) type endian = Big | Little 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 = 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); 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 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; 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 "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) 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) <- read_u32 b off done; Ok { sid_ident_auth = ia ; sid_sub_auths = sas } 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 type toplevel_auth = ?sa:sub_auths -> unit -> sid let security_null_sid_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x00) let security_world_sid_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x01) let security_local_sid_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x02) let security_creator_sid_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x03) let security_nt_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x05) let security_app_package_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x0f) let security_mandatory_label_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x10) let security_scoped_policy_id_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x11) let security_authentication_authority ?(sa=[||]) () = create_unsafe sa (U64.of_int 0x12) end end let of_string = StringFmt.decode let to_string = StringFmt.encode type t = sid