From a78c24df831ffaee32a9afca5fe56f5b39e3160a Mon Sep 17 00:00:00 2001 From: ArthurW Date: Thu, 16 Jan 2025 11:44:16 +0100 Subject: [PATCH] Validate maintenance_intent --- src/dune_config_file/dune_config_file.ml | 3 +- src/dune_lang/package_info.ml | 68 ++++++- src/dune_lang/package_info.mli | 1 + .../test-cases/opam-maintenance-intent.t | 176 ++++++++++++++++++ 4 files changed, 244 insertions(+), 4 deletions(-) create mode 100644 test/blackbox-tests/test-cases/opam-maintenance-intent.t diff --git a/src/dune_config_file/dune_config_file.ml b/src/dune_config_file/dune_config_file.ml index e5a349d02735..ff87f8f4a40d 100644 --- a/src/dune_config_file/dune_config_file.ml +++ b/src/dune_config_file/dune_config_file.ml @@ -28,7 +28,8 @@ module Dune_config = struct fields (let+ authors = field_o "authors" (repeat string) and+ maintainers = field_o "maintainers" (repeat string) - and+ maintenance_intent = field_o "maintenance_intent" (repeat string) + and+ maintenance_intent = + field_o "maintenance_intent" Dune_lang.Package_info.decode_maintenance_intent and+ license = field_o "license" (repeat string) in { authors; maintainers; maintenance_intent; license }) ;; diff --git a/src/dune_lang/package_info.ml b/src/dune_lang/package_info.ml index 730fbd664c77..d48e1dba28bf 100644 --- a/src/dune_lang/package_info.ml +++ b/src/dune_lang/package_info.ml @@ -109,6 +109,70 @@ let encode_fields ] ;; +let valid_maintenance_intent = + let open Decoder in + map_validate (located string) ~f:(fun (loc, str) -> + let rec loop i = + if i >= String.length str + then Ok () + else ( + match str.[i] with + | '.' -> after_dot (i + 1) + | '(' | ')' -> Error "unexpected parenthesis" + | _ -> loop (i + 1)) + and after_dot i = + if i >= String.length str + then Error "version ends with a dot" + else ( + match str.[i] with + | '(' -> parse_token (i + 1) (i + 1) + | '.' -> Error "unexpected dot" + | _ -> loop (i + 1)) + and parse_token start i = + if i >= String.length str + then Error "unclosed parenthesis" + else ( + match str.[i] with + | ')' -> + let token = String.sub str ~pos:start ~len:(i - start) in + if List.mem ~equal:String.equal [ "any"; "latest"; "none" ] token + then after_token (i + 1) + else + Error (Printf.sprintf "unknown intent %S, expected any, latest or none" token) + | '-' -> + let token = String.sub str ~pos:start ~len:(i - start) in + if String.equal token "latest" + then parse_num (i + 1) (i + 1) + else Error (Printf.sprintf "substraction only allowed for latest, not %S" token) + | _ -> parse_token start (i + 1)) + and parse_num start i = + if i >= String.length str + then Error "" + else ( + match str.[i] with + | ')' when i > start -> after_token (i + 1) + | '0' when i > start -> parse_num start (i + 1) + | '0' -> parse_num (i + 1) (i + 1) + | '1' .. '9' -> parse_num start (i + 1) + | _ -> Error "invalid substraction") + and after_token i = + if i >= String.length str + then Ok () + else ( + match str.[i] with + | '.' -> after_dot (i + 1) + | _ -> Error "missing dot after intent") + in + match after_dot 0 with + | Ok () -> Ok str + | Error msg -> Error (User_error.make ~loc [ Pp.text msg ])) +;; + +let decode_maintenance_intent = + let open Decoder in + Syntax.since Stanza.syntax (3, 18) >>> repeat valid_maintenance_intent +;; + let decode ?since () = let open Decoder in let v default = Option.value since ~default in @@ -132,9 +196,7 @@ let decode ?since () = field_o "bug_reports" (Syntax.since Stanza.syntax (v (1, 10)) >>> string) and+ maintainers = field_o "maintainers" (Syntax.since Stanza.syntax (v (1, 10)) >>> repeat string) - and+ maintenance_intent = - field_o "maintenance_intent" (Syntax.since Stanza.syntax (v (3, 18)) >>> repeat string) - in + and+ maintenance_intent = field_o "maintenance_intent" decode_maintenance_intent in { source ; authors ; license diff --git a/src/dune_lang/package_info.mli b/src/dune_lang/package_info.mli index bc951e6557f8..cabdc2a8bbb5 100644 --- a/src/dune_lang/package_info.mli +++ b/src/dune_lang/package_info.mli @@ -25,6 +25,7 @@ val decode -> unit -> t Dune_sexp.Decoder.fields_parser +val decode_maintenance_intent : string list Dune_sexp.Decoder.t val superpose : t -> t -> t val create diff --git a/test/blackbox-tests/test-cases/opam-maintenance-intent.t b/test/blackbox-tests/test-cases/opam-maintenance-intent.t new file mode 100644 index 000000000000..2fe1419f0809 --- /dev/null +++ b/test/blackbox-tests/test-cases/opam-maintenance-intent.t @@ -0,0 +1,176 @@ +The `x-opam-maintenance` field allows a list of strings matching version +numbers, possibly using the special keywords (latest), (any) and (none): + + $ cat >dune-project < (lang dune 3.18) + > (generate_opam_files true) + > (package (name foo) (allow_empty)) + > (maintenance_intent + > "1.2.3" + > "(latest)" + > "(latest-1234567890)" + > "(latest-1).(none)" + > "(any).(latest).(none)" + > "1.(any).2.(none)" + > "3.14.(latest)") + > EOF + $ cat dune-project + (lang dune 3.18) + (generate_opam_files true) + (package (name foo) (allow_empty)) + (maintenance_intent + "1.2.3" + "(latest)" + "(latest-1234567890)" + "(latest-1).(none)" + "(any).(latest).(none)" + "1.(any).2.(none)" + "3.14.(latest)") + $ dune build foo.opam + $ cat foo.opam + # This file is generated by dune, edit dune-project instead + opam-version: "2.0" + depends: [ + "dune" {>= "3.18"} + "odoc" {with-doc} + ] + build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] + ] + x-maintenance-intent: [ + "1.2.3" + "(latest)" + "(latest-1234567890)" + "(latest-1).(none)" + "(any).(latest).(none)" + "1.(any).2.(none)" + "3.14.(latest)" + ] + +The following are all invalid maintenance intents: + + $ echo '(lang dune 3.18)\n(maintenance_intent "(latest")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-29: + 2 | (maintenance_intent "(latest") + ^^^^^^^^^ + Error: unclosed parenthesis + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent ").1")' >dune-project + $ dune build + + $ echo '(lang dune 3.18)\n(maintenance_intent ".1")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-24: + 2 | (maintenance_intent ".1") + ^^^^ + Error: unexpected dot + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "1.2.")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-26: + 2 | (maintenance_intent "1.2.") + ^^^^^^ + Error: version ends with a dot + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "1.2(latest).3")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-35: + 2 | (maintenance_intent "1.2(latest).3") + ^^^^^^^^^^^^^^^ + Error: unexpected parenthesis + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(none-3)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-30: + 2 | (maintenance_intent "(none-3)") + ^^^^^^^^^^ + Error: substraction only allowed for latest, not "none" + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(any-3)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-29: + 2 | (maintenance_intent "(any-3)") + ^^^^^^^^^ + Error: substraction only allowed for latest, not "any" + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(latest)1")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-31: + 2 | (maintenance_intent "(latest)1") + ^^^^^^^^^^^ + Error: missing dot after intent + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-31: + 2 | (maintenance_intent "(latest-)") + ^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-0)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-32: + 2 | (maintenance_intent "(latest-0)") + ^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-00)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-33: + 2 | (maintenance_intent "(latest-00)") + ^^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(latest--1)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-33: + 2 | (maintenance_intent "(latest--1)") + ^^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(latest-a)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-32: + 2 | (maintenance_intent "(latest-a)") + ^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "(lates)")' >dune-project + $ dune build + File "dune-project", line 2, characters 20-29: + 2 | (maintenance_intent "(lates)") + ^^^^^^^^^ + Error: unknown intent "lates", expected any, latest or none + [1] + + $ echo '(lang dune 3.18)\n(maintenance_intent "1.2" "(latest)" "err)" "3.4")' >dune-project + $ dune build + File "dune-project", line 2, characters 37-43: + 2 | (maintenance_intent "1.2" "(latest)" "err)" "3.4") + ^^^^^^ + Error: unexpected parenthesis + [1]