CBOR monotone: Major type 7 is short field encoded

reject noncanonical CTAP2 CBOR encodings
Indentation
2021-10-09 16:29:40 +02:00 · 2021-10-08 18:49:18 +02:00 · 2021-10-08 10:52:11 +02:00
5 changed files with 1061 additions and 191 deletions
--- a/cbor/CBOR.ml
+++ b/cbor/CBOR.ml
@ -6,10 +6,11 @@ module SE = EndianString.BigEndian_unsafe

 exception Error of string

-let (@@) f x = f x
-let (|>) x f = f x
-let list_iteri f l = let i = ref 0 in List.iter (fun x -> f !i x; incr i) l
+exception Noncanonical of string
+
 let fail fmt = ksprintf (fun s -> raise (Error s)) fmt
+let noncanonical fmt = ksprintf (fun s -> raise (Noncanonical s))
+    ("noncanonical CTAP2 CBOR: " ^^ fmt)

 module Encode = struct

@ -115,16 +116,22 @@ let int64_max_int = Int64.of_int max_int
  let two_min_int32 = 2 * Int32.to_int Int32.min_int

  let extract_number byte1 r =
+    let guard_min min n = if n < min
+      then noncanonical "non-compact number encoding: %d < %d" n min
+      else n
+    in
    match get_additional byte1 with
    | n when n < 24 -> n
-  | 24 -> get_byte r
-  | 25 -> get_n r 2 SE.get_uint16
+    | 24 -> guard_min 24 @@ get_byte r
+    | 25 -> guard_min 256 @@ get_n r 2 SE.get_uint16
    | 26 ->
-    let n = Int32.to_int @@ get_n r 4 SE.get_int32 in
+      let n = guard_min (256*256) @@ Int32.to_int @@ get_n r 4 SE.get_int32 in
      if n < 0 then n - two_min_int32 else n
    | 27 ->
      let n = get_n r 8 SE.get_int64 in
      if n > int64_max_int || n < 0L then fail "extract_number: %Lu" n;
+      if Int64.compare n 0x1_0000_0000L < 0
+      then noncanonical "non-compact number encoding: %Ld < %Ld" n 0x1_0000_0000L;
      Int64.to_int n
    | n -> fail "bad additional %d" n

@ -140,23 +147,57 @@ let get_float16 s i =
    in
    if half land 0x8000 = 0 then value else ~-. value

+  let monotonic s s' =
+    let major_typ s = int_of_char s.[0] lsr 5 in
+    let get_number s = match get_additional (int_of_char s.[0]) with
+      | n when n < 24 -> 1, Int64.of_int n
+      | 24 -> 2, Int64.of_int (int_of_char s.[1])
+      | 25 -> 3, Int64.of_int (SE.get_uint16 s 1)
+      | 26 -> 5, Int64.logand 0xFFFFFFFFL (Int64.of_int32 (SE.get_int32 s 1))
+      | 27 -> 9, SE.get_int64 s 1
+      | _ -> assert false
+    in
+    major_typ s < major_typ s' ||
+    major_typ s = major_typ s' &&
+    let off, n = get_number s and _, n' = get_number s' in
+    Int64.unsigned_compare n n' < 0 ||
+    Int64.unsigned_compare n n' = 0 &&
+    begin
+      List.mem (major_typ s) [2; 3; 4; 5] &&
+      let len = Int64.to_int n in
+      String.sub s off len < String.sub s' off len
+    end
+
  exception Break

  let extract_list byte1 r f =
    if is_indefinite byte1 then
-    let l = ref [] in
-    try while true do l := f r :: !l done; assert false with Break -> List.rev !l
+      noncanonical "indefinite length array or map"
    else
      let n = extract_number byte1 r in Array.to_list @@ Array.init n (fun _ -> f r)

-let rec extract_pair r =
+  let rec extract_pair ((s, i) as r) =
+    let start = !i in
    let a = extract r in
+    let finish = !i in
+    let raw = String.sub s start (finish - start) in
    let b = try extract r with Break -> fail "extract_pair: unexpected break" in
