diff options
| -rw-r--r-- | sid.ml | 76 | ||||
| -rw-r--r-- | sid_test.ml | 16 |
2 files changed, 59 insertions, 33 deletions
@@ -44,7 +44,35 @@ 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 StringFmt = struct +module type Validator = sig + val name : string + val ia : bool -> U64.t -> bool + val sas : U32.t array -> bool +end + +(** Validate as though the spec in [MS-DTYP] were normative. *) +module Vtor_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 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 nsa = Array.length v in + 0 < nsa && nsa <= max_subauth_count +end (* [module Vtor_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 @@ -103,32 +131,26 @@ module StringFmt = struct done; Bytes.blit_string s (p+2) b 2 12; let ia = U64.of_string (Bytes.unsafe_to_string b) in - if ia < ident_auth_hexmin then + if not (Vtor.ia true ia) 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 if ia > max_ident_auth then - raise (Invalid_argument - (Printf.sprintf - "Invalid SID: identifier authority (value=%s) cannot fit \ - 6 B (%s)" - (U64.to_string ia) (U64.to_string max_ident_auth))) + "input malformed: hex-encoded identifier authority failed \ + “%s” validation (value=%s)" + Vtor.name (U64.to_string ia))) else p + ident_auth_hexlen, ia let ident_auth_decimal s p = let p, ia = read_decimal_u64 s p in - if ia >= ident_auth_hexmin then + if not (Vtor.ia false ia) then raise (Invalid_argument (Printf.sprintf - "input malformed: identifier authority from 2³² on must \ - be hex-encoded (value=%s)" - (U64.to_string ia))) else + "input malformed: decimal identifier authority failed \ + “%s” validation (value=%s)" + Vtor.name (U64.to_string ia))) else p, ia let read_ident_auth s p = @@ -157,12 +179,6 @@ module StringFmt = struct expect_char s '-' 3; let p = 4 in let p, ia = read_ident_auth s p in - if p = n || s.[p] <> '-' then - raise (Invalid_argument - (Printf.sprintf - "Invalid SID: error parsing SID [%s] at position %d, \ - grammar mandates at least one subauthority" - s p)) else let sa = ref [] and p' = ref p in while !p' < n - 1 && List.length !sa < max_subauth_count @@ -181,9 +197,17 @@ module StringFmt = struct sa := d :: !sa; p' := np done; - Ok { sid_ident_auth = ia - ; sid_sub_auths = Array.of_list (List.rev !sa) - } + let sas = Array.of_list (List.rev !sa) in + if not (Vtor.sas sas) then + Error + (Printf.sprintf + "input malformed: subauthority list failed “%s” validation \ + (count=%n)" + Vtor.name (Array.length sas)) + else + Ok { sid_ident_auth = ia + ; sid_sub_auths = sas + } with Invalid_argument e -> Error e; end @@ -215,7 +239,9 @@ module StringFmt = struct fmt_sub_auths b s.sid_sub_auths; Buffer.contents b -end (* [module StringFmt] *) +end (* [module MkStringFmt] *) + +module StringFmt = MkStringFmt (Vtor_strict) module PacketRep = struct (* [MS-DTYP] 2.4.22 *) diff --git a/sid_test.ml b/sid_test.ml index 7da0d7f..26a125b 100644 --- a/sid_test.ml +++ b/sid_test.ml @@ -111,8 +111,8 @@ let sf_parse_nosa_fail () = (Printf.sprintf "unexpectedly parsed garbage as SID [%s]" (Sid.to_string s)) | Error e -> - assert_equal e "Invalid SID: error parsing SID [S-1-1] at position 5, \ - grammar mandates at least one subauthority" + assert_equal e "input malformed: subauthority list failed “strict” \ + validation (count=0)" let sf_parse_trailing_ok () = let s = unwrap_of_string "S-1-0-0-" in @@ -139,8 +139,8 @@ let sf_parse_oobia_fail () = with | Ok _ -> assert_failure "unexpectedly parsed the out of bounds subauth" | Error e -> - assert_equal e "input malformed: identifier authority from 2³² on must \ - be hex-encoded (value=18446744073709551615)" + assert_equal e "input malformed: decimal identifier authority failed \ + “strict” validation (value=18446744073709551615)" let sf_parse_oobsa_fail () = match Sid.of_string @@ -189,8 +189,8 @@ let sf_parse_iaxxoob_fail () = (* ias <= UINT32_MAX → decimal; hex not allowed *) match Sid.of_string "S-1-0x0000deadbeef-17-01" with | Error e -> - let expect = "input malformed: identifier authority less than 2³² must \ - not be hex-encoded (value=3735928559)" + let expect = "input malformed: hex-encoded identifier authority failed \ + “strict” validation (value=3735928559)" in assert_equal ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) @@ -236,8 +236,8 @@ let sf_parse_iaxxlong_fail () = (* too many digits, need exactly 12 *) match Sid.of_string "S-1-0xC01DC01DB100D-17-01" with | Error e -> - let expect = "Invalid SID: error parsing SID [S-1-0xC01DC01DB100D-17-01] \ - at position 18, grammar mandates at least one subauthority" + let expect = "input malformed: subauthority list failed “strict” \ + validation (count=0)" in assert_equal ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) |