summaryrefslogtreecommitdiff
path: root/sid.ml
diff options
context:
space:
mode:
Diffstat (limited to 'sid.ml')
-rw-r--r--sid.ml218
1 files changed, 153 insertions, 65 deletions
diff --git a/sid.ml b/sid.ml
index e8bc4ad..17c8124 100644
--- a/sid.ml
+++ b/sid.ml
@@ -11,6 +11,8 @@ and sub_auths = U32.t array
let sizeof_ident_auth = 6
let max_ident_auth = U64.of_string "0x0000_ffff_ffff_ffff"
+let ident_auth_hexlen = 14 (* 0x, 12 × hex digit *)
+let ident_auth_hexmin = U64.of_string "0x0001_0000_0000"
let sizeof_sub_auth = 4
let max_subauth_count = 15
@@ -44,113 +46,198 @@ let equal a b =
&& 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 Validator = sig
+module Util = 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'
+end
+
+module type Conformance = sig
val name : string
- val ia : bool -> U64.t -> bool
- val sas : U32.t array -> bool
+
+ val parse_hex_ia : string -> int -> U64.t * int
+ (** [parse_hex_ia raw p] read ia from [raw] at position [p] in hexadecimal,
+ return the value and the next position in the string. This only enforces
+ parsing behavior, not the value range. *)
+
+ val valid_decimal : string -> bool
+ (** [valid_decimal s] holds if [s] conforms to the constraints for decimal
+ numbers. Assumes the input already is all decimal digits. *)
+
+ val valid_ia : bool -> U64.t -> bool
+ (** [valid_ia ia] holds if [ia] is a valid identifier authority. *)
+
+ val valid_sas : U32.t array -> bool
+ (** [valid_sas sas] holds if [sas] is a valid array of
+ subauthorities. *)
+
+ val pad_hex_ia : int -> int
+ (** [pad n] return the number of padding zeros to prepend to the hex format
+ ident auth. *)
end
-(** Validate as though the spec in [MS-DTYP] were normative. *)
-module Vtor_strict = struct
+(* Validate and convert as though the spec in [MS-DTYP] were normative. *)
+module Con_strict = struct
let name = "strict"
- let ident_auth_hexlen = 14 (* 0x, 12 × hex digit *)
- let ident_auth_hexmin = U64.of_string "0x0001_0000_0000"
+ let parse_hex_ia 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 (Util.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;
+ U64.of_string (Bytes.unsafe_to_string b),
+ p + ident_auth_hexlen
+
+ (* leading zeros forbidden except for zero itself *)
+ let valid_decimal d =
+ String.length d > 0
+ && (String.length d = 1 || String.get d 0 <> '0')
- let ia hex v =
+ let valid_ia hex v =
if U64.compare v max_ident_auth > 0 then false else
if not hex && U64.compare v ident_auth_hexmin >= 0 then false else
not (hex && U64.compare v ident_auth_hexmin < 0)
- let sas v =
+ let valid_sas v =
+ let nsa = Array.length v in
+ 0 < nsa && nsa <= max_subauth_count
+
+ (* zero-pad to exactly twelve hex digits *)
+ let pad_hex_ia niax =
+ ident_auth_hexlen - niax
+end (* [module Con_strict] *)
+
+(* Validate simulating the empirically determined behavior of MS’s own
+ implementation “ConvertStringSidToSidA()”. The error code it returns
+ when rejecting an input is “ERROR_INVALID_SID”.
+
+ input | well-formed parsed | round-trip well-formed
+ -------------------------+----------------------+------------------------------------
+ S-1-0x000000000000-1 | no yes | S-1-0-1 yes
+ S-1-0x0000000000ff-1 | no yes | S-1-255-1 yes
+ S-1-0x0001000000ff-1 | yes yes | S-1-0x1000000FF-1 no
+ S-1-0xffffffffffff-1 | yes yes | S-1-0xFFFFFFFFFFFF-1 yes
+ S-1-0xff00ff00ff-1 | no yes | S-1-0xFF00FF00FF-1 no
+ S-1-0xff00ff00ff00ff-1 | no no | ø -
+ S-1-4294967296-1 | no yes | S-1-0x100000000-1 no
+ S-1-01-1 | no yes | S-1-1-1 yes
+ S-1-08-1 | no yes | S-1-8-1 yes
+ S-1-001-1 | no yes | S-1-1-1 yes
+ S-1-1 | no no | ø -
+ S-1-5 | no no | ø -
+
+ The inverse operations were modeled after “ConvertSidToStringSidA()”.
+*)
+module Con_MS = struct
+ let name = "MS"
+
+ let parse_hex_ia s p =
+ assert (String.length s - p - 2 > 0);
+ let e = p + ident_auth_hexlen in
+ let b = Buffer.create ident_auth_hexlen in
+ Buffer.add_string b "0x"; (* hex indicator for U64.of_string *)
+ let i = ref (p + 2) in
+ while !i < min (String.length s) e
+ && Util.is_xdigit s.[!i]
+ do
+ Buffer.add_char b s.[!i];
+ incr i;
+ done;
+ U64.of_string (Buffer.contents b),
+ !i
+
+ (* MS doesn’t care for leading zeros. *)
+ let valid_decimal d =
+ String.length d > 0
+
+ (* MS accepts hex-formatted ias of arbitrary values as long as they
+ fit a u64 *)
+ let valid_ia _hex v = true
+
+ (* Interestingly, subauths behave as specified. *)
+ let valid_sas v =
let nsa = Array.length v in
0 < nsa && nsa <= max_subauth_count
-end (* [module Vtor_strict] *)
+
+ (* No leading zeros in the hex output despite the spec mandating this
+ only for decimal formatting. *)
+ let pad_hex_ia _niax =
+ 0
+end (* [module Con_strict] *)
module type StringFmt_intf = sig
val decode : string -> (sid, string) result
val encode : sid -> string
end
-module MkStringFmt (Vtor : Validator) = 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'
+module MkStringFmt (Con : Conformance) = struct
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
+ while !p' < n && Util.is_digit s.[!p'] do
Buffer.add_char b s.[!p'];
incr p'
done;
- let nb = Buffer.length b in
- if nb = 0 then
+ let d = Buffer.contents b in
+ if not (Con.valid_decimal d) then
raise (Invalid_argument
(Printf.sprintf
- "Invalid SID [%s]: expected decimal at position %d" s p))
+ "Invalid SID [%s]: “%s” is not a valid decimal in mode %s"
+ s d Con.name))
else
- p + nb,
- f (Buffer.contents b)
+ p + String.length d,
+ f d
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;
- let ia = U64.of_string (Bytes.unsafe_to_string b) in
- if not (Vtor.ia true ia) then
+ let ia, p' = Con.parse_hex_ia s p in
+ if not (Con.valid_ia true ia) then
raise
(Invalid_argument
(Printf.sprintf
"input malformed: hex-encoded identifier authority failed \
“%s” validation (value=%s)"
- Vtor.name (U64.to_string ia)))
+ Con.name (U64.to_string ia)))
else
- p + ident_auth_hexlen,
- ia
+ p', ia
let ident_auth_decimal s p =
let p, ia = read_decimal_u64 s p in
- if not (Vtor.ia false ia) then
+ if not (Con.valid_ia false ia) then
raise
(Invalid_argument
(Printf.sprintf
"input malformed: decimal identifier authority failed \
“%s” validation (value=%s)"
- Vtor.name (U64.to_string ia))) else
+ Con.name (U64.to_string ia))) else
p, ia
let read_ident_auth s p =
@@ -173,10 +260,10 @@ module MkStringFmt (Vtor : Validator) = struct
"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;
+ Util.expect_char s 'S' 0;
+ Util.expect_char s '-' 1;
+ Util.expect_char s '1' 2;
+ Util.expect_char s '-' 3;
let p = 4 in
let p, ia = read_ident_auth s p in
let sa = ref [] and p' = ref p in
@@ -198,12 +285,12 @@ module MkStringFmt (Vtor : Validator) = struct
p' := np
done;
let sas = Array.of_list (List.rev !sa) in
- if not (Vtor.sas sas) then
+ if not (Con.valid_sas sas) then
Error
(Printf.sprintf
"input malformed: subauthority list failed “%s” validation \
(count=%n)"
- Vtor.name (Array.length sas))
+ Con.name (Array.length sas))
else
Ok { sid_ident_auth = ia
; sid_sub_auths = sas
@@ -219,7 +306,7 @@ module MkStringFmt (Vtor : Validator) = struct
else begin
let iax = U64.to_string_hex ia in
let niax = String.length iax in
- let pad = ident_auth_hexlen - niax in
+ let pad = Con.pad_hex_ia 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)))
@@ -241,7 +328,8 @@ module MkStringFmt (Vtor : Validator) = struct
end (* [module MkStringFmt] *)
-module StringFmt = MkStringFmt (Vtor_strict)
+module StringFmt = MkStringFmt (Con_strict)
+module MSStringFmt = MkStringFmt (Con_MS)
module PacketRep = struct (* [MS-DTYP] 2.4.22 *)