-  a,b
-and extract_string byte1 r f =
+    raw, (a,b)
+  and extract_map byte1 r =
+    let kvs = extract_list byte1 r extract_pair in
+    let _, kvs =
+      List.fold_right (fun (curr, kv) (next, acc) ->
+          match next with
+          | None -> (Some curr, kv :: acc)
+          | Some next ->
+            if not (monotonic curr next) then noncanonical "unsorted map";
+            (Some curr, kv :: acc))
+        kvs (None, [])
+    in
+    kvs
+  and extract_string byte1 r =
    if is_indefinite byte1 then
-    let b = Buffer.create 10 in
-    try while true do Buffer.add_string b (f @@ extract r) done; assert false with Break -> Buffer.contents b
+      noncanonical "indefinite length string"
    else
      let n = extract_number byte1 r in get_s r n
  and extract r =
@ -164,11 +205,11 @@ and extract r =
    match byte1 lsr 5 with
    | 0 -> `Int (extract_number byte1 r)
    | 1 -> `Int (-1 - extract_number byte1 r)
-  | 2 -> `Bytes (extract_string byte1 r (function `Bytes s -> s | _ -> fail "extract: not a bytes chunk"))
-  | 3 -> `Text (extract_string byte1 r (function `Text s -> s | _ -> fail "extract: not a text chunk"))
+    | 2 -> `Bytes (extract_string byte1 r)
+    | 3 -> `Text (extract_string byte1 r)
    | 4 -> `Array (extract_list byte1 r extract)
-  | 5 -> `Map (extract_list byte1 r extract_pair)
-  | 6 -> let _tag = extract_number byte1 r in extract r
+    | 5 -> `Map (extract_map byte1 r)
+    | 6 -> noncanonical "tagged value"
    | 7 ->
      begin match get_additional byte1 with
        | n when n < 20 -> `Simple n
@ -215,11 +256,11 @@ let to_diagnostic item =
      | `Text s -> bprintf b "\"%s\"" s
      | `Array l ->
        put "[";
