From 78717badf47fe53e8af810345c771a2caa12d5ec Mon Sep 17 00:00:00 2001 From: Etienne Millon Date: Fri, 4 Aug 2023 14:52:54 +0200 Subject: [PATCH] fix(init): parse --public as a package name Fixes #7108 Signed-off-by: Etienne Millon --- bin/dune_init.ml | 72 +++++++++++++++++-- bin/dune_init.mli | 10 ++- bin/init.ml | 16 +++-- init-public-name.md | 1 + src/dune_lang/package_name.ml | 67 ++++++++--------- src/dune_lang/package_name.mli | 2 + .../test-cases/dune-init/github7108.t | 8 +-- .../dune-init/public-implicit-invalid.t | 9 +++ .../test-cases/dune-init/public-sublibrary.t | 8 +-- test/blackbox-tests/test-cases/github3046.t | 13 ++-- 10 files changed, 142 insertions(+), 64 deletions(-) create mode 100644 init-public-name.md create mode 100644 test/blackbox-tests/test-cases/dune-init/public-implicit-invalid.t diff --git a/bin/dune_init.ml b/bin/dune_init.ml index 945925ad4c11..1621e04ad8f9 100644 --- a/bin/dune_init.ml +++ b/bin/dune_init.ml @@ -195,6 +195,64 @@ module Init_context = struct ;; end +module Public_name = struct + module Pkg = Dune_lang.Package_name.Opam_compatible + + module T = struct + type t = + { pkg : Pkg.t + ; sub : string list + } + + let module_ = "Dune_init.Public_name" + let description = "public name" + + let description_of_valid_string = + let open Pp.O in + Some + (Pp.text + "Public names are composed of an opam package name and optional dot-separated \ + string suffixes." + ++ Pp.newline + ++ Pkg.description_of_valid_string) + ;; + + let split s = + match String.split s ~on:'.' with + | [] -> assert false + | pkg_s :: sub -> pkg_s, sub + ;; + + let join pkg_s sub = String.concat ~sep:"." (pkg_s :: sub) + + let make_valid s = + let pkg_s, sub = split s in + let pkg_fixed = Pkg.make_valid pkg_s in + join pkg_fixed sub + ;; + + let hint_valid = Some make_valid + + let of_string_opt s = + let open Option.O in + let pkg_s, sub = split s in + let+ pkg = Pkg.of_string_opt pkg_s in + { pkg; sub } + ;; + + let to_string { pkg; sub } = join (Pkg.to_string pkg) sub + end + + include T + include Dune_util.Stringlike.Make (T) + + let of_name_exn name = + let s = Dune_lang.Atom.to_string name in + let pkg = Pkg.of_string_user_error (Loc.none, s) |> User_error.ok_exn in + { pkg; sub = [] } + ;; +end + module Component = struct module Options = struct module Common = struct @@ -206,12 +264,12 @@ module Component = struct end module Executable = struct - type t = { public : Dune_lang.Atom.t option } + type t = { public : Public_name.t option } end module Library = struct type t = - { public : Dune_lang.Atom.t option + { public : Public_name.t option ; inline_tests : bool } end @@ -308,8 +366,7 @@ module Component = struct if List.mem ~equal:Dune_lang.Atom.equal set elem then set else elem :: set ;; - let public_name_encoder atom = Atom atom - let public_name_field = Encoder.field_o "public_name" public_name_encoder + let public_name_field = Encoder.field_o "public_name" Public_name.encode let executable (common : Options.Common.t) (options : Options.Executable.t) = make "executable" common [ public_name_field options.public ] @@ -438,7 +495,7 @@ module Component = struct let libraries = Stanza_cst.add_to_list_set common.name common.libraries in bin { context = { context with dir = Path.relative dir "bin" } - ; options = { public = Some common.name } + ; options = { public = Some (Public_name.of_name_exn common.name) } ; common = { common with libraries; name = Dune_lang.Atom.of_string "main" } } in @@ -449,7 +506,10 @@ module Component = struct let lib_target = src { context = { context with dir = Path.relative dir "lib" } - ; options = { public = Some common.name; inline_tests = options.inline_tests } + ; options = + { public = Some (Public_name.of_name_exn common.name) + ; inline_tests = options.inline_tests + } ; common } in diff --git a/bin/dune_init.mli b/bin/dune_init.mli index 1d959e513727..b69826b6411a 100644 --- a/bin/dune_init.mli +++ b/bin/dune_init.mli @@ -12,6 +12,12 @@ module Init_context : sig val make : string option -> t Memo.t end +module Public_name : sig + include Dune_util.Stringlike + + val of_name_exn : Dune_lang.Atom.t -> t +end + (** A [Component.t] is a set of files that can be built or included as part of a build. *) module Component : sig @@ -28,13 +34,13 @@ module Component : sig (** Options for executable components *) module Executable : sig - type t = { public : Dune_lang.Atom.t option } + type t = { public : Public_name.t option } end (** Options for library components *) module Library : sig type t = - { public : Dune_lang.Atom.t option + { public : Public_name.t option ; inline_tests : bool } end diff --git a/bin/init.ml b/bin/init.ml index e9b1c943b012..d843fe107d0b 100644 --- a/bin/init.ml +++ b/bin/init.ml @@ -79,23 +79,27 @@ let context_cwd : Init_context.t Term.t = module Public_name = struct type t = | Use_name - | Public_name of Dune_lang.Atom.t + | Public_name of Public_name.t let public_name_to_string = function | Use_name -> "" - | Public_name p -> Dune_lang.Atom.to_string p + | Public_name p -> Public_name.to_string p ;; let public_name (common : Component.Options.Common.t) = function | None -> None - | Some Use_name -> Some common.name + | Some Use_name -> Some (Public_name.of_name_exn common.name) | Some (Public_name n) -> Some n ;; let conv = - let parser = function - | "" -> Ok Use_name - | s -> component_name_parser s |> Result.map ~f:(fun a -> Public_name a) + let parser s = + if String.is_empty s + then Ok Use_name + else ( + match Public_name.of_string_user_error (Loc.none, s) with + | Ok n -> Ok (Public_name n) + | Error e -> Error (`Msg (User_message.to_string e))) in let printer ppf public_name = Format.pp_print_string ppf (public_name_to_string public_name) diff --git a/init-public-name.md b/init-public-name.md new file mode 100644 index 000000000000..cfbbec37235d --- /dev/null +++ b/init-public-name.md @@ -0,0 +1 @@ +- dune init: fix validation of `--public` argument (#...., fixes #7108, @emillon) diff --git a/src/dune_lang/package_name.ml b/src/dune_lang/package_name.ml index 2f5e6ae95607..e4220650d4b2 100644 --- a/src/dune_lang/package_name.ml +++ b/src/dune_lang/package_name.ml @@ -15,47 +15,50 @@ include ( Dune_util.Stringlike with type t := t) module Opam_compatible = struct - include Dune_util.Stringlike.Make (struct - type t = string + let description_of_valid_string = + Pp.text + "Package names can contain letters, numbers, '-', '_' and '+', and need to contain \ + at least a letter." + ;; - let module_ = "Package.Name.Strict" - let description = "opam package name" - let to_string s = s + module T = struct + type t = string + + let module_ = "Package.Name.Strict" + let description = "opam package name" + let to_string s = s + let description_of_valid_string = Some description_of_valid_string - let description_of_valid_string = - Some - (Pp.textf - "Package names can contain letters, numbers, '-', '_' and '+', and need to \ - contain at least a letter.") - ;; + let is_letter = function + | 'a' .. 'z' | 'A' .. 'Z' -> true + | _ -> false + ;; - let is_letter = function - | 'a' .. 'z' | 'A' .. 'Z' -> true - | _ -> false - ;; + let is_other_valid_char = function + | '0' .. '9' | '-' | '+' | '_' -> true + | _ -> false + ;; - let is_other_valid_char = function - | '0' .. '9' | '-' | '+' | '_' -> true - | _ -> false - ;; + let is_valid_char c = is_letter c || is_other_valid_char c - let is_valid_char c = is_letter c || is_other_valid_char c + let is_valid_string s = + let all_chars_valid = String.for_all s ~f:is_valid_char in + let has_one_letter = String.exists s ~f:is_letter in + all_chars_valid && has_one_letter + ;; - let is_valid_string s = - let all_chars_valid = String.for_all s ~f:is_valid_char in - let has_one_letter = String.exists s ~f:is_letter in - all_chars_valid && has_one_letter - ;; + let of_string_opt s = Option.some_if (is_valid_string s) s - let of_string_opt s = Option.some_if (is_valid_string s) s + let make_valid s = + let replaced = String.map s ~f:(fun c -> if is_valid_char c then c else '_') in + if is_valid_string replaced then replaced else "p" ^ replaced + ;; - let make_valid s = - let replaced = String.map s ~f:(fun c -> if is_valid_char c then c else '_') in - if is_valid_string replaced then replaced else "p" ^ replaced - ;; + let hint_valid = Some make_valid + end - let hint_valid = Some make_valid - end) + include Dune_util.Stringlike.Make (T) + let make_valid = T.make_valid let to_package_name s = s end diff --git a/src/dune_lang/package_name.mli b/src/dune_lang/package_name.mli index 6849029cd58e..4b7b5847f67a 100644 --- a/src/dune_lang/package_name.mli +++ b/src/dune_lang/package_name.mli @@ -20,5 +20,7 @@ module Opam_compatible : sig type package_name val to_package_name : t -> package_name + val description_of_valid_string : _ Pp.t + val make_valid : string -> string end with type package_name := t diff --git a/test/blackbox-tests/test-cases/dune-init/github7108.t b/test/blackbox-tests/test-cases/dune-init/github7108.t index 61388f2f2ab5..44e395d0942e 100644 --- a/test/blackbox-tests/test-cases/dune-init/github7108.t +++ b/test/blackbox-tests/test-cases/dune-init/github7108.t @@ -1,10 +1,4 @@ #7108: foo-bar is a valid public name, we should accept it. $ dune init lib foo_bar --public foo-bar - dune: option '--public': invalid component name `foo-bar' - Library names must be non-empty and composed only of the - following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Usage: dune init library [OPTION]… NAME [PATH] - Try 'dune init library --help' or 'dune --help' for more information. - [1] + Success: initialized library component named foo_bar diff --git a/test/blackbox-tests/test-cases/dune-init/public-implicit-invalid.t b/test/blackbox-tests/test-cases/dune-init/public-implicit-invalid.t new file mode 100644 index 000000000000..32052286f44b --- /dev/null +++ b/test/blackbox-tests/test-cases/dune-init/public-implicit-invalid.t @@ -0,0 +1,9 @@ +When a public name is implicit from the name, it should still be validated as a +public name. + + $ dune init lib 0 --public + Error: "0" is an invalid opam package name. + Package names can contain letters, numbers, '-', '_' and '+', and need to + contain at least a letter. + Hint: p0 would be a correct opam package name + [1] diff --git a/test/blackbox-tests/test-cases/dune-init/public-sublibrary.t b/test/blackbox-tests/test-cases/dune-init/public-sublibrary.t index 9507ea99da0d..3dbb9d3dd763 100644 --- a/test/blackbox-tests/test-cases/dune-init/public-sublibrary.t +++ b/test/blackbox-tests/test-cases/dune-init/public-sublibrary.t @@ -1,10 +1,4 @@ Sub-library names should be accepted: $ dune init lib lib_s1_s2 --public lib.sub1.sub2 - dune: option '--public': invalid component name `lib.sub1.sub2' - Library names must be non-empty and composed only of the - following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. - Usage: dune init library [OPTION]… NAME [PATH] - Try 'dune init library --help' or 'dune --help' for more information. - [1] + Success: initialized library component named lib_s1_s2 diff --git a/test/blackbox-tests/test-cases/github3046.t b/test/blackbox-tests/test-cases/github3046.t index cfb9536e1f05..6f9da1dcb5b6 100644 --- a/test/blackbox-tests/test-cases/github3046.t +++ b/test/blackbox-tests/test-cases/github3046.t @@ -25,10 +25,15 @@ are given as parameters `dune init lib foo --public="some/invalid&name!"` returns an informative parsing error $ dune init lib foo --public="some/invalid&name!" - dune: option '--public': invalid component name `some/invalid&name!' - Library names must be non-empty and composed only of the - following - characters: 'A'..'Z', 'a'..'z', '_' or '0'..'9'. + dune: option '--public': "some/invalid&name!" is an invalid public + name. + Public names are composed of an opam package name and optional + dot-separated + string suffixes. + Package names can contain letters, numbers, '-', '_' and '+', and need + to + contain at least a letter. + Hint: some_invalid_name_ would be a correct public name Usage: dune init library [OPTION]… NAME [PATH] Try 'dune init library --help' or 'dune --help' for more information. [1]