From f3b0b0b00a618c8ef17ba12164d4c59d61670a37 Mon Sep 17 00:00:00 2001 From: Milo Davis Date: Fri, 30 Mar 2018 22:58:11 -0400 Subject: [PATCH] Micheline: add 255 character annotation length limit --- src/bin_client/test/test_contracts.sh | 4 ++++ src/lib_micheline/micheline.ml | 9 +++++---- src/lib_micheline/micheline_parser.ml | 28 ++++++++++++++++++++++---- src/lib_micheline/micheline_parser.mli | 3 +++ 4 files changed, 36 insertions(+), 8 deletions(-) diff --git a/src/bin_client/test/test_contracts.sh b/src/bin_client/test/test_contracts.sh index e42e84cba..5877954ba 100755 --- a/src/bin_client/test/test_contracts.sh +++ b/src/bin_client/test/test_contracts.sh @@ -438,6 +438,10 @@ bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 True) assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 False)' bake_after $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 False)' assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 True)' +assert_fails $client typecheck data '3' against type \ + '(int @aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)' +$client typecheck data '3' against type \ + '(int @aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa)' init_with_transfer $contract_dir/big_map_get_add.tz $key1\ '(Pair { Elt 0 1 ; Elt 1 2 ; Elt 2 3 } Unit)' \ diff --git a/src/lib_micheline/micheline.ml b/src/lib_micheline/micheline.ml index ab0b28453..2396e9cd2 100644 --- a/src/lib_micheline/micheline.ml +++ b/src/lib_micheline/micheline.ml @@ -131,11 +131,12 @@ let canonical_encoding ~variant prim_encoding = case tag (list expr_encoding) (function Seq (_, v, _annot) -> Some v | _ -> None) (fun args -> Seq (0, args, None)) in + let byte_string = Bounded.string 255 in let application_encoding tag expr_encoding = case tag (obj3 (req "prim" prim_encoding) (req "args" (list expr_encoding)) - (opt "annot" string)) + (opt "annot" byte_string)) (function Prim (_, prim, args, annot) -> Some (prim, args, annot) | _ -> None) (fun (prim, args, annot) -> Prim (0, prim, args, annot)) in @@ -161,7 +162,7 @@ let canonical_encoding ~variant prim_encoding = (* No args, with annot *) case (Tag 4) (obj2 (req "prim" prim_encoding) - (req "annot" string)) + (req "annot" byte_string)) (function | Prim (_, v, [], Some annot) -> Some (v, annot) | _ -> None) @@ -178,7 +179,7 @@ let canonical_encoding ~variant prim_encoding = case (Tag 6) (obj3 (req "prim" prim_encoding) (req "arg" expr_encoding) - (req "annot" string)) + (req "annot" byte_string)) (function | Prim (_, prim, [ arg ], Some annot) -> Some (prim, arg, annot) | _ -> None) @@ -197,7 +198,7 @@ let canonical_encoding ~variant prim_encoding = (obj4 (req "prim" prim_encoding) (req "arg1" expr_encoding) (req "arg2" expr_encoding) - (req "annot" string)) + (req "annot" byte_string)) (function | Prim (_, prim, [ arg1 ; arg2 ], Some annot) -> Some (prim, arg1, arg2, annot) | _ -> None) diff --git a/src/lib_micheline/micheline_parser.ml b/src/lib_micheline/micheline_parser.ml index 6000af44a..31f8bb158 100644 --- a/src/lib_micheline/micheline_parser.ml +++ b/src/lib_micheline/micheline_parser.ml @@ -95,6 +95,8 @@ type token = { token : token_value ; loc : location } +let max_annot_length = 255 + type error += Invalid_utf8_sequence of point * string type error += Unexpected_character of point * string type error += Undefined_escape_sequence of point * string @@ -102,6 +104,7 @@ type error += Missing_break_after_number of point type error += Unterminated_string of location type error += Unterminated_integer of location type error += Unterminated_comment of location +type error += Annotation_length of location let tokenize source = let decoder = Uutf.decoder ~encoding:`UTF_8 (`String source) in @@ -139,8 +142,13 @@ let tokenize source = | `End, _ -> List.rev acc | `Uchar c, start -> begin match uchar_to_char c with - | Some ('a'..'z' | 'A'..'Z') -> ident acc start (fun s -> Ident s) - | Some '@' -> ident acc start (fun s -> Annot s) + | Some ('a'..'z' | 'A'..'Z') -> ident acc start (fun s _ -> Ident s) + | Some '@' -> + ident acc start + (fun str stop -> + if String.length str > max_annot_length + then errors := (Annotation_length { start ; stop }) :: !errors ; + Annot str) | Some '-' -> begin match next () with | `End, stop -> @@ -273,11 +281,11 @@ let tokenize source = let byte = Uutf.decoder_byte_count decoder in let s = String.sub source stop.byte (byte - stop.byte) in string acc (s :: sacc) start - and ident acc start ret = + and ident acc start (ret : string -> point -> token_value) = let tok stop = let name = String.sub source start.byte (stop.byte - start.byte) in - tok start stop (ret name) in + tok start stop (ret name stop) in match next () with | (`Uchar c, stop) as charloc -> begin match uchar_to_char c with @@ -722,6 +730,18 @@ let () = Data_encoding.(obj1 (req "location" location_encoding)) (function Unterminated_comment loc -> Some loc | _ -> None) (fun loc -> Unterminated_comment loc) ; + register_error_kind `Permanent + ~id: "micheline.parse_error.annotation_exceeds_max_length" + ~title: "Micheline parser error: annotation exceeds max length" + ~description: (Format.sprintf + "While parsing a piece of Micheline source, \ + an annotation exceeded the maximum length (%d)." max_annot_length) + ~pp:(fun ppf loc -> Format.fprintf ppf "%a, annotation exceeded maximum length (%d chars)" + print_location + loc max_annot_length) + Data_encoding.(obj1 (req "location" location_encoding)) + (function Annotation_length loc -> Some loc | _ -> None) + (fun loc -> Annotation_length loc) ; register_error_kind `Permanent ~id: "micheline.parse_error.unclosed_token" ~title: "Micheline parser error: unclosed token" diff --git a/src/lib_micheline/micheline_parser.mli b/src/lib_micheline/micheline_parser.mli index 18f274f8e..4e30e9a3d 100644 --- a/src/lib_micheline/micheline_parser.mli +++ b/src/lib_micheline/micheline_parser.mli @@ -56,6 +56,8 @@ val min_point : node list -> point (** End of a sequence of consecutive primitives *) val max_point : node list -> point +val max_annot_length : int + val node_encoding : node Data_encoding.encoding type error += Invalid_utf8_sequence of point * string @@ -70,6 +72,7 @@ type error += Unexpected of token type error += Extra of token type error += Misaligned of node type error += Empty +type error += Annotation_length of location val parse_toplevel : ?check:bool -> token list -> node list parsing_result