-    l |> list_iteri (fun i x -> if i <> 0 then put ", "; write x);
+        l |> List.iteri (fun i x -> if i <> 0 then put ", "; write x);
        put "]"
      | `Map m ->
        put "{";
-    m |> list_iteri (fun i (k,v) -> if i <> 0 then put ", "; write k; put ": "; write v);
+        m |> List.iteri (fun i (k,v) -> if i <> 0 then put ", "; write k; put ": "; write v);
        put "}"
    in
    write item;
--- a/cbor/CBOR.mli
+++ b/cbor/CBOR.mli
@ -2,6 +2,8 @@

 exception Error of string

+exception Noncanonical of string
+
 module Simple : sig

 type t =
--- a/cbor/appendix_a.json
+++ b/cbor/appendix_a.json
@ -0,0 +1,720 @@
+[
+  {
+    "cbor": "AA==",
+    "hex": "00",
+    "roundtrip": true,
+    "decoded": 0
+  },
+  {
+    "cbor": "AQ==",
+    "hex": "01",
+    "roundtrip": true,
+    "decoded": 1
+  },
+  {
+    "cbor": "Cg==",
+    "hex": "0a",
+    "roundtrip": true,
+    "decoded": 10
+  },
+  {
+    "cbor": "Fw==",
+    "hex": "17",
+    "roundtrip": true,
+    "decoded": 23
+  },
+  {
+    "cbor": "GBg=",
+    "hex": "1818",
+    "roundtrip": true,
+    "decoded": 24
+  },
+  {
+    "cbor": "GBk=",
+    "hex": "1819",
+    "roundtrip": true,
+    "decoded": 25
+  },
+  {
+    "cbor": "GGQ=",
+    "hex": "1864",
+    "roundtrip": true,
+    "decoded": 100
+  },
+  {
+    "cbor": "GQPo",
+    "hex": "1903e8",
+    "roundtrip": true,
+    "decoded": 1000
+  },
+  {
+    "cbor": "GgAPQkA=",
+    "hex": "1a000f4240",
+    "roundtrip": true,
+    "decoded": 1000000
+  },
+  {
+    "cbor": "GwAAAOjUpRAA",
+    "hex": "1b000000e8d4a51000",
+    "roundtrip": true,
+    "decoded": 1000000000000
+  },
+  {
+    "cbor": "G///////////",
+    "hex": "1bffffffffffffffff",
+    "roundtrip": true,
+    "decoded": 18446744073709551615
+  },
+  {
+    "cbor": "wkkBAAAAAAAAAAA=",
+    "hex": "c249010000000000000000",
+    "roundtrip": true,
+    "noncanonical": true,
+    "decoded": 18446744073709551616
+  },
+  {
+    "cbor": "O///////////",
+    "hex": "3bffffffffffffffff",
+    "roundtrip": true,
+    "decoded": -18446744073709551616
+  },
+  {
+    "cbor": "w0kBAAAAAAAAAAA=",
+    "hex": "c349010000000000000000",
+    "roundtrip": true,
+    "noncanonical": true,
+    "decoded": -18446744073709551617
+  },
+  {
+    "cbor": "IA==",
+    "hex": "20",
+    "roundtrip": true,
+    "decoded": -1
+  },
+  {
+    "cbor": "KQ==",
+    "hex": "29",
+    "roundtrip": true,
+    "decoded": -10
+  },
+  {
+    "cbor": "OGM=",
+    "hex": "3863",
+    "roundtrip": true,
+    "decoded": -100
+  },
+  {
+    "cbor": "OQPn",
+    "hex": "3903e7",
+    "roundtrip": true,
+    "decoded": -1000
+  },
+  {
+    "cbor": "+QAA",
+    "hex": "f90000",
+    "roundtrip": true,
+    "decoded": 0.0
+  },
+  {
+    "cbor": "+YAA",
+    "hex": "f98000",
+    "roundtrip": true,
+    "decoded": -0.0
+  },
+  {
+    "cbor": "+TwA",
+    "hex": "f93c00",
+    "roundtrip": true,
+    "decoded": 1.0
+  },
+  {
+    "cbor": "+z/xmZmZmZma",
+    "hex": "fb3ff199999999999a",
+    "roundtrip": true,
+    "decoded": 1.1
+  },
+  {
+    "cbor": "+T4A",
+    "hex": "f93e00",
+    "roundtrip": true,
+    "decoded": 1.5
+  },
+  {
+    "cbor": "+Xv/",
+    "hex": "f97bff",
+    "roundtrip": true,
+    "decoded": 65504.0
+  },
+  {
+    "cbor": "+kfDUAA=",
+    "hex": "fa47c35000",
+    "roundtrip": true,
+    "decoded": 100000.0
+  },
+  {
+    "cbor": "+n9///8=",
+    "hex": "fa7f7fffff",
+    "roundtrip": true,
+    "decoded": 3.4028234663852886e+38
+  },
+  {
+    "cbor": "+3435DyIAHWc",
+    "hex": "fb7e37e43c8800759c",
+    "roundtrip": true,
+    "decoded": 1.0e+300
+  },
+  {
+    "cbor": "+QAB",
+    "hex": "f90001",
+    "roundtrip": true,
+    "decoded": 5.960464477539063e-08
+  },
+  {
+    "cbor": "+QQA",
+    "hex": "f90400",
+    "roundtrip": true,
+    "decoded": 6.103515625e-05
+  },
+  {
+    "cbor": "+cQA",
+    "hex": "f9c400",
+    "roundtrip": true,
+    "decoded": -4.0
+  },
+  {
+    "cbor": "+8AQZmZmZmZm",
+    "hex": "fbc010666666666666",
+    "roundtrip": true,
+    "decoded": -4.1
+  },
+  {
+    "cbor": "+XwA",
+    "hex": "f97c00",
+    "roundtrip": true,
+    "diagnostic": "Infinity"
+  },
+  {
+    "cbor": "+X4A",
+    "hex": "f97e00",
+    "roundtrip": true,
+    "diagnostic": "NaN"
+  },
+  {
+    "cbor": "+fwA",
+    "hex": "f9fc00",
+    "roundtrip": true,
+    "diagnostic": "-Infinity"
+  },
+  {
+    "cbor": "+n+AAAA=",
+    "hex": "fa7f800000",
+    "roundtrip": false,
+    "diagnostic": "Infinity"
+  },
+  {
+    "cbor": "+n/AAAA=",
+    "hex": "fa7fc00000",
+    "roundtrip": false,
+    "diagnostic": "NaN"
+  },
+  {
+    "cbor": "+v+AAAA=",
+    "hex": "faff800000",
+    "roundtrip": false,
+    "diagnostic": "-Infinity"
+  },
+  {
+    "cbor": "+3/wAAAAAAAA",
+    "hex": "fb7ff0000000000000",
+    "roundtrip": false,
+    "diagnostic": "Infinity"
+  },
+  {
+    "cbor": "+3/4AAAAAAAA",
+    "hex": "fb7ff8000000000000",
+    "roundtrip": false,
+    "diagnostic": "NaN"
+  },
+  {
+    "cbor": "+//wAAAAAAAA",
+    "hex": "fbfff0000000000000",
+    "roundtrip": false,
+    "diagnostic": "-Infinity"
+  },
+  {
+    "cbor": "9A==",
+    "hex": "f4",
+    "roundtrip": true,
+    "decoded": false
+  },
+  {
+    "cbor": "9Q==",
+    "hex": "f5",
+    "roundtrip": true,
+    "decoded": true
+  },
+  {
+    "cbor": "9g==",
+    "hex": "f6",
+    "roundtrip": true,
+    "decoded": null
+  },
+  {
+    "cbor": "9w==",
+    "hex": "f7",
+    "roundtrip": true,
+    "diagnostic": "undefined"
+  },
+  {
+    "cbor": "8A==",
+    "hex": "f0",
+    "roundtrip": true,
+    "diagnostic": "simple(16)"
+  },
+  {
+    "cbor": "+Bg=",
+    "hex": "f818",
+    "roundtrip": true,
+    "diagnostic": "simple(24)"
+  },
+  {
+    "cbor": "+P8=",
+    "hex": "f8ff",
+    "roundtrip": true,
+    "diagnostic": "simple(255)"
+  },
+  {
+    "cbor": "wHQyMDEzLTAzLTIxVDIwOjA0OjAwWg==",
+    "hex": "c074323031332d30332d32315432303a30343a30305a",
+    "roundtrip": true,
+    "noncanonical": true,
+    "diagnostic": "0(\"2013-03-21T20:04:00Z\")"
+  },
+  {
+    "cbor": "wRpRS2ew",
+    "hex": "c11a514b67b0",
+    "roundtrip": true,
+    "noncanonical": true,
+    "diagnostic": "1(1363896240)"
+  },
+  {
+    "cbor": "wftB1FLZ7CAAAA==",
+    "hex": "c1fb41d452d9ec200000",
+    "roundtrip": true,
+    "noncanonical": true,
+    "diagnostic": "1(1363896240.5)"
+  },
+  {
+    "cbor": "10QBAgME",
+    "hex": "d74401020304",
+    "roundtrip": true,
+    "noncanonical": true,
+    "diagnostic": "23(h'01020304')"
+  },
+  {
+    "cbor": "2BhFZElFVEY=",
+    "hex": "d818456449455446",
+    "roundtrip": true,
+    "noncanonical": true,
+    "diagnostic": "24(h'6449455446')"
+  },
+  {
+    "cbor": "2CB2aHR0cDovL3d3dy5leGFtcGxlLmNvbQ==",
+    "hex": "d82076687474703a2f2f7777772e6578616d706c652e636f6d",
+    "roundtrip": true,
+    "noncanonical": true,
+    "diagnostic": "32(\"http://www.example.com\")"
+  },
+  {
+    "cbor": "QA==",
+    "hex": "40",
+    "roundtrip": true,
+    "diagnostic": "h''"
+  },
+  {
+    "cbor": "RAECAwQ=",
+    "hex": "4401020304",
+    "roundtrip": true,
+    "diagnostic": "h'01020304'"
+  },
+  {
+    "cbor": "YA==",
+    "hex": "60",
+    "roundtrip": true,
+    "decoded": ""
+  },
+  {
+    "cbor": "YWE=",
+    "hex": "6161",
+    "roundtrip": true,
+    "decoded": "a"
+  },
+  {
+    "cbor": "ZElFVEY=",
+    "hex": "6449455446",
+    "roundtrip": true,
+    "decoded": "IETF"
+  },
+  {
+    "cbor": "YiJc",
+    "hex": "62225c",
+    "roundtrip": true,
+    "decoded": "\"\\"
+  },
+  {
+    "cbor": "YsO8",
+    "hex": "62c3bc",
+    "roundtrip": true,
+    "decoded": "ü"
+  },
+  {
+    "cbor": "Y+awtA==",
+    "hex": "63e6b0b4",
+    "roundtrip": true,
+    "decoded": "水"
+  },
+  {
+    "cbor": "ZPCQhZE=",
+    "hex": "64f0908591",
+    "roundtrip": true,
+    "decoded": "𐅑"
+  },
+  {
+    "cbor": "gA==",
+    "hex": "80",
+    "roundtrip": true,
+    "decoded": [
+
+    ]
+  },
+  {
+    "cbor": "gwECAw==",
+    "hex": "83010203",
+    "roundtrip": true,
+    "decoded": [
+      1,
+      2,
+      3
+    ]
+  },
+  {
+    "cbor": "gwGCAgOCBAU=",
+    "hex": "8301820203820405",
+    "roundtrip": true,
+    "decoded": [
+      1,
+      [
+        2,
+        3
+      ],
+      [
+        4,
+        5
+      ]
+    ]
+  },
+  {
+    "cbor": "mBkBAgMEBQYHCAkKCwwNDg8QERITFBUWFxgYGBk=",
+    "hex": "98190102030405060708090a0b0c0d0e0f101112131415161718181819",
+    "roundtrip": true,
+    "decoded": [
+      1,
+      2,
+      3,
+      4,
+      5,
+      6,
+      7,
+      8,
+      9,
+      10,
+      11,
+      12,
+      13,
+      14,
+      15,
+      16,
+      17,
+      18,
+      19,
+      20,
+      21,
+      22,
+      23,
+      24,
+      25
+    ]
+  },
+  {
+    "cbor": "oA==",
+    "hex": "a0",
+    "roundtrip": true,
+    "decoded": {
+    }
+  },
+  {
+    "cbor": "ogECAwQ=",
+    "hex": "a201020304",
+    "roundtrip": true,
+    "diagnostic": "{1: 2, 3: 4}"
+  },
+  {
+    "cbor": "omFhAWFiggID",
+    "hex": "a26161016162820203",
+    "roundtrip": true,
+    "decoded": {
+      "a": 1,
+      "b": [
+        2,
+        3
+      ]
+    }
+  },
+  {
+    "cbor": "gmFhoWFiYWM=",
+    "hex": "826161a161626163",
+    "roundtrip": true,
+    "decoded": [
+      "a",
+      {
+        "b": "c"
+      }
+    ]
+  },
+  {
+    "cbor": "pWFhYUFhYmFCYWNhQ2FkYURhZWFF",
+    "hex": "a56161614161626142616361436164614461656145",
+    "roundtrip": true,
+    "decoded": {
+      "a": "A",
+      "b": "B",
+      "c": "C",
+      "d": "D",
+      "e": "E"
+    }
+  },
+  {
+    "cbor": "X0IBAkMDBAX/",
+    "hex": "5f42010243030405ff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "diagnostic": "(_ h'0102', h'030405')"
+  },
+  {
+    "cbor": "f2VzdHJlYWRtaW5n/w==",
+    "hex": "7f657374726561646d696e67ff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": "streaming"
+  },
+  {
+    "cbor": "n/8=",
+    "hex": "9fff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": [
+
+    ]
+  },
+  {
+    "cbor": "nwGCAgOfBAX//w==",
+    "hex": "9f018202039f0405ffff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": [
+      1,
+      [
+        2,
+        3
+      ],
+      [
+        4,
+        5
+      ]
+    ]
+  },
+  {
+    "cbor": "nwGCAgOCBAX/",
+    "hex": "9f01820203820405ff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": [
+      1,
+      [
+        2,
+        3
+      ],
+      [
+        4,
+        5
+      ]
+    ]
+  },
+  {
+    "cbor": "gwGCAgOfBAX/",
+    "hex": "83018202039f0405ff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": [
+      1,
+      [
+        2,
+        3
+      ],
+      [
+        4,
+        5
+      ]
+    ]
+  },
+  {
+    "cbor": "gwGfAgP/ggQF",
+    "hex": "83019f0203ff820405",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": [
+      1,
+      [
+        2,
+        3
+      ],
+      [
+        4,
+        5
+      ]
+    ]
+  },
+  {
+    "cbor": "nwECAwQFBgcICQoLDA0ODxAREhMUFRYXGBgYGf8=",
+    "hex": "9f0102030405060708090a0b0c0d0e0f101112131415161718181819ff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": [
+      1,
+      2,
+      3,
+      4,
+      5,
+      6,
+      7,
+      8,
+      9,
+      10,
+      11,
+      12,
+      13,
+      14,
+      15,
+      16,
+      17,
+      18,
+      19,
+      20,
+      21,
+      22,
+      23,
+      24,
+      25
+    ]
+  },
+  {
+    "cbor": "v2FhAWFinwID//8=",
+    "hex": "bf61610161629f0203ffff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": {
+      "a": 1,
+      "b": [
+        2,
+        3
+      ]
+    }
+  },
+  {
+    "cbor": "gmFhv2FiYWP/",
+    "hex": "826161bf61626163ff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": [
+      "a",
+      {
+        "b": "c"
+      }
+    ]
+  },
+  {
+    "cbor": "v2NGdW71Y0FtdCH/",
+    "hex": "bf6346756ef563416d7421ff",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": {
+      "Fun": true,
+      "Amt": -2
+    }
+  },
+  {
+    "cbor": "pGJya/VidXD1ZHBsYXT0aWNsaWVudFBpbvU=",
+    "hex": "a462726bf5627570f564706c6174f469636c69656e7450696ef5",
+    "roundtrip": false,
+    "decoded": {
+      "rk": true,
+      "up": true,
+      "plat": false,
+      "clientPin": true
+    }
+  },
+  {
+    "cbor": "pGRwbGF09GJya/VpY2xpZW50UGlu9WJ1cPU=",
+    "hex": "a464706c6174f462726bf569636c69656e7450696ef5627570f5",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": {
+      "up": true,
+      "clientPin": true,
+      "rk": true,
+      "plat": false
+    }
+  },
+  {
+    "cbor": "GAE=",
+    "hex": "1801",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": 1
+  },
+  {
+    "cbor": "GQAB",
+    "hex": "190001",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": 1
+  },
+  {
+    "cbor": "GgAAAAE=",
+    "hex": "1a00000001",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": 1
+  },
+  {
+    "cbor": "GwAAAAAAAAAB",
+    "hex": "1b0000000000000001",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": 1
+  },
+  {
+    "cbor": "OAA=",
+    "hex": "3800",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": -1
+  },
+  {
+    "cbor": "OwAAAAAAAQRp",
+    "hex": "3B0000000000010469",
+    "roundtrip": false,
+    "noncanonical": true,
+    "decoded": -66666
+  }
+]
--- a/cbor/dune
+++ b/cbor/dune
@ -1,5 +1,16 @@
 (library
 (name cbor)
 (public_name webauthn.cbor)
+ (modules CBOR)
 (wrapped false)
 (libraries ocplib-endian))
+
+(executable
+  (name test)
+  (modules test)
+  (libraries webauthn.cbor yojson))
+
+(rule
+  (alias runtest)
+  (deps test.exe appendix_a.json)
+  (action (run ./test.exe appendix_a.json)))
--- a/cbor/test.ml
+++ b/cbor/test.ml
@ -0,0 +1,96 @@
+type result = Decoded of Yojson.Basic.t | Diagnostic of string
+
+type test = {
+  cbor : string;
+  result : result;
+  noncanonical : bool;
+}
+
+let (@@) f x = f x
+let (|>) x f = f x
+let eprintfn fmt = Printf.ksprintf prerr_endline fmt
+let fail fmt = Printf.ksprintf failwith fmt
+
+let of_hex s =
+  assert (String.length s mod 2 = 0);
+  let n = String.length s / 2 in
+  let r = Bytes.create n in
+  for i = 0 to pred n do
+    Bytes.set r i @@ Char.chr @@ int_of_string ("0x" ^ String.sub s (i*2) 2)
+  done;
+  Bytes.to_string r
+
+let read file =
+  let open Yojson.Basic in
+  Yojson.Safe.from_file file (* large ints *)
+  |> Yojson.Safe.to_basic
+  |> Util.to_list
+  |> List.map begin function
+    | `Assoc a ->
+      let cbor = of_hex @@ Util.to_string @@ List.assoc "hex" a in
+      let result =
+        try
+          Diagnostic (Util.to_string @@ List.assoc "diagnostic" a)
+        with Not_found -> 
+          Decoded (List.assoc "decoded" a)
+      in
+      let noncanonical = try
+          Util.to_bool @@ List.assoc "noncanonical" a
+        with Not_found -> false
+      in
+      { cbor; result; noncanonical }
+    | _ -> assert false
+    end
+
+let rec json_of_cbor : CBOR.Simple.t -> Yojson.Basic.t = function
+| (`Null | `Bool _ | `Int _ | `Float _ as x) -> x
+| `Undefined | `Simple _ -> `Null
+| `Bytes x -> `String x
+| `Text x -> `String x
+| `Array x -> `List (List.map json_of_cbor x)
+| `Map x -> `Assoc (List.map (fun (k,v) ->
+  match k with
+  | `Text s -> s, json_of_cbor v
+  | _ -> fail "json_of_cbor: expected string key") x)
+
+let () =
+  match List.tl @@ Array.to_list Sys.argv with
+  | file::[] ->
+    eprintfn "I: running tests from %s" file;
+    let tests = read file in
+    eprintfn "I: total tests = %d" (List.length tests);
+    let ok = ref 0 in
+    let failed = ref 0 in
+    let ignored = ref 0 in
+    let nr = ref (-1) in
+    tests |> List.iter begin fun test ->
+      try
+        incr nr;
+        if test.noncanonical then
+          try let cbor = CBOR.Simple.decode test.cbor in
+            fail "expected reject noncanonical CBOR, got %s"
+              (CBOR.Simple.to_diagnostic cbor)
+          with CBOR.Noncanonical _ -> incr ok
+        else
+          let cbor = CBOR.Simple.decode test.cbor in
+          let diag = CBOR.Simple.to_diagnostic cbor in
+          let () = match test.result with
+            | Diagnostic s ->
+              if s <> diag then fail "expected %s, got %s" s diag
+            | Decoded json ->
+              let json' = json_of_cbor cbor in
+              if json <> json' then fail "expected %s, got %s, aka %s"
+                  (Yojson.Basic.to_string json) (Yojson.Basic.to_string json') diag
+          in
+          incr ok
+      with exn ->
+        let ignore = List.mem !nr [10; 12] in
+        eprintfn "%s test %d: %s"
+          (if ignore then "W: ignoring" else "E:") !nr (match exn with Failure s -> s | _ -> Printexc.to_string exn);
+        incr (if ignore then ignored else failed)
+    end;
+    eprintfn "I: finished. tests ok = %d failed = %d ignored = %d" !ok !failed !ignored;
+    exit (if !failed = 0 then 0 else 1)
+  | _ ->
+    eprintfn "E: no test file given";
+    exit 2
Author	SHA1	Message	Date
Reynir Björnsson	3edd956493	CBOR monotone: Major type 7 is short field encoded	2021-10-09 16:29:40 +02:00
Reynir Björnsson	9e8f765703	reject noncanonical CTAP2 CBOR encodings	2021-10-08 18:49:18 +02:00
Reynir Björnsson	cb8a3bbb41	Indentation	2021-10-08 10:52:11 +02:00