From 4110881448217abedf694c77003c07d76d9ebac0 Mon Sep 17 00:00:00 2001 From: art-w Date: Fri, 17 Jan 2025 14:34:06 +0100 Subject: [PATCH] Validate maintenance_intent (#11308) * Validate maintenance_intent Signed-off-by: ArthurW * Fix after review Signed-off-by: ArthurW --------- Signed-off-by: ArthurW --- doc/changes/11308.md | 1 + src/dune_config_file/dune_config_file.ml | 3 +- src/dune_lang/package_info.ml | 82 +++++- src/dune_lang/package_info.mli | 1 + .../test-cases/opam-maintenance-intent.t | 243 ++++++++++++++++++ 5 files changed, 326 insertions(+), 4 deletions(-) create mode 100644 doc/changes/11308.md create mode 100644 test/blackbox-tests/test-cases/opam-maintenance-intent.t diff --git a/doc/changes/11308.md b/doc/changes/11308.md new file mode 100644 index 00000000000..6098f0876fa --- /dev/null +++ b/doc/changes/11308.md @@ -0,0 +1 @@ +- Validate opam `maintenance_intent` (#11308, @art-w) diff --git a/src/dune_config_file/dune_config_file.ml b/src/dune_config_file/dune_config_file.ml index e5a349d0273..ff87f8f4a40 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 730fbd664c7..e54bd7580c2 100644 --- a/src/dune_lang/package_info.ml +++ b/src/dune_lang/package_info.ml @@ -109,6 +109,84 @@ let encode_fields ] ;; +let maintenance_intent_list = [ "any"; "latest"; "none" ] + +let rec pp_or_list () = function + | [] -> "" + | [ x ] -> x + | [ x; y ] -> sprintf "%S or %S" x y + | x :: xs -> sprintf "%S, %a" x pp_or_list xs +;; + +let valid_maintenance_intent = + let open Decoder in + map_validate (located string) ~f:(fun (loc, str) -> + let rec parse_part i = + if i >= String.length str + then if i > 0 then Error "version ends with a dot" else Error "empty version" + else ( + match str.[i] with + | '(' -> parse_token (i + 1) (i + 1) + | '.' -> Error "unexpected dot" + | _ -> inside_part (i + 1)) + and inside_part i = + if i >= String.length str + then Ok () + else ( + match str.[i] with + | '.' -> parse_part (i + 1) + | '(' | ')' -> Error "unexpected parenthesis" + | _ -> inside_part (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 maintenance_intent_list token + then after_token (i + 1) + else + Error + (sprintf + "unknown intent %S, expected %a" + token + pp_or_list + maintenance_intent_list) + | '-' -> + 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 (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 "unclosed parenthesis" + 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 + | '.' -> parse_part (i + 1) + | _ -> Error "missing dot after intent") + in + match parse_part 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 +210,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 bc951e6557f..cabdc2a8bbb 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 00000000000..2be376f896b --- /dev/null +++ b/test/blackbox-tests/test-cases/opam-maintenance-intent.t @@ -0,0 +1,243 @@ +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: + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "") + > EOF + $ dune build + File "dune-project", line 2, characters 20-22: + 2 | (maintenance_intent "") + ^^ + Error: empty version + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest") + > EOF + $ dune build + File "dune-project", line 2, characters 20-29: + 2 | (maintenance_intent "(latest") + ^^^^^^^^^ + Error: unclosed parenthesis + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent ").1") + > EOF + $ dune build + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent ".1") + > EOF + $ dune build + File "dune-project", line 2, characters 20-24: + 2 | (maintenance_intent ".1") + ^^^^ + Error: unexpected dot + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "1.2.") + > EOF + $ dune build + File "dune-project", line 2, characters 20-26: + 2 | (maintenance_intent "1.2.") + ^^^^^^ + Error: version ends with a dot + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "1.2(latest).3") + > EOF + $ dune build + File "dune-project", line 2, characters 20-35: + 2 | (maintenance_intent "1.2(latest).3") + ^^^^^^^^^^^^^^^ + Error: unexpected parenthesis + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(none-3)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-30: + 2 | (maintenance_intent "(none-3)") + ^^^^^^^^^^ + Error: substraction only allowed for "latest", not "none" + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(any-3)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-29: + 2 | (maintenance_intent "(any-3)") + ^^^^^^^^^ + Error: substraction only allowed for "latest", not "any" + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest)1") + > EOF + $ dune build + File "dune-project", line 2, characters 20-31: + 2 | (maintenance_intent "(latest)1") + ^^^^^^^^^^^ + Error: missing dot after intent + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-31: + 2 | (maintenance_intent "(latest-)") + ^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-0)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-32: + 2 | (maintenance_intent "(latest-0)") + ^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-00)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-33: + 2 | (maintenance_intent "(latest-00)") + ^^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest--1)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-33: + 2 | (maintenance_intent "(latest--1)") + ^^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-a)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-32: + 2 | (maintenance_intent "(latest-a)") + ^^^^^^^^^^^^ + Error: invalid substraction + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(latest-1") + > EOF + $ dune build + File "dune-project", line 2, characters 20-31: + 2 | (maintenance_intent "(latest-1") + ^^^^^^^^^^^ + Error: unclosed parenthesis + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "(lates)") + > EOF + $ dune build + File "dune-project", line 2, characters 20-29: + 2 | (maintenance_intent "(lates)") + ^^^^^^^^^ + Error: unknown intent "lates", expected "any", "latest" or "none" + [1] + + $ cat >dune-project < (lang dune 3.18) + > (maintenance_intent "1.2" "(latest)" "err)" "3.4") + > EOF + $ dune build + File "dune-project", line 2, characters 37-43: + 2 | (maintenance_intent "1.2" "(latest)" "err)" "3.4") + ^^^^^^ + Error: unexpected parenthesis + [1]