diff options
| -rw-r--r-- | sid.ml | 218 | ||||
| -rw-r--r-- | sid.mli | 11 | ||||
| -rw-r--r-- | sid_test.ml | 95 |
3 files changed, 257 insertions, 67 deletions
@@ -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 *) @@ -46,6 +46,17 @@ module StringFmt : (** [encode s] convert SID [s] to its string representation. *) end +(** Conversions to and from the {e string format syntax} with permissive + input validation. *) +module MSStringFmt : + sig + val decode : string -> (t, string) result + (** [decode b] parse string buffer [b] into a SID. *) + + val encode : t -> string + (** [encode s] convert SID [s] to its string representation. *) + end + (** Conversion to and from the {e packet representation} (MS-DTYP 2.4.2.2). *) module PacketRep : sig diff --git a/sid_test.ml b/sid_test.ml index 26a125b..b339190 100644 --- a/sid_test.ml +++ b/sid_test.ml @@ -255,6 +255,91 @@ let sf_print_iaxx_ok () = ~msg:(Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string sid) str) (Sid.to_string sid) str +let ms_unwrap_of_string s = + match Sid.MSStringFmt.decode s with + | Error e -> + assert_failure + (Printf.sprintf "error parsing assumed well-formed sid [%s]: %s" s e) + | Ok r -> r + +let mssf_parse_ok () = + (* accept well-formed input *) + let s = ms_unwrap_of_string "S-1-1-0" + and z = Sid.create_unsafe U64.one [| U32.zero |] in + assert_bool + (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s) (Sid.to_string z)) + (Sid.equal s z); + let w = Sid.WellKnown.world in + assert_bool + (Printf.sprintf "[%s] ≠ [well known: %s]" + (Sid.to_string s) (Sid.to_string w)) + (Sid.equal s w) + +let mssf_parse_hex_junk_ok () = + (* accept certain kinds of malformed input; note: we expect hex digit + to be lowercase *) + let samples = + [ "S-1-0x000000000000-1" , false, Some ("S-1-0-1" , true ) + ; "S-1-0x0000000000ff-1" , false, Some ("S-1-255-1" , true ) + ; "S-1-0x0001000000ff-1" , true , Some ("S-1-0x1000000ff-1" , false) + ; "S-1-0xffffffffffff-1" , true , Some ("S-1-0xffffffffffff-1", true ) + ; "S-1-0xff00ff00ff-1" , false, Some ("S-1-0xff00ff00ff-1" , false) + ; "S-1-0xff00ff00ff00ff-1", false, None + ; "S-1-4294967296-1" , false, Some ("S-1-0x100000000-1" , false) + ; "S-1-01-1" , false, Some ("S-1-1-1" , true ) + ; "S-1-08-1" , false, Some ("S-1-8-1" , true ) + ; "S-1-001-1" , false, Some ("S-1-1-1" , true ) + ; "S-1-1" , false, None + ; "S-1-5" , false, None + ] + in + let is_wellformed s = + match Sid.StringFmt.decode s with Ok _ -> true | Error _ -> false in + let check (input, inwell, output) = + let () = + if is_wellformed input then + assert_bool + (Printf.sprintf "Sid [%s] parsed a-ok despite strict mode" input) + inwell + else + assert_bool + (Printf.sprintf "Sid [%s] failed to parse with strict mode" input) + (not inwell) + in + let () = + match Sid.MSStringFmt.decode input, output with + | Ok s, None -> + assert_bool + (Printf.sprintf "Sid [%s] unexpectedly parsed a-ok with MS mode" + input) + false + | Ok s, Some (output, outwell) -> (* test round-trip results *) + let reenc = Sid.MSStringFmt.encode s in + let () = + assert_bool + (Printf.sprintf "Sid [%s] re-encoded as [%s] failed to match \ + expected value of [%s]" + input reenc output) + (output = reenc) + in (* finally: validate behavior of strict parse against output *) + assert_bool + (Printf.sprintf "Sid [%s] re-encoded as [%s] unexpectedly \ + %s in strict mode" + input reenc + (if outwell then "failed to parse" else "parsed ok")) + (is_wellformed reenc = outwell) + | Error _, None -> () (* bad even by MS standards *) + | Error e, Some (output, _) -> + assert_bool + (Printf.sprintf "Sid [%s] failed to parse in MS mode (%s), \ + expected [%s] after reconversion" + input e output) + false + in () + in + List.iter check samples + + let pr_encode_null_ok () = let x = Sid.WellKnown.null @@ -455,6 +540,11 @@ let string_format_test = "string-format-syntax" >::: ; "print-iaxx-ok" >:: sf_print_iaxx_ok ] +let ms_string_format_test = "ms-string-format-syntax" >::: + [ "parse-ok" >:: mssf_parse_ok + ; "parse-hex-junk-ok" >:: mssf_parse_hex_junk_ok + ] + let packet_rep_test = "packet-rep" >::: [ "encode-null-ok" >:: pr_encode_null_ok ; "encode-all-ok" >:: pr_encode_all_ok @@ -476,6 +566,7 @@ let toplevel_test = "toplevel" >::: let () = ignore (run_test_tt_main string_format_test); - ignore (run_test_tt_main packet_rep_test ); - ignore (run_test_tt_main toplevel_test ) + ignore (run_test_tt_main ms_string_format_test); + ignore (run_test_tt_main packet_rep_test); + ignore (run_test_tt_main toplevel_test) |