sid: sid_test: handle large ias correctly

In string format, the “identifier authority” is quirky: from 1 << 32 on
the spec requires that exactly 12 hex digits be printed.

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)