path: root/sid.ml

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