summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--sid.ml78
-rw-r--r--sid_test.ml152
-rw-r--r--xxd.ml6
3 files changed, 197 insertions, 39 deletions
diff --git a/sid.ml b/sid.ml
index 38c97f2..a696237 100644
--- a/sid.ml
+++ b/sid.ml
@@ -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" >:::
diff --git a/xxd.ml b/xxd.ml
index 50e0072..bafc17d 100644
--- a/xxd.ml
+++ b/xxd.ml
@@ -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)