diff options
| -rw-r--r-- | sid.ml | 78 | ||||
| -rw-r--r-- | sid_test.ml | 152 | ||||
| -rw-r--r-- | xxd.ml | 6 |
3 files changed, 197 insertions, 39 deletions
@@ -55,6 +55,11 @@ module StringFmt = struct let is_digit c = '0' <= c && c <= '9' + let is_xdigit c = + '0' <= c && c <= '9' + || 'a' <= c && c <= 'f' + || 'A' <= c && c <= 'F' + let read_decimal_string f s p = let n = String.length s in assert (p < n); @@ -76,6 +81,56 @@ module StringFmt = struct 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; + p + ident_auth_hexlen, + U64.of_string (Bytes.unsafe_to_string b) + + let ident_auth_decimal s p = + let p, ia = read_decimal_u64 s p in + if ia >= ident_auth_hexmin then + raise + (Invalid_argument + (Printf.sprintf + "input malformed: identifier authority from 2³² on must \ + be hex-encoded (value=%s)" + (U64.to_string ia))) else + p, ia + + let read_ident_auth s p = + let r = String.length s - p in + if r < ident_auth_hexlen then ident_auth_decimal s p else (* hex can’t fit *) + match s.[p], s.[p+1] with + | '0', 'x' -> + (let p, ia = read_ident_auth_hex s p in + if ia < ident_auth_hexmin 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 + p, ia) + | _ -> ident_auth_decimal s p + (* * The spec ([MS-DTYP]): * @@ -94,7 +149,7 @@ module StringFmt = struct expect_char s '1' 2; expect_char s '-' 3; let p = 4 in - let p, ia = read_decimal_u64 s p in + let p, ia = read_ident_auth s p in if ia > max_ident_auth then raise (Invalid_argument (Printf.sprintf @@ -122,8 +177,19 @@ module StringFmt = struct with Invalid_argument e -> Error e; end + let ident_auth_blank = "0x000000000000" + let fmt_ident_auth b ia = - Buffer.add_string b (U64.to_string ia) + if U64.compare ia ident_auth_hexmin < 0 then + Buffer.add_string b (U64.to_string ia) + else begin + let iax = U64.to_string_hex ia in + let niax = String.length iax in + let pad = ident_auth_hexlen - 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))) + end let fmt_sub_auths b sas = Array.iter @@ -201,13 +267,7 @@ module PacketRep = struct (* [MS-DTYP] 2.4.22 *) "input malformed: up to %d subAuthority elements permitted, \ %d specified" max_subauth_count nsa) else - let getbyte n ia = (* b[n] << (5 - (n - 2)) *) - U64.logor ia - (U64.shift_left (Bytes.get b n |> int_of_char |> U64.of_int) (5 - (n - 2))) - in - let ia = U64.zero - |> getbyte 2 |> getbyte 3 |> getbyte 4 - |> getbyte 5 |> getbyte 6 |> getbyte 7 in + let ia = U64.of_bytes_big_endian b 0 |> U64.logand max_ident_auth in let sas = Array.make nsa (U32.zero) and read_u32 = match endian with diff --git a/sid_test.ml b/sid_test.ml index 9b61b40..e7b6c24 100644 --- a/sid_test.ml +++ b/sid_test.ml @@ -5,6 +5,8 @@ open OUnit module U64 = Stdint.Uint64 module U32 = Stdint.Uint32 +let max_ident_auth = U64.of_string "0x0000_ffff_ffff_ffff" + (* let () = Printexc.record_backtrace true ;; *) @@ -37,8 +39,6 @@ let create_etoomany_fail () = | None -> () | Some s -> assert_failure ("Sid.create succeeded on invalid sa array") -let max_ident_auth = U64.of_string "0x0000_ffff_ffff_ffff" - let create_iatoobig_fail () = let sas = Array.make 2 U32.one in let ia = U64.add max_ident_auth U64.one in @@ -104,12 +104,19 @@ let sf_parse_trailing_ok () = assert_equal (Sid.to_string s) "S-1-0-0" let sf_parse_maxint_ok () = - let s = unwrap_of_string - (Printf.sprintf "S-1-281474976710655-%s-%s" + let s1 = unwrap_of_string + (Printf.sprintf "S-1-%s-%s-%s" + (U32.to_string U32.max_int) + (U32.to_string U32.max_int) + (U32.to_string U32.max_int)) + and s2 = unwrap_of_string + (Printf.sprintf "S-1-%s-%s-%s" + (U64.to_string_hex max_ident_auth) (U32.to_string U32.max_int) (U32.to_string U32.max_int)) in - assert_equal (Sid.to_string s) "S-1-281474976710655-4294967295-4294967295" + assert_equal (Sid.to_string s1) "S-1-4294967295-4294967295-4294967295"; + assert_equal (Sid.to_string s2) "S-1-0xffffffffffff-4294967295-4294967295" let sf_parse_oobia_fail () = match Sid.of_string @@ -117,8 +124,8 @@ let sf_parse_oobia_fail () = with | Ok _ -> assert_failure "unexpectedly parsed the out of bounds subauth" | Error e -> - assert_equal e "Invalid SID: identifier authority cannot fit 6 B \ - (281474976710655)" + assert_equal e "input malformed: identifier authority from 2³² on must \ + be hex-encoded (value=18446744073709551615)" let sf_parse_oobsa_fail () = match Sid.of_string @@ -148,11 +155,96 @@ let sf_parse_too_long_ok () = (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string s2) (Sid.to_string l)) (Sid.equal s2 l) +let sf_parse_iaxx_ok () = + (* ias > UINT32_MAX → hexdigits; proof that MS are a bunch of weirdos *) + let result = unwrap_of_string "S-1-0x0070c51cf00d-13-37" + and expect = + match Xxd.bytes_of "0102 0070 c51c f00d 0d00 0000 2500 0000" + (* vvcc iiii iiii iiii ssss ssss *) + |> Sid.PacketRep.decode + with + | Ok s -> s + | Error e -> assert_failure (Printf.sprintf "error decoding SID: %s" e) + in + assert_bool + (Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string result) (Sid.to_string expect)) + (Sid.equal result expect) + +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)" + in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +let sf_parse_iaxxinval_fail () = + (* ias <= UINT32_MAX → decimal; hex not allowed *) + match Sid.of_string "S-1-0xEA75BADB10OD-17-01" with + | Error e -> + let expect = "Invalid SID [S-1-0xEA75BADB10OD-17-01]: expected \ + hexadecimal digit at position 16 while parsing ident \ + auth, got ‘O’" + in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +let sf_parse_iaxxshort_fail () = + (* too few digits, need exactly 12 *) + match Sid.of_string "S-1-0xdeadbeef-17-01" with + | Error e -> + let expect = "Invalid SID [S-1-0xdeadbeef-17-01]: expected \ + hexadecimal digit at position 14 while parsing ident \ + auth, got ‘-’" + in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +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 [S-1-0xC01DC01DB100D-17-01]: expected ‘-’ \ + at position 18, found ‘D’" + in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" e expect) + e expect + | Ok s -> + assert_failure + (Printf.sprintf "malformed SID decoded unexpectedly: %s" + (Sid.to_string s)) + +let sf_print_iaxx_ok () = + (* hex ia must be padded to 12 digits *) + let str = "S-1-0x0070c51cf00d-13-37" in + let sid = unwrap_of_string str in + assert_equal + ~msg:(Printf.sprintf "[%s] ≠ [%s]" (Sid.to_string sid) str) + (Sid.to_string sid) str + let pr_encode_null_ok () = let x = Sid.WellKnown.null |> Sid.PacketRep.encode - |> Xxd.xxd_of_bytes ~blocklen:2 + |> Xxd.of_bytes ~blocklen:2 in let expect = "0101 0000 0000 0000 0000 0000" in (* vvcc iiii iiii iiii ssss ssss *) @@ -164,10 +256,10 @@ let pr_encode_be_ok () = let sid = "S-1-0-42" in let sle = unwrap_of_string sid |> Sid.PacketRep.encode - |> Xxd.xxd_of_bytes ~blocklen:2 + |> Xxd.of_bytes ~blocklen:2 and sbe = unwrap_of_string sid - |> Sid.PacketRep.encode ~endian:Big - |> Xxd.xxd_of_bytes ~blocklen:2 + |> Sid.PacketRep.encode ~endian:Sid.PacketRep.Big + |> Xxd.of_bytes ~blocklen:2 in let expect_le = "0101 0000 0000 0000 2a00 0000" and expect_be = "0101 0000 0000 0000 0000 002a" in @@ -183,7 +275,7 @@ let pr_encode_all_ok () = let x = Sid.WellKnown.everyone |> Sid.PacketRep.encode - |> Xxd.xxd_of_bytes ~blocklen:2 + |> Xxd.of_bytes ~blocklen:2 in let expect = "0101 0000 0000 0001 0000 0000" in (* vvcc iiii iiii iiii ssss ssss *) @@ -194,8 +286,8 @@ let pr_encode_all_ok () = let pr_decode_all_ok () = let s = match - Xxd.bytes_of_xxd "0101 0000 0000 0001 0000 0000" - (* vvcc iiii iiii iiii ssss ssss *) + Xxd.bytes_of "0101 0000 0000 0001 0000 0000" + (* vvcc iiii iiii iiii ssss ssss *) |> Sid.PacketRep.decode with | Ok s -> s @@ -212,7 +304,7 @@ let pr_decode_all_ok () = let pr_decode_be_ok () = let sid = unwrap_of_string "S-1-1-1-2-3-4-5-6-7-8-9-10-11-12-13-14-15" and sle = - match Xxd.bytes_of_xxd + match Xxd.bytes_of "010f 0000 0000 0001 \ 0100 0000 0200 0000 0300 0000 0400 0000 \ 0500 0000 0600 0000 0700 0000 0800 0000 \ @@ -225,13 +317,13 @@ let pr_decode_be_ok () = assert_failure (Printf.sprintf "error decoding SID: %s" e) and sbe = - match Xxd.bytes_of_xxd + match Xxd.bytes_of "010f 0000 0000 0001 \ 0000 0001 0000 0002 0000 0003 0000 0004 \ 0000 0005 0000 0006 0000 0007 0000 0008 \ 0000 0009 0000 000a 0000 000b 0000 000c \ 0000 000d 0000 000e 0000 000f" - |> Sid.PacketRep.decode ~endian:Big + |> Sid.PacketRep.decode ~endian:Sid.PacketRep.Big with | Ok s -> s | Error e -> @@ -246,8 +338,8 @@ let pr_decode_be_ok () = (Sid.equal sid sbe) let pr_decode_version_fail () = - let b = Xxd.bytes_of_xxd "0201 0000 0000 0001 0000 0000" in - (* vvcc iiii iiii iiii ssss ssss *) + let b = Xxd.bytes_of "0201 0000 0000 0001 0000 0000" in + (* vvcc iiii iiii iiii ssss ssss *) match Sid.PacketRep.decode b with | Error e -> let expect = "input malformed: expected SID version=0x01, got 0x02" in @@ -260,8 +352,8 @@ let pr_decode_version_fail () = (Sid.to_string s)) let pr_decode_sacount_fail () = - let b = Xxd.bytes_of_xxd "0110 0000 0000 0001 0000 0000" in - (* vvcc iiii iiii iiii ssss ssss *) + let b = Xxd.bytes_of "0110 0000 0000 0001 0000 0000" in + (* vvcc iiii iiii iiii ssss ssss *) match Sid.PacketRep.decode b with | Error e -> let expect = "input malformed: up to 15 subAuthority elements \ @@ -275,8 +367,8 @@ let pr_decode_sacount_fail () = (Sid.to_string s)) let pr_decode_short_fail () = - let b = Xxd.bytes_of_xxd "0105 0000 0000 00" in - (* vvcc iiii iiii ii…… *) + let b = Xxd.bytes_of "0105 0000 0000 00" in + (* vvcc iiii iiii ii…… *) match Sid.PacketRep.decode b with | Error e -> let expect = "bad input size: expected 8–68 B, got 7 B" in @@ -296,7 +388,7 @@ let pr_decode_long_fail () = 0b00 0000 0c00 0000 0d00 0000 0e00 0000 \ 0f00 0000 1000 0000" in - let b = Xxd.bytes_of_xxd r in + let b = Xxd.bytes_of r in match Sid.PacketRep.decode b with | Error e -> let expect = "bad input size: expected 8–68 B, got 72 B" in @@ -310,9 +402,9 @@ let pr_decode_long_fail () = let pr_decode_odd_fail () = match - Xxd.bytes_of_xxd "0101 0000 0000 0000 0100 0000 0200" - (* vvcc iiii iiii iiii ssss ssss ssss … - upper half word missing *) + Xxd.bytes_of "0101 0000 0000 0000 0100 0000 0200" + (* vvcc iiii iiii iiii ssss ssss ssss … + upper half word missing *) |> Sid.PacketRep.decode with | Error e -> @@ -339,6 +431,12 @@ let string_format_test = "string-format-syntax" >::: ; "parse-oobsa-fail" >:: sf_parse_oobsa_fail ; "parse-long-ok" >:: sf_parse_long_ok ; "parse-too-long-ok" >:: sf_parse_too_long_ok + ; "parse-iaxx-ok" >:: sf_parse_iaxx_ok + ; "parse-iaxxoob-fail" >:: sf_parse_iaxxoob_fail + ; "parse-iaxxinval-fail" >:: sf_parse_iaxxinval_fail + ; "parse-iaxxshort-fail" >:: sf_parse_iaxxshort_fail + ; "parse-iaxxlong-fail" >:: sf_parse_iaxxlong_fail + ; "print-iaxx-ok" >:: sf_print_iaxx_ok ] let packet_rep_test = "packet-rep" >::: @@ -55,7 +55,7 @@ let every n i = i > 0 && i mod n = 0 (* result length can be calculated in advance so we can do this without realloc() *) -let xxd_of_bytes ?(blocklen=0) src = +let of_bytes ?(blocklen=0) src = let ls = Bytes.length src in if ls = 0 then "" else let ld = 2 * ls + if blocklen = 0 then 0 else (ls - 1) / blocklen in @@ -85,7 +85,7 @@ let int_of_nibble c = if 'A' <= c && c <= 'F' then Some (int_of_char c - base_upper ) else None -let bytes_of_xxd src = +let bytes_of src = let ls = String.length src in if ls = 0 then Bytes.empty else let buf = Buffer.create bufsiz in @@ -93,7 +93,7 @@ let bytes_of_xxd src = if is = ls then if hi = None then (Buffer.contents buf |> (!!)) else raise (Invalid_argument - "bytes_of_xxd: odd number of hex digits in input") + "Xxd.bytes_of: odd number of hex digits in input") else match String.get src is |> int_of_nibble with | None -> aux hi (is+1) |