(* SPDX-License-Identifier: LGPL-3.0-only WITH OCaml-LGPL-linking-exception *) 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 max_ident_auth = U64.of_string "0x0000_ffff_ffff_ffff" 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 if U64.compare ia max_ident_auth > 0 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 is_xdigit c = '0' <= c && c <= '9' || 'a' <= c && c <= 'f' || 'A' <= c && c <= 'F' 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 let ident_auth_hexlen = 14 (* 0x, 12 × hex digit *) let ident_auth_hexmin = U64.of_string "0x0001_0000_0000" (* specialized cause only needed for ia *) let read_ident_auth_hex s p = assert (p <= String.length s - ident_auth_hexlen); let e = p + ident_auth_hexlen - 1 in let b = Bytes.make ident_auth_hexlen '\x2a' in Bytes.set b 0 '0'; (* hex indicator for U64.of_string *) Bytes.set b 1 'x'; for i = p + 2 to e do (* assumption: prefix “0x” checked by caller *) if not (is_xdigit s.[i]) then raise (Invalid_argument (Printf.sprintf "Invalid SID [%s]: expected hexadecimal digit at \ position %d while parsing ident auth, got ‘%c’" s i s.[i])) done; Bytes.blit_string s (p+2) b 2 12; p + ident_auth_hexlen, U64.of_string (Bytes.unsafe_to_string b) let ident_auth_decimal s p = let p, ia = read_decimal_u64 s p in if ia >= ident_auth_hexmin then raise (Invalid_argument (Printf.sprintf "input malformed: identifier authority from 2³² on must \ be hex-encoded (value=%s)" (U64.to_string ia))) else p, ia let read_ident_auth s p = let r = String.length s - p in if r < ident_auth_hexlen then ident_auth_decimal s p else (* hex can’t fit *) match s.[p], s.[p+1] with | '0', 'x' -> (let p, ia = read_ident_auth_hex s p in if ia < ident_auth_hexmin then raise (Invalid_argument (Printf.sprintf "input malformed: identifier authority less than 2³² must \ not be hex-encoded (value=%s)" (U64.to_string ia))) else p, ia) | _ -> ident_auth_decimal s p (* * 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_ident_auth s p in if ia > max_ident_auth then raise (Invalid_argument (Printf.sprintf "Invalid SID: identifier authority cannot fit 6 B (%s)" (U64.to_string max_ident_auth))); 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 = try read_decimal_u32 s (!p' + 1) with Invalid_argument e -> (* Brr, but Stdint’s error messages aren’t overly instructive. *) raise (Invalid_argument (Printf.sprintf "Invalid SID: error parsing subauth at position %d, \ (err: %s)" (!p' + 1) e)) 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 ident_auth_blank = "0x000000000000" let fmt_ident_auth b ia = if U64.compare ia ident_auth_hexmin < 0 then Buffer.add_string b (U64.to_string ia) else begin let iax = U64.to_string_hex ia in let niax = String.length iax in let pad = ident_auth_hexlen - niax in if pad = 0 then Buffer.add_string b iax else (Buffer.add_string b (String.sub ident_auth_blank 0 (2+pad)); Buffer.add_string b (String.sub iax 2 (niax - 2))) end 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 ia = U64.of_bytes_big_endian b 0 |> U64.logand max_ident_auth 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 } let from_channel ?(endian=Little) ic = try let v = input_byte ic in if v <> 0x01 then Error (Printf.sprintf "input malformed: expected SID version=0x01, got 0x%0.2x" v) else let nsa = input_byte ic 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 n = sizeof_ident_auth + nsa * sizeof_sub_auth in let b = Bytes.make (2 + n) '\x00' in Bytes.set b 0 '\x01'; Bytes.set b 1 (char_of_int nsa); really_input ic b 2 n; decode ~endian b with End_of_file -> Error (Printf.sprintf "input malformed: unexpected end of file at offset %d \ parsing SID" (pos_in ic)) let to_channel ?(endian=Little) oc s = encode ~endian s |> output_bytes oc end (* [module PacketRep] *) module WellKnown = struct let cu = create_unsafe let sa = U32.of_int let ia = U64.of_int (* * see also * https://docs.microsoft.com/en-us/windows/desktop/secauthz/well-known-sids *) let null = cu [| U32.zero |] U64.zero let everyone = cu [| U32.zero |] U64.one let world = everyone (* 1-2-… *) let local = cu [| U32.zero |] (U64.of_int 2) let console_logon = cu [| U32.one |] (U64.of_int 2) (* 1-3-… *) let creator_owner_id = cu [| U32.zero |] (U64.of_int 3) let creator_group_id = cu [| U32.one |] (U64.of_int 3) let creator_owner_server = cu [| U32.of_int 2 |] (U64.of_int 3) let creator_group_server = cu [| U32.of_int 3 |] (U64.of_int 3) let owner_rights = cu [| U32.of_int 4 |] (U64.of_int 3) let elite = cu [| U32.of_int 3 ; U32.of_int 3; U32.of_int 7 |] U64.one (* 1-5-… *) let nt_authority = cu [| |] (U64.of_int 5) let dialup = cu [| U32.one |] (U64.of_int 5) let network = cu [| U32.of_int 2 |] (U64.of_int 5) let batch = cu [| U32.of_int 3 |] (U64.of_int 5) let interactive = cu [| U32.of_int 4 |] (U64.of_int 5) let logon_id = cu [| U32.of_int 5 |] (U64.of_int 5) let service = cu [| U32.of_int 6 |] (U64.of_int 5) let anonymous = cu [| U32.of_int 7 |] (U64.of_int 5) let proxy = cu [| U32.of_int 8 |] (U64.of_int 5) let enterprise_domain_controllers = cu [| U32.of_int 9 |] (U64.of_int 5) let principal_self = cu [| U32.of_int 10 |] (U64.of_int 5) let authenticated_users = cu [| U32.of_int 11 |] (U64.of_int 5) let restricted_code = cu [| U32.of_int 12 |] (U64.of_int 5) let terminal_server_user = cu [| U32.of_int 13 |] (U64.of_int 5) let remote_interactive_logon = cu [| U32.of_int 14 |] (U64.of_int 5) let this_organisation = cu [| U32.of_int 15 |] (U64.of_int 5) let iusr = cu [| U32.of_int 17 |] (U64.of_int 5) let local_system = cu [| U32.of_int 18 |] (U64.of_int 5) let local_service = cu [| U32.of_int 19 |] (U64.of_int 5) let network_service = cu [| U32.of_int 20 |] (U64.of_int 5) let compounded_authentication = cu [| sa 21; U32.zero; U32.zero; U32.zero; sa 496 |] (ia 5) let claims_valid = cu [| sa 21; U32.zero; U32.zero; U32.zero; sa 497 |] (ia 5) let administrator machine = cu [| sa 21; machine; sa 500 |] (ia 5) let guest machine = cu [| sa 21; machine; sa 501 |] (ia 5) let krbtgt domain = cu [| sa 21; domain; sa 502 |] (ia 5) let domain_admins domain = cu [| sa 21; domain; sa 512 |] (ia 5) let domain_users domain = cu [| sa 21; domain; sa 513 |] (ia 5) let domain_guests domain = cu [| sa 21; domain; sa 514 |] (ia 5) let domain_computers domain = cu [| sa 21; domain; sa 515 |] (ia 5) let domain_domain_controllers domain = cu [| sa 21; domain; sa 516 |] (ia 5) let cert_publishers domain = cu [| sa 21; domain; sa 517 |] (ia 5) let schema_administrators root_domain = cu [| sa 21; root_domain; sa 518 |] (ia 5) let enterprise_admins root_domain = cu [| sa 21; root_domain; sa 519 |] (ia 5) let group_policy_creator_owners domain = cu [| sa 21; domain; sa 520 |] (ia 5) let readonly_domain_controllers domain = cu [| sa 21; domain; sa 521 |] (ia 5) let cloneable_controllers domain = cu [| sa 21; domain; sa 522 |] (ia 5) let protected_users domain = cu [| sa 21; domain; sa 525 |] (ia 5) let key_admins domain = cu [| sa 21; domain; sa 526 |] (ia 5) let enterprise_key_admins domain = cu [| sa 21; domain; sa 527 |] (ia 5) let ras_servers domain = cu [| sa 21; domain; sa 553 |] (ia 5) let allowed_rodc_password_replication_group domain = cu [| sa 21; domain; sa 571 |] (ia 5) let denied_rodc_password_replication_group domain = cu [| sa 21; domain; sa 572 |] (ia 5) let builtin_administrators = cu [| sa 32; sa 544 |] (ia 5) let builtin_users = cu [| sa 32; sa 545 |] (ia 5) let builtin_guests = cu [| sa 32; sa 546 |] (ia 5) let power_users = cu [| sa 32; sa 547 |] (ia 5) let account_operators = cu [| sa 32; sa 548 |] (ia 5) let server_operators = cu [| sa 32; sa 549 |] (ia 5) let printer_operators = cu [| sa 32; sa 550 |] (ia 5) let backup_operators = cu [| sa 32; sa 551 |] (ia 5) let replicator = cu [| sa 32; sa 552 |] (ia 5) let alias_prew2kcompacc = cu [| sa 32; sa 554 |] (ia 5) let remote_desktop = cu [| sa 32; sa 555 |] (ia 5) let network_configuration_ops = cu [| sa 32; sa 556 |] (ia 5) let incoming_forest_trust_builders = cu [| sa 32; sa 557 |] (ia 5) let perfmon_users = cu [| sa 32; sa 558 |] (ia 5) let perflog_users = cu [| sa 32; sa 559 |] (ia 5) let windows_authorization_access_group = cu [| sa 32; sa 560 |] (ia 5) let terminal_server_license_servers = cu [| sa 32; sa 561 |] (ia 5) let distributed_com_users = cu [| sa 32; sa 562 |] (ia 5) let iis_iusrs = cu [| sa 32; sa 568 |] (ia 5) let cryptographic_operators = cu [| sa 32; sa 569 |] (ia 5) let event_log_readers = cu [| sa 32; sa 573 |] (ia 5) let certificate_service_dcom_access = cu [| sa 32; sa 574 |] (ia 5) let rds_remote_access_servers = cu [| sa 32; sa 575 |] (ia 5) let rds_endpoint_servers = cu [| sa 32; sa 576 |] (ia 5) let rds_management_servers = cu [| sa 32; sa 577 |] (ia 5) let hyper_v_admins = cu [| sa 32; sa 578 |] (ia 5) let access_control_assistance_ops = cu [| sa 32; sa 579 |] (ia 5) let remote_management_users = cu [| sa 32; sa 580 |] (ia 5) let write_restricted_code = cu [| sa 33 |] (ia 5) let ntlm_authentication = cu [| sa 64; sa 10 |] (ia 5) let schannel_authentication = cu [| sa 64; sa 14 |] (ia 5) let digest_authentication = cu [| sa 64; sa 21 |] (ia 5) let this_organization_certificate = cu [| sa 65; sa 1 |] (ia 5) let nt_service = cu [| sa 80 |] (ia 5) let user_mode_drivers = cu [| sa 84; U32.zero; U32.zero; U32.zero; U32.zero; U32.zero |] (ia 5) let local_account = cu [| sa 113 |] (ia 5) let local_account_and_member_of_administrators_group = cu [| sa 114 |] (ia 5) let other_organization = cu [| sa 1000 |] (ia 5) (* 1-15-… *) let all_app_packages = cu [| sa 2; U32.one |] (ia 15) (* 1-16-… *) let ml_untrusted = cu [| U32.zero |] (ia 16) let ml_low = cu [| sa 4096 |] (ia 16) let ml_medium = cu [| sa 8192 |] (ia 16) let ml_medium_plus = cu [| sa 8448 |] (ia 16) let ml_high = cu [| sa 12288 |] (ia 16) let ml_system = cu [| sa 16384 |] (ia 16) let ml_protected_process = cu [| sa 20480 |] (ia 16) let ml_secure_process = cu [| sa 28672 |] (ia 16) (* 1-18-… *) let authentication_authority_asserted_identity = cu [| U32.one |] (ia 18) let service_asserted_identity = cu [| sa 2 |] (ia 18) let fresh_public_key_identity = cu [| sa 3 |] (ia 18) let key_trust_identity = cu [| sa 4 |] (ia 18) let key_property_mfa = cu [| sa 5 |] (ia 18) let key_property_attestation = cu [| sa 6 |] (ia 18) module Prefix = struct 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 let of_bytes = PacketRep.decode let to_bytes = PacketRep.encode type t = sid