diff options
Diffstat (limited to 'sid.ml')
| -rw-r--r-- | sid.ml | 76 |
1 files changed, 51 insertions, 25 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 *) |