From 9e8f7657033911deae96de7450dbc21d3c437aca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 8 Oct 2021 18:49:18 +0200 Subject: [PATCH] reject noncanonical CTAP2 CBOR encodings --- cbor/CBOR.ml | 79 +++-- cbor/CBOR.mli | 2 + cbor/appendix_a.json | 720 +++++++++++++++++++++++++++++++++++++++++++ cbor/dune | 11 + cbor/test.ml | 96 ++++++ 5 files changed, 889 insertions(+), 19 deletions(-) create mode 100644 cbor/appendix_a.json create mode 100644 cbor/test.ml diff --git a/cbor/CBOR.ml b/cbor/CBOR.ml index c882466..77345bf 100644 --- 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 @@ module Simple = struct 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 @@ module Simple = struct 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; 7 (* XXX: unsure about 7 *)] && + 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 @@ module Simple = struct 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 @@ module Simple = struct | `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; diff --git a/cbor/CBOR.mli b/cbor/CBOR.mli index 4e8f789..9a34d1c 100644 --- 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 = diff --git a/cbor/appendix_a.json b/cbor/appendix_a.json new file mode 100644 index 0000000..a8c802d --- /dev/null +++ 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 + } +] diff --git a/cbor/dune b/cbor/dune index e16f80f..c92df54 100644 --- 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))) diff --git a/cbor/test.ml b/cbor/test.ml new file mode 100644 index 0000000..afc9945 --- /dev/null +++ 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