From b223c6704b82a8911f9019c38632757473b6b490 Mon Sep 17 00:00:00 2001 From: Benedikt Reinartz Date: Sun, 16 Apr 2023 21:39:44 +0200 Subject: [PATCH 1/7] Add verl dependency and vendor it --- apps/rebar/rebar.config | 3 +- rebar.lock | 9 +- vendor/verl/LICENSE | 191 +++++++++++++ vendor/verl/README.md | 142 ++++++++++ vendor/verl/hex_metadata.config | 12 + vendor/verl/rebar.config | 48 ++++ vendor/verl/rebar.lock | 1 + vendor/verl/src/verl.app.src | 11 + vendor/verl/src/verl.erl | 332 +++++++++++++++++++++++ vendor/verl/src/verl_parser.erl | 456 ++++++++++++++++++++++++++++++++ 10 files changed, 1203 insertions(+), 2 deletions(-) create mode 100644 vendor/verl/LICENSE create mode 100644 vendor/verl/README.md create mode 100644 vendor/verl/hex_metadata.config create mode 100644 vendor/verl/rebar.config create mode 100644 vendor/verl/rebar.lock create mode 100644 vendor/verl/src/verl.app.src create mode 100644 vendor/verl/src/verl.erl create mode 100644 vendor/verl/src/verl_parser.erl diff --git a/apps/rebar/rebar.config b/apps/rebar/rebar.config index 69fc1e1fb..53dc8e95b 100644 --- a/apps/rebar/rebar.config +++ b/apps/rebar/rebar.config @@ -10,7 +10,8 @@ {relx, "4.8.0"}, {cf, "0.3.1"}, {cth_readable, "1.5.1"}, - {eunit_formatters, "0.5.0"}]}. + {eunit_formatters, "0.5.0"}, + {verl, "1.1.1"}]}. {post_hooks, [{"(linux|darwin|solaris|freebsd|netbsd|openbsd)", escriptize, diff --git a/rebar.lock b/rebar.lock index 57afcca04..d71dc1aef 100644 --- a/rebar.lock +++ b/rebar.lock @@ -1 +1,8 @@ -[]. +{"1.2.0", +[{<<"verl">>,{pkg,<<"verl">>,<<"1.1.1">>},0}]}. +[ +{pkg_hash,[ + {<<"verl">>, <<"98F3EC48B943AA4AE8E29742DE86A7CD752513687911FE07D2E00ECDF3107E45">>}]}, +{pkg_hash_ext,[ + {<<"verl">>, <<"0925E51CD92A0A8BE271765B02430B2E2CFF8AC30EF24D123BD0D58511E8FB18">>}]} +]. diff --git a/vendor/verl/LICENSE b/vendor/verl/LICENSE new file mode 100644 index 000000000..50e0a132c --- /dev/null +++ b/vendor/verl/LICENSE @@ -0,0 +1,191 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + Copyright 2019, Bryan Paxton . + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + diff --git a/vendor/verl/README.md b/vendor/verl/README.md new file mode 100644 index 000000000..24468451d --- /dev/null +++ b/vendor/verl/README.md @@ -0,0 +1,142 @@ +# verl +[![Hex Version](https://img.shields.io/hexpm/v/verl.svg)](https://hex.pm/packages/verl) [![GitHub Actions CI](https://github.com/jelly-beam/verl/workflows/build/badge.svg)](https://github.com/jelly-beam/verl +) [![codecov](https://codecov.io/gh/jelly-beam/verl/branch/main/graph/badge.svg)](https://codecov.io/gh/jelly-beam/verl) + +SemVer 2.0 version and requirements parsing, matching, and comparisons. + +All parsing of versions and requirements adhere to the [SemVer 2.0 schema](http://semver.org/) + + - [Build](#build) + - [Usage](#usage) + * [Comparisons](#comparisons) + * [Version, Requirements, and Matching](#version--requirements--and-matching) + - [Matching](#matching) + - [Compiled requirements for ludicious speed matching](#compiled-requirements-for-ludicious-speed-matching) + - [Version parsing](#version-parsing) + * [Requirements parsing](#requirements-parsing) + - [Credits](#credits) + + +## Build + +```bash +$ rebar3 compile +``` + +## Test + +```bash +$ rebar3 test +``` + +## Usage + +Add to you deps configuration in rebar.config for your project : + +```erlang +{deps, [{verl, "1.1.0"}]}. +``` + +### Comparisons + +```erlang +1> verl:compare(<<"1.0.0">>, <<"1.0.1">>). +lt +2> verl:compare(<<"1.0.0">>, <<"1.0.0">>). +eq +3> verl:compare(<<"2.0.0">>, <<"1.0.0">>). +gt +4> verl:compare(<<"1.0.0-pre">>, <<"1.0.0">>). +lt +5> verl:compare(<<"1.0.0">>, <<"1.0.0-pre">>). +gt +``` + +### Version, Requirements, and Matching + +#### Matching + +```erlang +1> verl:is_match(<<"1.0.0">>, <<"~> 1.0.0">>). +true +2> verl:is_match(<<"1.0.0">>, <<"~> 2.0.0">>). +false +3> verl:is_match(<<"3.2.0">>, <<"~> 3.0.0">>). +false +4> verl:is_match(<<"3.2.0">>, <<"~> 3.0">>). +true +``` + +#### Compiled requirements for ludicious speed matching + +```erlang +1> {ok, Req} = verl:parse_requirement(<<"~> 3.0">>). +{ok,#{compiled => false, + string => <<"~> 3.0">>, + matchspec => [{{'$1','$2','$3','$4','$5'}...}], + string => <<"~> 3.0">>}} +2> verl:is_match(<<"3.0.0-dev">>, Req). + false +3> verl:is_match(<<"1.2.3">>, Req). + false +4> verl:is_match(<<"3.1.0">>, Req). + true +``` + +#### Version parsing + +```erlang +1> verl:parse(<<"1.2.3">>). +#{build => undefined,major => 1,minor => 2,patch => 3, + pre => []} +2> verl:parse(<<"1.2.3+build">>). +#{build => <<"build">>,major => 1,minor => 2,patch => 3, + pre => []} +3> verl:parse(<<"1.2.3-pre+build">>). +#{build => <<"build">>,major => 1,minor => 2,patch => 3, + pre => [<<"pre">>]} +4> verl:parse(<<"1">>). +{error, invalid_version} +5> verl:parse(<<"2">>). +{error, invalid_version} +``` + +Don't want a map? Use the `verl_parser` module... + +```erlang +1> verl_parser:parse_version(<<"1.2.3">>). +{ok,{1,2,3,[],[]}} +2> verl_parser:parse_version(<<"1.2.3+build">>). +{ok,{1,2,3,[],[<<"build">>]}} +3> verl_parser:parse_version(<<"1.2.3-pre+build">>). +{ok,{1,2,3,[<<"pre">>],[<<"build">>]}} +4> verl_parser:parse_version(<<"1">>). +{error, invalid_version} +``` + +##### Requirements parsing + +```erlang +1> verl:parse_requirement(<<"~> 2.1.0-dev">>). +{ok,#{compiled => false, + string => <<"~> 2.1.0-dev">>, + matchspec => + [{{'$1','$2','$3','$4','$5'}...] }} +2> verl:parse_requirement(<<"~> 2.1.0-">>). +{error,invalid_requirement} +``` + +Don't want a map? User the `verl_parser` module... + +```erlang +1> verl_parser:parse_requirement(<<"~> 2.1.0-dev">>). +{ok, [{{'$1','$2','$3','$4','$5'}...]} +2> verl:parse_requirement(<<"~> 2.1.0-">>). +{error,invalid_requirement} +``` + +## Credits + +- All credit goes to the Elixir team and contributors to Version and +Version.Parser in the Elixir standard lib for the algorithm and original +implementation. diff --git a/vendor/verl/hex_metadata.config b/vendor/verl/hex_metadata.config new file mode 100644 index 000000000..398960df2 --- /dev/null +++ b/vendor/verl/hex_metadata.config @@ -0,0 +1,12 @@ +{<<"app">>,<<"verl">>}. +{<<"build_tools">>,[<<"rebar3">>]}. +{<<"description">>, + <<"SemVer2 version and requirements parsing, matching, and comparison">>}. +{<<"files">>, + [<<"LICENSE">>,<<"README.md">>,<<"rebar.config">>,<<"rebar.lock">>, + <<"src/verl.app.src">>,<<"src/verl.erl">>,<<"src/verl_parser.erl">>]}. +{<<"licenses">>,[<<"Apache 2.0">>]}. +{<<"links">>,[{<<"Github">>,<<"https://github.com/jelly-beam/verl">>}]}. +{<<"name">>,<<"verl">>}. +{<<"requirements">>,[]}. +{<<"version">>,<<"1.1.1">>}. diff --git a/vendor/verl/rebar.config b/vendor/verl/rebar.config new file mode 100644 index 000000000..50e7a11c6 --- /dev/null +++ b/vendor/verl/rebar.config @@ -0,0 +1,48 @@ +{erl_opts, [ + debug_info, + warn_missing_spec, + warnings_as_errors +]}. +{minimum_otp_vsn, "19.3"}. +{deps, []}. +{project_plugins, [erlfmt, rebar3_proper, rebar3_hex, covertool, rebar3_lint, rebar3_hank]}. +{profiles, [ + {test, [ + {deps, [{proper, "1.3.0"}]}, + {erl_opts, [nowarn_missing_spec, nowarn_export_all]}, + {dialyzer, [{plt_extra_apps, [proper]}]}, + {cover_enabled, true}, + {cover_opts, [verbose]} + ]} +]}. + +{erlfmt, [ + {files, "{src,include,test}/*.{hrl,erl}"} + ]}. + +{edoc_opts, [ + {doclet, edoc_doclet_chunks}, + {layout, edoc_layout_chunks}, + {preprocess, true}, + {dir, "_build/default/lib/verl/doc"}]}. + +{xref_ignores, [verl, {verl_parser, parse_version, 2}]}. + +{alias, [{quick_test, [{proper, "--cover --numtests=3"}, + {eunit, "--cover"}, + {cover, "-v"}]}, + {test, [{ct, "-c"}, {proper, "--cover"}, {eunit, "--cover"}, {cover, "-v"}]}, + {check, [{proper, "--cover --numtests=3"}, + {eunit, "--cover"}, + xref, dialyzer, cover]}]}. + +{xref_checks,[undefined_function_calls,locals_not_used, + deprecated_function_calls,exports_not_used]}. + +{dialyzer, [ + {warnings, [ + error_handling, + unknown, + unmatched_returns + ]} +]}. diff --git a/vendor/verl/rebar.lock b/vendor/verl/rebar.lock new file mode 100644 index 000000000..57afcca04 --- /dev/null +++ b/vendor/verl/rebar.lock @@ -0,0 +1 @@ +[]. diff --git a/vendor/verl/src/verl.app.src b/vendor/verl/src/verl.app.src new file mode 100644 index 000000000..144d36e63 --- /dev/null +++ b/vendor/verl/src/verl.app.src @@ -0,0 +1,11 @@ +{application,verl, + [{description,"SemVer2 version and requirements parsing, matching, and comparison"}, + {vsn,"1.1.1"}, + {organization,"jelly-beam"}, + {registered,[]}, + {applications,[kernel,stdlib]}, + {env,[]}, + {modules,[]}, + {extra,{maintainers,["Bryan Paxton"]}}, + {licenses,["Apache 2.0"]}, + {links,[{"Github","https://github.com/jelly-beam/verl"}]}]}. diff --git a/vendor/verl/src/verl.erl b/vendor/verl/src/verl.erl new file mode 100644 index 000000000..f94f358cf --- /dev/null +++ b/vendor/verl/src/verl.erl @@ -0,0 +1,332 @@ +-module(verl). + +%% Main API +-export([ + compare/2, + is_match/2, + is_match/3, + parse/1, + parse_requirement/1, + compile_requirement/1 +]). + +%% Helpers +-export([ + between/3, + eq/2, + gt/2, + gte/2, + lt/2, + lte/2 +]). + +-type version() :: binary(). +-type requirement() :: binary(). + +-type major() :: non_neg_integer(). +-type minor() :: non_neg_integer(). +-type patch() :: non_neg_integer(). +-type pre() :: [binary() | non_neg_integer()]. +-type build() :: binary() | undefined. +-type version_t() :: #{ + major => major(), + minor => minor(), + patch => patch(), + pre => pre(), + build => build() +}. + +-type requirement_t() :: #{ + string => requirement(), + matchspec => list(), + compiled => boolean() +}. + +-type compiled_requirement() :: #{ + compiled => true, + matchspec => ets:comp_match_spec(), + string => requirement() +}. + +-type match_opts() :: [allow_pre | {allow_pre, true}]. + +-export_type([ + version/0, + requirement/0, + major/0, + minor/0, + patch/0, + pre/0, + build/0, + version_t/0, + requirement_t/0, + compiled_requirement/0 +]). + +%%% Primary API + +%%% @doc +%%% Compares two versions, returning whether the first argument is greater, equal, or +%%% less than the second argument. +%%% @end +-spec compare(version(), version()) -> gt | eq | lt | {error, invalid_version}. +compare(Version1, Version2) -> + ver_cmp(to_matchable(Version1, true), to_matchable(Version2, true)). + +%%% @doc +%%% Parses a semantic version, returning {ok, version_t()} or {error, invalid_version} +%%% @end +-spec parse(version()) -> {ok, version_t()} | {error, invalid_version}. +parse(Str) -> + build_version(Str). + +%%% @doc +%%% Parses a semantic version requirement, returning {ok, requirement_t()} or +%%% {error, invalid_requirement} +%%% @end +-spec parse_requirement(requirement()) -> {ok, requirement_t()} | {error, invalid_requirement}. +parse_requirement(Str) -> + case verl_parser:parse_requirement(Str) of + {ok, Spec} -> + {ok, #{string => Str, matchspec => Spec, compiled => false}}; + {error, invalid_requirement} -> + {error, invalid_requirement} + end. + +%%% @doc +%%% Compiles a version requirement as returned by `parse_requirement' for faster +%%% matches. +%%% @end +-spec compile_requirement(requirement_t()) -> compiled_requirement(). +compile_requirement(Req) when is_map(Req) -> + Ms = ets:match_spec_compile(maps:get(matchspec, Req)), + maps:put(compiled, true, maps:put(matchspec, Ms, Req)). + +%%% @doc +%%% Returns `true' if the dependency is in range of the requirement, otherwise +%%% `false', or an error. +%%% @end +-spec is_match(version() | version_t(), requirement() | requirement_t()) -> + boolean() | {error, badarg | invalid_requirement | invalid_version}. +is_match(Version, Requirement) -> + is_match(Version, Requirement, []). + +%%% @doc +%%% Works like `is_match/2' but takes extra options as an argument. +%%% @end +-spec is_match(version() | version_t(), requirement() | requirement_t(), match_opts()) -> + boolean() | {error, badarg | invalid_requirement | invalid_version}. +is_match(Version, Requirement, Opts) when is_binary(Version) andalso is_binary(Requirement) -> + case build_version(Version) of + {ok, Ver} -> + case build_requirement(Requirement) of + {ok, Req} -> + is_match(Ver, Req, Opts); + {error, invalid_requirement} -> + {error, invalid_requirement} + end; + {error, invalid_version} -> + {error, invalid_version} + end; +is_match(Version, Requirement, Opts) when is_binary(Version) andalso is_map(Requirement) -> + case build_version(Version) of + {ok, Ver} -> + is_match(Ver, Requirement, Opts); + {error, invalid_version} -> + {error, invalid_version} + end; +is_match(Version, Requirement, Opts) when is_map(Version) andalso is_binary(Requirement) -> + case build_requirement(Requirement) of + {ok, Req} -> + is_match(Version, Req, Opts); + {error, invalid_requirement} -> + {error, invalid_requirement} + end; +is_match(Version, #{matchspec := Spec, compiled := false} = R, Opts) when is_map(R) -> + AllowPre = proplists:get_value(allow_pre, Opts, true), + {ok, Result} = ets:test_ms(to_matchable(Version, AllowPre), Spec), + Result /= false; +is_match(Version, #{matchspec := Spec, compiled := true} = R, Opts) when + is_map(Version) andalso is_map(R) +-> + AllowPre = proplists:get_value(allow_pre, Opts, true), + ets:match_spec_run([to_matchable(Version, AllowPre)], Spec) /= []. + +to_matchable(#{major := Major, minor := Minor, patch := Patch, pre := Pre}, AllowPre) -> + {Major, Minor, Patch, Pre, AllowPre}; +to_matchable(String, AllowPre) when is_binary(String) -> + case verl_parser:parse_version(String) of + {ok, {Major, Minor, Patch, Pre, _Build}} -> + {Major, Minor, Patch, Pre, AllowPre}; + {error, invalid_version} -> + {error, invalid_version} + end. + +%%% Helper functions + +%%% @doc +%%% Helper function that returns true if the first version is greater than the third version and +%%% also the second version is less than the the third version, otherwise returns false. +%%% See `compare/2' for more details. +%%% @end +-spec between(version(), version(), version()) -> boolean() | {error, invalid_version}. +between(Vsn1, Vsn2, VsnMatch) -> + case {gte(VsnMatch, Vsn1), lte(VsnMatch, Vsn2)} of + {true, true} -> + true; + {{error, _} = Err, _} -> + Err; + {_, {error, _} = Err} -> + Err; + _ -> + false + end. + +%%% @doc +%%% Helper function that returns true if two versions are equal, otherwise +%%% false. See `compare/2' for more details. +%%% @end +-spec eq(version(), version()) -> boolean() | {error, invalid_version}. +eq(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + eq -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is greater than +%%% the second, otherwise returns false. See `compare/2' for more details. +%%% @end +-spec gt(version(), version()) -> boolean() | {error, invalid_version}. +gt(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + gt -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is greater than +%%% or equal to the second, otherwise returns false. +%%% See `compare/2' for more details. +%%% @end +-spec gte(version(), version()) -> boolean() | {error, invalid_version}. +gte(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + gt -> true; + eq -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is less than the +%%% second, otherwise returns false. See `compare/2' for more details. +%%% @end +-spec lt(version(), version()) -> boolean() | {error, invalid_version}. +lt(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + lt -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%%% @doc +%%% Helper function that returns true the first version given is less than or +%%% equal to the second, otherwise returns false. +%%% See `compare/2' for more details. +%%% @end +-spec lte(version(), version()) -> boolean() | {error, invalid_version}. +lte(Vsn1, Vsn2) -> + case compare(Vsn1, Vsn2) of + lt -> true; + eq -> true; + {error, _} = Err -> Err; + _ -> false + end. + +%% private api +%% + +%% @private +build_version(Version) -> + case verl_parser:parse_version(Version) of + {ok, {Major, Minor, Patch, Pre, Build}} -> + {ok, #{ + major => Major, + minor => Minor, + patch => Patch, + pre => Pre, + build => build_string(Build) + }}; + {error, invalid_version} -> + {error, invalid_version} + end. + +%% @private +build_requirement(Str) -> + case verl_parser:parse_requirement(Str) of + {ok, Spec} -> + {ok, #{string => Str, matchspec => Spec, compiled => false}}; + {error, invalid_requirement} -> + {error, invalid_requirement} + end. + +%% @private +build_string(Build) -> + case Build of + [] -> undefined; + _ -> binary:list_to_bin(Build) + end. + +%% @private +ver_cmp({Maj1, Min1, Patch1, Pre1, _}, {Maj2, Min2, Patch2, Pre2, _}) -> + case {Maj1, Min1, Patch1} > {Maj2, Min2, Patch2} of + true -> + gt; + false -> + case {Maj1, Min1, Patch1} < {Maj2, Min2, Patch2} of + true -> + lt; + false -> + test_pre(Pre1, Pre2) + end + end; +ver_cmp(_, _) -> + {error, invalid_version}. + +%% @private +test_pre(Pre1, Pre2) -> + case pre_is_eq(Pre1, Pre2) of + true -> + gt; + false -> + case pre_is_eq(Pre2, Pre1) of + true -> + lt; + false -> + pre_cmp(Pre1, Pre2) + end + end. + +%% @private +pre_cmp(Pre1, Pre2) -> + case Pre1 > Pre2 of + true -> + gt; + false -> + case Pre1 < Pre2 of + true -> + lt; + false -> + eq + end + end. + +%% @private +pre_is_eq(Pre1, Pre2) -> + case Pre1 == [] of + false -> false; + true -> Pre2 /= [] + end. diff --git a/vendor/verl/src/verl_parser.erl b/vendor/verl/src/verl_parser.erl new file mode 100644 index 000000000..614b5a190 --- /dev/null +++ b/vendor/verl/src/verl_parser.erl @@ -0,0 +1,456 @@ +-module(verl_parser). + +-export([parse_requirement/1, parse_version/1, parse_version/2]). + +-type operator() :: '!=' | '&&' | '<' | '<=' | '==' | '>' | '>=' | '||' | '~>' | bitstring(). + +-spec parse_version(verl:version()) -> + {ok, {verl:major(), verl:minor(), verl:patch(), verl:pre(), [verl:build()]}} + | {error, invalid_version}. +parse_version(Str) -> parse_version(Str, false). + +-spec parse_version(verl:version(), boolean()) -> + {ok, {verl:major(), verl:minor(), verl:patch(), verl:pre(), [verl:build()]}} + | {error, invalid_version}. +parse_version(Str, Approximate) when is_binary(Str) -> + try parse_and_convert(Str, Approximate) of + {ok, {_, _, undefined, _, _}} -> + {error, invalid_version}; + {ok, _} = V -> + V; + {error, invalid_version} -> + {error, invalid_version} + catch + error:{badmatch, {error, T}} when + T =:= invalid_version orelse + T =:= nan orelse + T =:= bad_part orelse + T =:= leading_zero + -> + {error, invalid_version} + end. + +-spec parse_requirement(verl:requirement()) -> + {ok, ets:match_spec()} | {error, invalid_requirement}. +parse_requirement(Source) -> + Lexed = lexer(Source, []), + to_matchspec(Lexed). + +%% @private +-spec lexer(binary(), [operator()]) -> [operator()]. +lexer(<<">=", Rest/binary>>, Acc) -> + lexer(Rest, ['>=' | Acc]); +lexer(<<"<=", Rest/binary>>, Acc) -> + lexer(Rest, ['<=' | Acc]); +lexer(<<"~>", Rest/binary>>, Acc) -> + lexer(Rest, ['~>' | Acc]); +lexer(<<">", Rest/binary>>, Acc) -> + lexer(Rest, ['>' | Acc]); +lexer(<<"<", Rest/binary>>, Acc) -> + lexer(Rest, ['<' | Acc]); +lexer(<<"==", Rest/binary>>, Acc) -> + lexer(Rest, ['==' | Acc]); +lexer(<<"!=", Rest/binary>>, Acc) -> + lexer(Rest, ['!=' | Acc]); +lexer(<<"!", Rest/binary>>, Acc) -> + lexer(Rest, ['!=' | Acc]); +lexer(<<" or ", Rest/binary>>, Acc) -> + lexer(Rest, ['||' | Acc]); +lexer(<<" and ", Rest/binary>>, Acc) -> + lexer(Rest, ['&&' | Acc]); +lexer(<<" ", Rest/binary>>, Acc) -> + lexer(Rest, Acc); +lexer(<>, []) -> + lexer(Rest, [<>, '==']); +lexer(<>, [Head | Acc]) -> + Acc1 = + case Head of + Head when is_binary(Head) -> + [<> | Acc]; + Head when Head =:= '&&' orelse Head =:= '||' -> + [<>, '==', Head | Acc]; + _Other -> + [<>, Head | Acc] + end, + lexer(Body, Acc1); +lexer(<<>>, Acc) -> + lists:reverse(Acc). + +%% @private +-spec parse_condition(verl:version()) -> + {integer(), integer(), 'undefined' | integer(), [binary() | integer()]}. +parse_condition(Version) -> parse_condition(Version, false). + +%% @private +-spec parse_condition(verl:version(), boolean()) -> + {integer(), integer(), 'undefined' | integer(), [binary() | integer()]}. +parse_condition(Version, Approximate) -> + try + case parse_and_convert(Version, Approximate) of + {ok, {Major, Minor, Patch, Pre, _Bld}} -> + {Major, Minor, Patch, Pre}; + _ -> + throw(invalid_matchspec) + end + catch + error:{badmatch, {error, T}} when + T =:= invalid_version orelse + T =:= nan orelse + T =:= bad_part orelse + T =:= leading_zero + -> + throw(invalid_matchspec) + end. + +%% @private +-spec approximate_upper({integer(), integer(), 'undefined' | integer(), [binary() | integer()]}) -> + {integer(), integer(), 0, [0, ...]}. +approximate_upper(Version) -> + case Version of + {Major, _Minor, undefined, _} -> + {Major + 1, 0, 0, [0]}; + {Major, Minor, _Patch, _Pre} -> + {Major, Minor + 1, 0, [0]} + end. + +%% @private +-spec matchable_to_string( + {integer(), integer(), 'undefined' | integer(), [binary() | integer()]} +) -> binary(). +matchable_to_string({Major, Minor, Patch, Pre}) -> + Patch1 = + case Patch of + P when P =:= undefined orelse P =:= false -> + <<"0">>; + _ -> + maybe_to_string(Patch) + end, + Pre1 = + case Pre == [] of + true -> + <<>>; + false -> + case Pre of + [0] -> + <<"-0">>; + _ -> + Pre0 = maybe_to_string(Pre), + <<<<"-">>/binary, Pre0/binary>> + end + end, + Major1 = maybe_to_string(Major), + Minor1 = maybe_to_string(Minor), + Patch2 = maybe_to_string(Patch1), + Joined = join_bins([Major1, Minor1, Patch2], <<".">>), + <>. + +%% @private +-spec pre_condition('<' | '>', [binary() | integer()]) -> tuple(). +pre_condition('>', Pre) -> + PreLength = length(Pre), + {'orelse', {'andalso', {'==', {length, '$4'}, 0}, {const, PreLength /= 0}}, + {'andalso', {const, PreLength /= 0}, + {'orelse', {'>', {length, '$4'}, PreLength}, + {'andalso', {'==', {length, '$4'}, PreLength}, {'>', '$4', {const, Pre}}}}}}; +pre_condition('<', Pre) -> + PreLength = length(Pre), + {'orelse', {'andalso', {'/=', {length, '$4'}, 0}, {const, PreLength == 0}}, + {'andalso', {'/=', {length, '$4'}, 0}, + {'orelse', {'<', {length, '$4'}, PreLength}, + {'andalso', {'==', {length, '$4'}, PreLength}, {'<', '$4', {const, Pre}}}}}}. + +%% @private +-spec no_pre_condition([binary() | integer()]) -> tuple(). +no_pre_condition([]) -> + {'orelse', '$5', {'==', {length, '$4'}, 0}}; +no_pre_condition(_) -> + {const, true}. + +%% @private +-spec to_matchspec([operator(), ...]) -> {error, invalid_requirement} | {ok, ets:match_spec()}. +to_matchspec(Lexed) -> + try + case is_valid_requirement(Lexed) of + true -> + First = to_condition(Lexed), + Rest = lists:nthtail(2, Lexed), + {ok, [{{'$1', '$2', '$3', '$4', '$5'}, [to_condition(First, Rest)], ['$_']}]}; + false -> + {error, invalid_requirement} + end + catch + invalid_matchspec -> {error, invalid_requirement} + end. + +%% @private +-spec to_condition([iodata(), ...]) -> tuple(). +to_condition(['==', Version | _]) -> + Matchable = parse_condition(Version), + main_condition('==', Matchable); +to_condition(['!=', Version | _]) -> + Matchable = parse_condition(Version), + main_condition('/=', Matchable); +to_condition(['~>', Version | _]) -> + From = parse_condition(Version, true), + To = approximate_upper(From), + {'andalso', to_condition(['>=', matchable_to_string(From)]), + to_condition(['<', matchable_to_string(To)])}; +to_condition(['>', Version | _]) -> + {Major, Minor, Patch, Pre} = + parse_condition(Version), + {'andalso', + {'orelse', main_condition('>', {Major, Minor, Patch}), + {'andalso', main_condition('==', {Major, Minor, Patch}), pre_condition('>', Pre)}}, + no_pre_condition(Pre)}; +to_condition(['>=', Version | _]) -> + Matchable = parse_condition(Version), + {'orelse', main_condition('==', Matchable), to_condition(['>', Version])}; +to_condition(['<', Version | _]) -> + {Major, Minor, Patch, Pre} = + parse_condition(Version), + {'orelse', main_condition('<', {Major, Minor, Patch}), + {'andalso', main_condition('==', {Major, Minor, Patch}), pre_condition('<', Pre)}}; +to_condition(['<=', Version | _]) -> + Matchable = parse_condition(Version), + {'orelse', main_condition('==', Matchable), to_condition(['<', Version])}. + +%% @private +-spec to_condition(tuple(), list()) -> tuple(). +to_condition(Current, []) -> + Current; +to_condition( + Current, + ['&&', Operator, Version | Rest] +) -> + to_condition( + {'andalso', Current, to_condition([Operator, Version])}, + Rest + ); +to_condition( + Current, + ['||', Operator, Version | Rest] +) -> + to_condition( + {'orelse', Current, to_condition([Operator, Version])}, + Rest + ). + +%% @private +-spec main_condition(any(), tuple()) -> tuple(). +main_condition(Op, Version) when tuple_size(Version) == 3 -> + {Op, {{'$1', '$2', '$3'}}, {const, Version}}; +main_condition(Op, Version) when tuple_size(Version) == 4 -> + {Op, {{'$1', '$2', '$3', '$4'}}, {const, Version}}. + +%% @private +-spec bisect(binary(), binary(), list()) -> [binary() | undefined, ...]. +bisect(Str, Delim, Opts) -> + [First | Rest] = binary:split(Str, [Delim], Opts), + Rest1 = + case Rest of + [] -> + undefined; + _ -> + join_bins(Rest, Delim) + end, + [First, Rest1]. + +%% @private +-spec has_leading_zero(error | undefined | binary() | [binary()]) -> boolean(). +has_leading_zero(<<48/integer, _/integer, _/binary>>) -> + true; +has_leading_zero(_) -> + false. + +%% @private +-spec is_valid_identifier(any()) -> boolean(). +is_valid_identifier(<>) when + is_integer(Char) andalso + Char >= 48 andalso Char =< 57; + is_integer(Char) andalso + Char >= 97 andalso Char =< 122; + is_integer(Char) andalso + Char >= 65 andalso Char =< 90; + Char == 45 +-> + is_valid_identifier(Rest); +is_valid_identifier(<<>>) -> + true; +is_valid_identifier(_) -> + false. + +%% @private +-spec join_bins([binary(), ...], binary()) -> binary(). +join_bins(List, Delim) -> + lists:foldl( + fun(Bin, Acc) -> + case bit_size(Acc) of + N when N > 0 -> + <>; + _ -> + Bin + end + end, + <<>>, + List + ). + +%% @private +-spec maybe_patch(undefined | binary() | integer(), boolean()) -> {ok, undefined | integer()}. +maybe_patch(undefined, true) -> + {ok, undefined}; +maybe_patch(Patch, _) -> + to_digits(Patch). + +%% @private +-spec parse_and_convert(verl:version(), boolean()) -> + {error, invalid_version} + | {ok, + { + integer(), + integer(), + 'undefined' + | integer(), + [ + binary() + | integer() + ], + [binary()] + }}. +parse_and_convert(Str, Approx) -> + [VerPre, Build] = bisect(Str, <<"+">>, [global]), + [Ver, Pre] = bisect(VerPre, <<"-">>, []), + [Maj1, Min1, Patch1, Other] = split_ver(Ver), + case Other of + undefined -> + {ok, Maj2} = to_digits(Maj1), + {ok, Min2} = to_digits(Min1), + {ok, Patch2} = maybe_patch(Patch1, Approx), + {ok, PreParts} = opt_dot_separated(Pre), + {ok, PreParts1} = parts_to_integers(PreParts, []), + {ok, Build2} = opt_dot_separated(Build), + {ok, {Maj2, Min2, Patch2, PreParts1, Build2}}; + _ -> + {error, invalid_version} + end. + +%% @private +-spec parse_digits('error' | 'undefined' | binary() | [binary()], bitstring()) -> + {'error', 'nan'} | {'ok', integer()}. +parse_digits(<>, Acc) when + is_integer(Char) andalso Char >= 48 andalso Char =< 57 +-> + parse_digits(Rest, <>); +parse_digits(<<>>, Acc) when byte_size(Acc) > 0 -> + {ok, binary_to_integer(Acc)}; +parse_digits(_, _) -> + {error, nan}. + +%% @private +-spec parts_to_integers([binary()], [binary() | integer()]) -> + {'error', 'nan'} | {'ok', [binary() | integer()]}. +parts_to_integers([Part | Rest], Acc) -> + case parse_digits(Part, <<>>) of + {ok, Int} -> + case has_leading_zero(Part) of + P when P =:= undefined orelse P =:= false -> + parts_to_integers(Rest, [Int | Acc]); + _ -> + {error, nan} + end; + {error, nan} -> + parts_to_integers(Rest, [Part | Acc]) + end; +parts_to_integers([], Acc) -> + {ok, lists:reverse(Acc)}. + +%% @private +-spec opt_dot_separated('undefined' | binary()) -> {'error', 'bad_part'} | {'ok', [binary()]}. +opt_dot_separated(undefined) -> + {ok, []}; +opt_dot_separated(Str) -> + Parts = binary:split(Str, <<".">>, [global]), + Fun = fun(P) -> + case P /= <<>> of + false -> false; + true -> is_valid_identifier(P) + end + end, + case lists:all(Fun, Parts) of + P when P =:= undefined orelse P =:= false -> + {error, bad_part}; + _ -> + {ok, Parts} + end. + +%% @private +-spec split_ver(binary()) -> ['error' | 'undefined' | binary() | [binary()], ...]. +split_ver(Str) -> + case binary:split(Str, [<<".">>], [global]) of + [Maj0, Min0] -> + [Maj0, Min0, undefined, undefined]; + [Maj, Min, P] -> + [Maj, Min, P, undefined]; + [Major, Minor, Patch | Rest] -> + [Major, Minor, Patch, Rest]; + _ -> + [error, error, error, error] + end. + +%% @private +-spec to_digits('error' | 'undefined' | binary() | [binary()]) -> + {'error', 'leading_zero' | 'nan'} | {'ok', integer()}. +to_digits(Str) -> + case has_leading_zero(Str) of + S when S =:= undefined orelse S =:= false -> + parse_digits(Str, <<>>); + true -> + {error, leading_zero} + end. + +%% @private +-spec maybe_to_string(binary() | [binary() | byte()] | integer()) -> binary(). +maybe_to_string(Part) -> + case Part of + Rewrite when is_binary(Rewrite) -> + Rewrite; + Int when is_integer(Int) -> + integer_to_binary(Int); + Rewrite when is_list(Rewrite) -> + list_to_binary(Rewrite) + end. + +%% @private +-spec is_valid_requirement([operator(), ...]) -> boolean(). +is_valid_requirement([]) -> false; +is_valid_requirement([A | Next]) -> is_valid_requirement(A, Next). + +%% @private +-spec is_valid_requirement(operator(), [operator()]) -> boolean(). +is_valid_requirement(A, []) when is_binary(A) -> + true; +is_valid_requirement(A, [B | Next]) when + (is_atom(A) andalso + is_atom(B)) andalso + (A =:= '&&' orelse A =:= '||') +-> + is_valid_requirement(B, Next); +is_valid_requirement(A, [B | Next]) when + (is_binary(A) andalso + is_atom(B)) andalso + (B =:= '&&' orelse B =:= '||') +-> + is_valid_requirement(B, Next); +is_valid_requirement(A, [B | Next]) when + (is_atom(A) andalso + is_binary(B)) andalso + (A =:= '&&' orelse A =:= '||') +-> + is_valid_requirement(B, Next); +is_valid_requirement(A, [B | Next]) when + is_atom(A) andalso + is_binary(B) +-> + is_valid_requirement(B, Next); +is_valid_requirement(_, _) -> + false. From 9a2aad134a122975952c6ee722cb1b1843363c51 Mon Sep 17 00:00:00 2001 From: Benedikt Reinartz Date: Tue, 18 Apr 2023 11:31:39 +0200 Subject: [PATCH 2/7] Start integrating verl --- apps/rebar/src/rebar.hrl | 2 +- apps/rebar/src/rebar_app_utils.erl | 4 +- apps/rebar/src/rebar_packages.erl | 179 ++++++---------------- apps/rebar/src/rebar_verl.erl | 55 +++++++ apps/rebar/test/mock_pkg_resource.erl | 8 +- apps/rebar/test/rebar_deps_SUITE.erl | 42 +---- apps/rebar/test/rebar_pkg_SUITE.erl | 12 +- apps/rebar/test/rebar_pkg_alias_SUITE.erl | 2 +- apps/rebar/test/rebar_pkg_repos_SUITE.erl | 4 +- rebar.lock | 9 +- 10 files changed, 128 insertions(+), 189 deletions(-) create mode 100644 apps/rebar/src/rebar_verl.erl diff --git a/apps/rebar/src/rebar.hrl b/apps/rebar/src/rebar.hrl index fa6f2bda2..5ccf21837 100644 --- a/apps/rebar/src/rebar.hrl +++ b/apps/rebar/src/rebar.hrl @@ -45,7 +45,7 @@ -type ms_field() :: '$1' | '_' | {'$1', '$2'}. %% TODO: change package and requirement keys to be required (:=) after dropping support for OTP-18 --record(package, {key :: {unicode:unicode_binary() | ms_field(), unicode:unicode_binary() | ms_field() | ec_semver:semver(), +-record(package, {key :: {unicode:unicode_binary() | ms_field(), unicode:unicode_binary() | ms_field() | verl:version(), unicode:unicode_binary() | ms_field()}, inner_checksum :: binary() | ms_field(), outer_checksum :: binary() | ms_field(), diff --git a/apps/rebar/src/rebar_app_utils.erl b/apps/rebar/src/rebar_app_utils.erl index f4526e4c5..c3d2deba4 100644 --- a/apps/rebar/src/rebar_app_utils.erl +++ b/apps/rebar/src/rebar_app_utils.erl @@ -328,7 +328,7 @@ update_source(AppInfo, {pkg, PkgName, PkgVsn, OldHash, Hash}, State) -> dependencies=Deps, retired=Retired} = Package, maybe_warn_retired(PkgName, PkgVsn1, Hash, Retired), - PkgVsn2 = list_to_binary(lists:flatten(ec_semver:format(PkgVsn1))), + PkgVsn2 = list_to_binary(lists:flatten(rebar_verl:format_version(PkgVsn1))), AppInfo1 = rebar_app_info:source(AppInfo, {pkg, PkgName, PkgVsn2, OldHash1, Hash1, RepoConfig}), rebar_app_info:update_opts_deps(AppInfo1, Deps); not_found -> @@ -364,7 +364,7 @@ maybe_warn_retired(_, _, Hash, _) when is_binary(Hash) -> maybe_warn_retired(Name, Vsn, _, R=#{reason := Reason}) -> Message = maps:get(message, R, ""), ?WARN("Warning: package ~s-~s is retired: (~s) ~s", - [Name, ec_semver:format(Vsn), retire_reason(Reason), Message]); + [Name, rebar_verl:format_version(Vsn), retire_reason(Reason), Message]); maybe_warn_retired(_, _, _, _) -> ok. diff --git a/apps/rebar/src/rebar_packages.erl b/apps/rebar/src/rebar_packages.erl index 5f39ac39b..89658a619 100644 --- a/apps/rebar/src/rebar_packages.erl +++ b/apps/rebar/src/rebar_packages.erl @@ -11,7 +11,7 @@ ,resolve_version/6]). -ifdef(TEST). --export([new_package_table/0, find_highest_matching_/5, cmp_/4, cmpl_/4, valid_vsn/1]). +-export([new_package_table/0, find_highest_matching_/5, valid_vsn/1]). -endif. -export_type([package/0]). @@ -55,16 +55,20 @@ get_all_names(State) -> _='_'}, [], ['$1']}])). --spec get_package_versions(unicode:unicode_binary(), ec_semver:semver(), +-spec get_package_versions(unicode:unicode_binary(), verl:semver(), unicode:unicode_binary(), ets:tid(), rebar_state:t()) -> [vsn()]. -get_package_versions(Dep, {_, AlphaInfo}, Repo, Table, State) -> - ?MODULE:verify_table(State), - AllowPreRelease = rebar_state:get(State, deps_allow_prerelease, false) - orelse AlphaInfo =/= {[],[]}, - ets:select(Table, [{#package{key={Dep, {'$1', '$2'}, Repo}, - _='_'}, - [{'==', '$2', {{[],[]}}} || not AllowPreRelease], [{{'$1', '$2'}}]}]). +get_package_versions(Dep, DepVsn, Repo, Table, State) -> + _AllowPreRelease = rebar_state:get(State, deps_allow_prerelease, false), + case rebar_verl:parse_requirement(DepVsn) of + {error, _} -> + none; + {ok, #{matchspec := [{Head, [Match], _}]}} -> + ?MODULE:verify_table(State), + Vsns = ets:select(Table, [{#package{key={Dep, Head, Repo}, _='_'}, + [Match], [{Head}]}]), + handle_vsns(Vsns) + end. -spec get_package(unicode:unicode_binary(), unicode:unicode_binary(), binary() | undefined | '_', @@ -72,14 +76,16 @@ get_package_versions(Dep, {_, AlphaInfo}, Repo, Table, State) -> -> {ok, #package{}} | not_found. get_package(Dep, Vsn, undefined, Repos, Table, State) -> get_package(Dep, Vsn, '_', Repos, Table, State); +get_package(Dep, Vsn, Hash, Repos, Table, State) when is_binary(Vsn) -> + get_package(Dep, r3_verl:parse(Vsn), Hash, Repos, Table, State); get_package(Dep, Vsn, Hash, Repos, Table, State) -> ?MODULE:verify_table(State), - MatchingPackages = ets:select(Table, [{#package{key={Dep, ec_semver:parse(Vsn), Repo}, + MatchingPackages = ets:select(Table, [{#package{key={Dep, Vsn, Repo}, _='_'}, [], ['$_']} || Repo <- Repos]), PackagesWithProperHash = lists:filter( fun(#package{key = {_Dep, _Vsn, Repo}, outer_checksum = PkgChecksum}) -> if (PkgChecksum =/= Hash) andalso (Hash =/= '_') -> - ?WARN("Checksum mismatch for package ~ts-~ts from repo ~ts", [Dep, Vsn, Repo]), + ?WARN("Checksum mismatch for package ~ts-~ts from repo ~ts", [Dep, rebar_verl:format_version(Vsn), Repo]), false; true -> true @@ -174,7 +180,8 @@ package_dir(Repo, State) -> %% `~> 2.1.3-dev` | `>= 2.1.3-dev and < 2.2.0` %% `~> 2.0` | `>= 2.0.0 and < 3.0.0` %% `~> 2.1` | `>= 2.1.0 and < 3.0.0` -find_highest_matching(Dep, Constraint, Repo, Table, State) -> +find_highest_matching(Dep, Version, Repo, Table, State) -> + Constraint = verl:add_highest_matching_prefix(Version), try find_highest_matching_(Dep, Constraint, Repo, Table, State) of none -> handle_missing_package(Dep, Repo, State, @@ -192,39 +199,26 @@ find_highest_matching(Dep, Constraint, Repo, Table, State) -> end. find_highest_matching_(Dep, Constraint, #{name := Repo}, Table, State) -> - try get_package_versions(Dep, Constraint, Repo, Table, State) of - [Vsn] -> - handle_single_vsn(Vsn, Constraint); - Vsns -> - case handle_vsns(Constraint, Vsns) of - none -> - none; - FoundVsn -> - {ok, FoundVsn} - end + try + get_package_versions(Dep, Constraint, Repo, Table, State) catch error:badarg -> none end. -handle_vsns(Constraint, Vsns) -> - lists:foldl(fun(Version, Highest) -> - case ec_semver:pes(Version, Constraint) andalso - (Highest =:= none orelse ec_semver:gt(Version, Highest)) of - true -> - Version; - false -> - Highest - end - end, none, Vsns). - -handle_single_vsn(Vsn, Constraint) -> - case ec_semver:pes(Vsn, Constraint) of - true -> - {ok, Vsn}; - false -> - none - end. +handle_vsns([]) -> none; +handle_vsns(Vsns) -> + Vsn = + lists:foldl( + fun(Version, Highest) -> + case (Highest =:= none orelse r3_verl:compare(Version, Highest) =:= gt) of + true -> + Version; + false -> + Highest + end + end, none, Vsns), + {ok, Vsn}. verify_table(State) -> ets:info(?PACKAGE_TABLE, named_table) =:= true orelse load_and_verify_version(State). @@ -282,8 +276,12 @@ unverified_repo_message() -> "You can disable this check by setting REBAR_NO_VERIFY_REPO_ORIGIN=1". insert_releases(Name, Releases, Repo, Table) -> + Parse = fun (V) -> + {ok, Res} = verl:parse(V), + Res + end, [true = ets:insert(Table, - #package{key={Name, ec_semver:parse(Version), Repo}, + #package{key={Name, Parse(Version), Repo}, inner_checksum=parse_checksum(InnerChecksum), outer_checksum=parse_checksum(OuterChecksum), retired=maps:get(retired, Release, false), @@ -313,7 +311,7 @@ resolve_version(Dep, DepVsn, _OldHash, Hash, HexRegistry, State) when is_binary( {ok, Package, RepoConfig}; _ -> Fun = fun(Repo) -> - case resolve_version_(Dep, DepVsn, Repo, HexRegistry, State) of + case get_package_versions(Dep, DepVsn, Repo, HexRegistry, State) of none -> not_found; {ok, Vsn} -> @@ -324,7 +322,7 @@ resolve_version(Dep, DepVsn, _OldHash, Hash, HexRegistry, State) when is_binary( end; resolve_version(Dep, undefined, _OldHash, Hash, HexRegistry, State) -> Fun = fun(Repo) -> - case highest_matching(Dep, {0,{[],[]}}, Repo, HexRegistry, State) of + case get_latest_version(Dep, Repo, HexRegistry, State) of none -> not_found; {ok, Vsn} -> @@ -338,7 +336,7 @@ resolve_version(Dep, DepVsn, _OldHash, Hash, HexRegistry, State) -> {error, {invalid_vsn, DepVsn}}; _ -> Fun = fun(Repo) -> - case resolve_version_(Dep, DepVsn, Repo, HexRegistry, State) of + case get_package_versions(Dep, DepVsn, Repo, HexRegistry, State) of none -> not_found; {ok, Vsn} -> @@ -373,92 +371,11 @@ handle_missing_no_exception(Fun, Dep, State) -> Result end. -resolve_version_(Dep, DepVsn, Repo, HexRegistry, State) -> - case DepVsn of - <<"~>", Vsn/binary>> -> - highest_matching(Dep, rm_ws(Vsn), Repo, HexRegistry, State); - <<">=", Vsn/binary>> -> - cmp(Dep, rm_ws(Vsn), Repo, HexRegistry, State, fun ec_semver:gte/2); - <<">", Vsn/binary>> -> - cmp(Dep, rm_ws(Vsn), Repo, HexRegistry, State, fun ec_semver:gt/2); - <<"<=", Vsn/binary>> -> - cmpl(Dep, rm_ws(Vsn), Repo, HexRegistry, State, fun ec_semver:lte/2); - <<"<", Vsn/binary>> -> - cmpl(Dep, rm_ws(Vsn), Repo, HexRegistry, State, fun ec_semver:lt/2); - <<"==", Vsn/binary>> -> - {ok, Vsn}; - Vsn -> - {ok, Vsn} - end. - -rm_ws(<<" ", R/binary>>) -> - ec_semver:parse(rm_ws(R)); -rm_ws(R) -> - ec_semver:parse(R). - valid_vsn(Vsn) -> - %% Regepx from https://github.com/sindresorhus/semver-regex/blob/master/index.js - SemVerRegExp = "v?(0|[1-9][0-9]*)\\.(0|[1-9][0-9]*)(\\.(0|[1-9][0-9]*))?" - "(-[0-9a-z-]+(\\.[0-9a-z-]+)*)?(\\+[0-9a-z-]+(\\.[0-9a-z-]+)*)?", - SupportedVersions = "^(>=?|<=?|~>|==)?\\s*" ++ SemVerRegExp ++ "$", - re:run(Vsn, SupportedVersions, [unicode]) =/= nomatch. - -highest_matching(Dep, Vsn, Repo, HexRegistry, State) -> - find_highest_matching_(Dep, Vsn, #{name => Repo}, HexRegistry, State). - -cmp(Dep, Vsn, Repo, HexRegistry, State, CmpFun) -> - case get_package_versions(Dep, Vsn, Repo, HexRegistry, State) of - [] -> - none; - Vsns -> - cmp_(undefined, Vsn, Vsns, CmpFun) - end. - -cmp_(undefined, MinVsn, [], _CmpFun) -> - {ok, MinVsn}; -cmp_(HighestDepVsn, _MinVsn, [], _CmpFun) -> - {ok, HighestDepVsn}; - -cmp_(BestMatch, MinVsn, [Vsn | R], CmpFun) -> - case CmpFun(Vsn, MinVsn) of - true -> - cmp_(Vsn, Vsn, R, CmpFun); - false -> - cmp_(BestMatch, MinVsn, R, CmpFun) - end. - -%% We need to treat this differently since we want a version that is LOWER but -%% the highest possible one. -cmpl(Dep, Vsn, Repo, HexRegistry, State, CmpFun) -> - case get_package_versions(Dep, Vsn, Repo, HexRegistry, State) of - [] -> - none; - Vsns -> - cmpl_(undefined, Vsn, Vsns, CmpFun) - end. - -cmpl_(undefined, MaxVsn, [], _CmpFun) -> - {ok, MaxVsn}; -cmpl_(HighestDepVsn, _MaxVsn, [], _CmpFun) -> - {ok, HighestDepVsn}; - -cmpl_(undefined, MaxVsn, [Vsn | R], CmpFun) -> - case CmpFun(Vsn, MaxVsn) of - true -> - cmpl_(Vsn, MaxVsn, R, CmpFun); - false -> - cmpl_(undefined, MaxVsn, R, CmpFun) - end; + rebar_verl:valid_requirement(Vsn). -cmpl_(BestMatch, MaxVsn, [Vsn | R], CmpFun) -> - case CmpFun(Vsn, MaxVsn) of - true -> - case ec_semver:gte(Vsn, BestMatch) of - true -> - cmpl_(Vsn, MaxVsn, R, CmpFun); - false -> - cmpl_(BestMatch, MaxVsn, R, CmpFun) - end; - false -> - cmpl_(BestMatch, MaxVsn, R, CmpFun) - end. +get_latest_version(Dep, Repo, HexRegistry, State) -> + verify_table(State), + Vsns = ets:select(HexRegistry, [{#package{key={'$1', '$2', '$3'}, _='_'}, + [{'==', '$1', Dep}, {'==', '$3', Repo}], ['$2']}]), + handle_vsns(Vsns). diff --git a/apps/rebar/src/rebar_verl.erl b/apps/rebar/src/rebar_verl.erl new file mode 100644 index 000000000..57252723f --- /dev/null +++ b/apps/rebar/src/rebar_verl.erl @@ -0,0 +1,55 @@ +%% -*- erlang-indent-level: 4;indent-tabs-mode: nil -*- +%% ex: ts=4 sw=4 et +-module(rebar_verl). + +-export([ + parse_requirement/1, + valid_requirement/1, + parse_version/1, + format_version/1 + ]). + +parse_requirement(Vsn) -> + Vsn1 = + case verl:parse(Vsn) of + {ok, _} -> + list_to_binary([<<"=> ">>, Vsn]); + _ -> + Vsn + end, + + verl:parse_requirement(Vsn1). + +valid_requirement(Vsn) -> + case verl:parse(Vsn) of + {ok, _} -> + true; + _ -> + case verl:parse_requirement(Vsn) of + {ok, _} -> + true; + _ -> + false + end + end. + +parse_version(Vsn) -> + {ok, Res} = verl:parse(Vsn), + Res. + +format_version(#{major := Major, minor := Minor, patch := Patch, pre := Pre, build := Build}) -> + Base = io_lib:format("~p.~p.~p", [Major, Minor, Patch]), + WithPre = case Pre of + [] -> + Base; + _ -> + [Base, [$-, Pre]] + end, + WithBuild = case Build of + undefined -> + WithPre; + _ -> + [WithPre, io_lib:format("+~p", [Build])] + end, + WithBuild. + diff --git a/apps/rebar/test/mock_pkg_resource.erl b/apps/rebar/test/mock_pkg_resource.erl index ec571f3c6..2f4136111 100644 --- a/apps/rebar/test/mock_pkg_resource.erl +++ b/apps/rebar/test/mock_pkg_resource.erl @@ -173,8 +173,9 @@ to_index(AllDeps, Dict, Repos) -> DKB <- [ec_cnv:to_binary(DK)], DVB <- [ec_cnv:to_binary(DV)]], Repo = rebar_test_utils:random_element(Repos), + {ok, ParsedV} = verl:parse(V), - ets:insert(?PACKAGE_TABLE, #package{key={N, ec_semver:parse(V), Repo}, + ets:insert(?PACKAGE_TABLE, #package{key={N, ParsedV, Repo}, dependencies=parse_deps(DepsList), retired=false, inner_checksum = <<"inner_checksum">>, @@ -182,12 +183,13 @@ to_index(AllDeps, Dict, Repos) -> end, ok, Dict), lists:foreach(fun({{Name, Vsn}, _}) -> + {ok, ParsedV} = verl:parse(Vsn), case lists:any(fun(R) -> - ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(Name), ec_semver:parse(Vsn), R}) + ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(Name), ParsedV, R}) end, Repos) of false -> Repo = rebar_test_utils:random_element(Repos), - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(Name), ec_semver:parse(Vsn), Repo}, + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(Name), ParsedV, Repo}, dependencies=[], retired=false, inner_checksum = <<"inner_checksum">>, diff --git a/apps/rebar/test/rebar_deps_SUITE.erl b/apps/rebar/test/rebar_deps_SUITE.erl index 0618bd2c0..50771ce00 100644 --- a/apps/rebar/test/rebar_deps_SUITE.erl +++ b/apps/rebar/test/rebar_deps_SUITE.erl @@ -6,7 +6,6 @@ all() -> [sub_app_deps, newly_added_dep, newly_added_after_empty_lock, no_deps_empty_lock, http_proxy_settings, https_proxy_settings, http_os_proxy_settings, https_os_proxy_settings, - semver_matching_lt, semver_matching_lte, semver_matching_gt, valid_version, top_override, {group, git}, {group, pkg}, deps_cmd_needs_update_called ]. @@ -443,55 +442,28 @@ https_os_proxy_settings(_Config) -> ?assertEqual({ok,{{"localhost", 1234}, []}}, httpc:get_option(https_proxy, rebar)). -semver_matching_lt(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>, <<"0.2.1">>], - ?assertEqual({ok, <<"0.1.9">>}, - rebar_packages:cmpl_(undefined, MaxVsn, Vsns, - fun ec_semver:lt/2)). - -semver_matching_lte(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>, <<"0.2.1">>], - ?assertEqual({ok, <<"0.2.0">>}, - rebar_packages:cmpl_(undefined, MaxVsn, Vsns, - fun ec_semver:lte/2)). - -semver_matching_gt(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>, <<"0.2.1">>], - ?assertEqual({ok, <<"0.2.1">>}, - rebar_packages:cmp_(undefined, MaxVsn, Vsns, - fun ec_semver:gt/2)). -semver_matching_gte(_Config) -> - MaxVsn = <<"0.2.0">>, - Vsns = [<<"0.1.7">>, <<"0.1.9">>, <<"0.1.8">>, <<"0.2.0">>], - ?assertEqual({ok, <<"0.2.0">>}, - rebar_packages:cmp_(undefined, MaxVsn, Vsns, - fun ec_semver:gt/2)). - valid_version(_Config) -> - ?assert(rebar_packages:valid_vsn(<<"0.1">>)), + % ?assert(rebar_packages:valid_vsn(<<"0.1">>)), ?assert(rebar_packages:valid_vsn(<<"0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<" 0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<" 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"<0.1">>)), + % ?assert(rebar_packages:valid_vsn(<<"<0.1">>)), ?assert(rebar_packages:valid_vsn(<<"<0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"< 0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"< 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<">0.1">>)), + % ?assert(rebar_packages:valid_vsn(<<">0.1">>)), ?assert(rebar_packages:valid_vsn(<<">0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"> 0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"> 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"<=0.1">>)), + % ?assert(rebar_packages:valid_vsn(<<"<=0.1">>)), ?assert(rebar_packages:valid_vsn(<<"<=0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"<= 0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"<= 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<">=0.1">>)), + % ?assert(rebar_packages:valid_vsn(<<">=0.1">>)), ?assert(rebar_packages:valid_vsn(<<">=0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<">= 0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<">= 0.1.0">>)), - ?assert(rebar_packages:valid_vsn(<<"==0.1">>)), + % ?assert(rebar_packages:valid_vsn(<<"==0.1">>)), ?assert(rebar_packages:valid_vsn(<<"==0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"== 0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"== 0.1.0">>)), @@ -499,7 +471,7 @@ valid_version(_Config) -> ?assert(rebar_packages:valid_vsn(<<"~>0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"~> 0.1.0">>)), ?assert(rebar_packages:valid_vsn(<<"~> 0.1.0">>)), - ?assertNot(rebar_packages:valid_vsn(<<"> 0.1.0 and < 0.2.0">>)), + ?assert(rebar_packages:valid_vsn(<<"> 0.1.0 and < 0.2.0">>)), ok. diff --git a/apps/rebar/test/rebar_pkg_SUITE.erl b/apps/rebar/test/rebar_pkg_SUITE.erl index 1bfce0913..a9fda8243 100644 --- a/apps/rebar/test/rebar_pkg_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_SUITE.erl @@ -231,22 +231,22 @@ pkgs_provider(Config) -> find_highest_matching(_Config) -> State = rebar_state:new(), {ok, Vsn} = rebar_packages:find_highest_matching_( - <<"goodpkg">>, ec_semver:parse(<<"1.0.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + <<"goodpkg">>,rebar_verl:parse_version(<<"1.0.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{1,0,1},{[],[]}}, Vsn), {ok, Vsn1} = rebar_packages:find_highest_matching( - <<"goodpkg">>, ec_semver:parse(<<"1.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + <<"goodpkg">>,rebar_verl:parse_version(<<"1.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{1,1,1},{[],[]}}, Vsn1), {ok, Vsn2} = rebar_packages:find_highest_matching( - <<"goodpkg">>, ec_semver:parse(<<"2.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + <<"goodpkg">>,rebar_verl:parse_version(<<"2.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{2,0,0},{[],[]}}, Vsn2), %% regression test. ~> constraints higher than the available packages would result %% in returning the first package version instead of 'none'. - ?assertEqual(none, rebar_packages:find_highest_matching_(<<"goodpkg">>, ec_semver:parse(<<"5.0">>), + ?assertEqual(none, rebar_packages:find_highest_matching_(<<"goodpkg">>,rebar_verl:parse_version(<<"5.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State)), - {ok, Vsn3} = rebar_packages:find_highest_matching_(<<"goodpkg">>, ec_semver:parse(<<"3.0.0-rc.0">>), + {ok, Vsn3} = rebar_packages:find_highest_matching_(<<"goodpkg">>,rebar_verl:parse_version(<<"3.0.0-rc.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), ?assertEqual({{3,0,0},{[<<"rc">>,0],[]}}, Vsn3). @@ -277,7 +277,7 @@ mock_config(Name, Config) -> lists:foreach(fun({{N, Vsn}, [Deps, InnerChecksum, OuterChecksum, _]}) -> case ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(N), Vsn, <<"hexpm">>}) of false -> - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), ec_semver:parse(Vsn), <<"hexpm">>}, + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), rebar_verl:parse_version(Vsn), <<"hexpm">>}, dependencies=Deps, retired=false, inner_checksum=InnerChecksum, diff --git a/apps/rebar/test/rebar_pkg_alias_SUITE.erl b/apps/rebar/test/rebar_pkg_alias_SUITE.erl index 5ba544de7..94266d86b 100644 --- a/apps/rebar/test/rebar_pkg_alias_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_alias_SUITE.erl @@ -229,7 +229,7 @@ mock_config(Name, Config) -> lists:foreach(fun({{N, Vsn}, [Deps, Checksum, _]}) -> case ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(N), Vsn, <<"hexpm">>}) of false -> - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), ec_semver:parse(Vsn), <<"hexpm">>}, + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), verl:parse(Vsn), <<"hexpm">>}, dependencies=[{DAppName, {pkg, DN, DV, undefined}} || {DN, DV, _, DAppName} <- Deps], retired=false, outer_checksum=Checksum}); diff --git a/apps/rebar/test/rebar_pkg_repos_SUITE.erl b/apps/rebar/test/rebar_pkg_repos_SUITE.erl index 1a29fc63d..7a3b527cc 100644 --- a/apps/rebar/test/rebar_pkg_repos_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_repos_SUITE.erl @@ -472,7 +472,7 @@ setup_deps_and_repos(Deps, Repos) -> insert_deps(Deps) -> lists:foreach(fun({Name, Version, Repo, Retired}) -> ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - ec_semver:parse(Version), + verl:parse(Version), rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired, @@ -480,7 +480,7 @@ insert_deps(Deps) -> outer_checksum = <<"outer checksum">>}); ({Name, Version, InnerChecksum, OuterChecksum, Repo, Retired}) -> ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - ec_semver:parse(Version), + verl:parse(Version), rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired, diff --git a/rebar.lock b/rebar.lock index d71dc1aef..57afcca04 100644 --- a/rebar.lock +++ b/rebar.lock @@ -1,8 +1 @@ -{"1.2.0", -[{<<"verl">>,{pkg,<<"verl">>,<<"1.1.1">>},0}]}. -[ -{pkg_hash,[ - {<<"verl">>, <<"98F3EC48B943AA4AE8E29742DE86A7CD752513687911FE07D2E00ECDF3107E45">>}]}, -{pkg_hash_ext,[ - {<<"verl">>, <<"0925E51CD92A0A8BE271765B02430B2E2CFF8AC30EF24D123BD0D58511E8FB18">>}]} -]. +[]. From 78fb1c72eefba26ddd1cd31bf451e57047af4f80 Mon Sep 17 00:00:00 2001 From: Benedikt Reinartz Date: Tue, 30 May 2023 00:02:46 +0200 Subject: [PATCH 3/7] Improve verl handling of matchables (will be upstreamed) --- vendor/verl/src/verl.erl | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/vendor/verl/src/verl.erl b/vendor/verl/src/verl.erl index f94f358cf..91b98f37b 100644 --- a/vendor/verl/src/verl.erl +++ b/vendor/verl/src/verl.erl @@ -6,6 +6,7 @@ is_match/2, is_match/3, parse/1, + to_matchable/2, parse_requirement/1, compile_requirement/1 ]). @@ -35,6 +36,7 @@ pre => pre(), build => build() }. +-type matchable() :: {major(), minor(), patch(), pre(), boolean()}. -type requirement_t() :: #{ string => requirement(), @@ -58,6 +60,7 @@ patch/0, pre/0, build/0, + matchable/0, version_t/0, requirement_t/0, compiled_requirement/0 @@ -69,9 +72,11 @@ %%% Compares two versions, returning whether the first argument is greater, equal, or %%% less than the second argument. %%% @end --spec compare(version(), version()) -> gt | eq | lt | {error, invalid_version}. +-spec compare(version() | matchable() | version_t(), version() | matchable() | version_t()) -> gt | eq | lt | {error, invalid_version}. +compare({_, _, _, _, _} = Version1, {_, _, _, _, _} = Version2) -> + ver_cmp(Version1, Version2); compare(Version1, Version2) -> - ver_cmp(to_matchable(Version1, true), to_matchable(Version2, true)). + compare(to_matchable(Version1, true), to_matchable(Version2, true)). %%% @doc %%% Parses a semantic version, returning {ok, version_t()} or {error, invalid_version} @@ -152,6 +157,7 @@ is_match(Version, #{matchspec := Spec, compiled := true} = R, Opts) when AllowPre = proplists:get_value(allow_pre, Opts, true), ets:match_spec_run([to_matchable(Version, AllowPre)], Spec) /= []. +-spec to_matchable(version() | version_t(), boolean()) -> {_, _, _, _, _}. to_matchable(#{major := Major, minor := Minor, patch := Patch, pre := Pre}, AllowPre) -> {Major, Minor, Patch, Pre, AllowPre}; to_matchable(String, AllowPre) when is_binary(String) -> From 5d3d5d84f68648125b0b0ea36b20d2f6913dbd27 Mon Sep 17 00:00:00 2001 From: Benedikt Reinartz Date: Tue, 30 May 2023 00:03:32 +0200 Subject: [PATCH 4/7] Make test-suites pass by using matchables instead of version maps --- apps/rebar/src/rebar_packages.erl | 74 ++++++++++++++--------- apps/rebar/src/rebar_verl.erl | 37 ++++++++---- apps/rebar/test/mock_pkg_resource.erl | 8 +-- apps/rebar/test/rebar_pkg_SUITE.erl | 21 ++++--- apps/rebar/test/rebar_pkg_alias_SUITE.erl | 2 +- apps/rebar/test/rebar_pkg_repos_SUITE.erl | 32 +++++----- 6 files changed, 102 insertions(+), 72 deletions(-) diff --git a/apps/rebar/src/rebar_packages.erl b/apps/rebar/src/rebar_packages.erl index 89658a619..0f6ef4c34 100644 --- a/apps/rebar/src/rebar_packages.erl +++ b/apps/rebar/src/rebar_packages.erl @@ -55,20 +55,17 @@ get_all_names(State) -> _='_'}, [], ['$1']}])). --spec get_package_versions(unicode:unicode_binary(), verl:semver(), +-spec get_package_versions(unicode:unicode_binary(), verl:version(), unicode:unicode_binary(), ets:tid(), rebar_state:t()) -> [vsn()]. get_package_versions(Dep, DepVsn, Repo, Table, State) -> - _AllowPreRelease = rebar_state:get(State, deps_allow_prerelease, false), - case rebar_verl:parse_requirement(DepVsn) of - {error, _} -> - none; - {ok, #{matchspec := [{Head, [Match], _}]}} -> - ?MODULE:verify_table(State), - Vsns = ets:select(Table, [{#package{key={Dep, Head, Repo}, _='_'}, - [Match], [{Head}]}]), - handle_vsns(Vsns) - end. + AllowPreRelease = rebar_state:get(State, deps_allow_prerelease, false), + #{matchspec := [{Head, [Match], _}]} = rebar_verl:parse_requirement(DepVsn), + + ?MODULE:verify_table(State), + Vsns = ets:select(Table, [{#package{key={Dep, Head, Repo}, _='_'}, + [Match], [{Head}]}]), + handle_vsns(Vsns, AllowPreRelease). -spec get_package(unicode:unicode_binary(), unicode:unicode_binary(), binary() | undefined | '_', @@ -76,12 +73,19 @@ get_package_versions(Dep, DepVsn, Repo, Table, State) -> -> {ok, #package{}} | not_found. get_package(Dep, Vsn, undefined, Repos, Table, State) -> get_package(Dep, Vsn, '_', Repos, Table, State); -get_package(Dep, Vsn, Hash, Repos, Table, State) when is_binary(Vsn) -> - get_package(Dep, r3_verl:parse(Vsn), Hash, Repos, Table, State); get_package(Dep, Vsn, Hash, Repos, Table, State) -> + MatchSpec = + case is_binary(Vsn) of + true -> + #{matchspec := [{Head, [Match], _}]} = rebar_verl:parse_requirement(Vsn), + [{#package{key={Dep, Head, Repo}, _='_'}, [Match], ['$_']} || Repo <- Repos]; + false -> + [{#package{key={Dep, Vsn, Repo}, _='_'}, [], ['$_']} || Repo <- Repos] + end, + ?MODULE:verify_table(State), - MatchingPackages = ets:select(Table, [{#package{key={Dep, Vsn, Repo}, - _='_'}, [], ['$_']} || Repo <- Repos]), + + MatchingPackages = ets:select(Table, MatchSpec), PackagesWithProperHash = lists:filter( fun(#package{key = {_Dep, _Vsn, Repo}, outer_checksum = PkgChecksum}) -> if (PkgChecksum =/= Hash) andalso (Hash =/= '_') -> @@ -92,7 +96,19 @@ get_package(Dep, Vsn, Hash, Repos, Table, State) -> end end, MatchingPackages ), - case PackagesWithProperHash of + PackagesAdjustedForPrerelease = + case rebar_state:get(State, deps_allow_prerelease, false) of + true -> + PackagesWithProperHash; + false -> + lists:filter( + fun(#package{key = {_, {_, _, _, Pre, _}, _}}) -> + Pre =:= [] + end, + PackagesWithProperHash + ) + end, + case lists:reverse(PackagesAdjustedForPrerelease) of %% have to allow multiple matches in the list for cases that Repo is `_` [Package | _] -> {ok, Package}; @@ -181,12 +197,11 @@ package_dir(Repo, State) -> %% `~> 2.0` | `>= 2.0.0 and < 3.0.0` %% `~> 2.1` | `>= 2.1.0 and < 3.0.0` find_highest_matching(Dep, Version, Repo, Table, State) -> - Constraint = verl:add_highest_matching_prefix(Version), - try find_highest_matching_(Dep, Constraint, Repo, Table, State) of + try find_highest_matching_(Dep, Version, Repo, Table, State) of none -> handle_missing_package(Dep, Repo, State, fun(State1) -> - find_highest_matching_(Dep, Constraint, Repo, Table, State1) + find_highest_matching_(Dep, Version, Repo, Table, State1) end); Result -> Result @@ -194,7 +209,7 @@ find_highest_matching(Dep, Version, Repo, Table, State) -> _:_ -> handle_missing_package(Dep, Repo, State, fun(State1) -> - find_highest_matching_(Dep, Constraint, Repo, Table, State1) + find_highest_matching_(Dep, Version, Repo, Table, State1) end) end. @@ -206,17 +221,19 @@ find_highest_matching_(Dep, Constraint, #{name := Repo}, Table, State) -> none end. -handle_vsns([]) -> none; -handle_vsns(Vsns) -> +handle_vsns([], _) -> none; +handle_vsns(Vsns, AllowPreRelease) -> Vsn = lists:foldl( - fun(Version, Highest) -> - case (Highest =:= none orelse r3_verl:compare(Version, Highest) =:= gt) of + fun(Version, Highest) when AllowPreRelease orelse length(element(4, Version)) =:= 0 -> + case (Highest =:= none orelse verl:compare(Version, Highest) =:= gt) of true -> Version; false -> Highest - end + end; + (_, Highest) -> + Highest end, none, Vsns), {ok, Vsn}. @@ -276,10 +293,7 @@ unverified_repo_message() -> "You can disable this check by setting REBAR_NO_VERIFY_REPO_ORIGIN=1". insert_releases(Name, Releases, Repo, Table) -> - Parse = fun (V) -> - {ok, Res} = verl:parse(V), - Res - end, + Parse = fun rebar_verl:parse_as_matchable/1, [true = ets:insert(Table, #package{key={Name, Parse(Version), Repo}, inner_checksum=parse_checksum(InnerChecksum), @@ -378,4 +392,4 @@ get_latest_version(Dep, Repo, HexRegistry, State) -> verify_table(State), Vsns = ets:select(HexRegistry, [{#package{key={'$1', '$2', '$3'}, _='_'}, [{'==', '$1', Dep}, {'==', '$3', Repo}], ['$2']}]), - handle_vsns(Vsns). + handle_vsns(Vsns, true). diff --git a/apps/rebar/src/rebar_verl.erl b/apps/rebar/src/rebar_verl.erl index 57252723f..0020b1341 100644 --- a/apps/rebar/src/rebar_verl.erl +++ b/apps/rebar/src/rebar_verl.erl @@ -5,20 +5,25 @@ -export([ parse_requirement/1, valid_requirement/1, - parse_version/1, + parse_as_matchable/1, format_version/1 ]). parse_requirement(Vsn) -> Vsn1 = - case verl:parse(Vsn) of - {ok, _} -> - list_to_binary([<<"=> ">>, Vsn]); - _ -> - Vsn - end, + case verl:parse(Vsn) of + {ok, _} -> + list_to_binary([<<">= ">>, Vsn]); + _ -> + Vsn + end, - verl:parse_requirement(Vsn1). + case verl:parse_requirement(Vsn1) of + {ok, Requirement} -> + Requirement; + {error, Error} -> + error({Error, Vsn1}) + end. valid_requirement(Vsn) -> case verl:parse(Vsn) of @@ -33,10 +38,20 @@ valid_requirement(Vsn) -> end end. -parse_version(Vsn) -> - {ok, Res} = verl:parse(Vsn), - Res. +parse_as_matchable(Vsn) when is_list(Vsn) -> + parse_as_matchable(list_to_binary(Vsn)); +parse_as_matchable(Vsn) -> + case verl:parse(Vsn) of + {ok, Res} -> + verl:to_matchable(Res, true); + {error, Error} -> + error({Error, Vsn}) + end. +format_version(Binary) when is_binary(Binary) -> + Binary; +format_version({Major, Minor, Patch, Pre, _}) -> + format_version(#{major => Major, minor => Minor, patch => Patch, pre => Pre, build => undefined}); format_version(#{major := Major, minor := Minor, patch := Patch, pre := Pre, build := Build}) -> Base = io_lib:format("~p.~p.~p", [Major, Minor, Patch]), WithPre = case Pre of diff --git a/apps/rebar/test/mock_pkg_resource.erl b/apps/rebar/test/mock_pkg_resource.erl index 2f4136111..5bbd54ec5 100644 --- a/apps/rebar/test/mock_pkg_resource.erl +++ b/apps/rebar/test/mock_pkg_resource.erl @@ -173,7 +173,7 @@ to_index(AllDeps, Dict, Repos) -> DKB <- [ec_cnv:to_binary(DK)], DVB <- [ec_cnv:to_binary(DV)]], Repo = rebar_test_utils:random_element(Repos), - {ok, ParsedV} = verl:parse(V), + ParsedV = rebar_verl:parse_as_matchable(V), ets:insert(?PACKAGE_TABLE, #package{key={N, ParsedV, Repo}, dependencies=parse_deps(DepsList), @@ -183,13 +183,13 @@ to_index(AllDeps, Dict, Repos) -> end, ok, Dict), lists:foreach(fun({{Name, Vsn}, _}) -> - {ok, ParsedV} = verl:parse(Vsn), + V = rebar_verl:parse_as_matchable(Vsn), case lists:any(fun(R) -> - ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(Name), ParsedV, R}) + ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(Name), V, R}) end, Repos) of false -> Repo = rebar_test_utils:random_element(Repos), - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(Name), ParsedV, Repo}, + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(Name), V, Repo}, dependencies=[], retired=false, inner_checksum = <<"inner_checksum">>, diff --git a/apps/rebar/test/rebar_pkg_SUITE.erl b/apps/rebar/test/rebar_pkg_SUITE.erl index a9fda8243..55f0c62f3 100644 --- a/apps/rebar/test/rebar_pkg_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_SUITE.erl @@ -231,24 +231,24 @@ pkgs_provider(Config) -> find_highest_matching(_Config) -> State = rebar_state:new(), {ok, Vsn} = rebar_packages:find_highest_matching_( - <<"goodpkg">>,rebar_verl:parse_version(<<"1.0.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertEqual({{1,0,1},{[],[]}}, Vsn), + <<"goodpkg">>, <<"~> 1.0.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + ?assertMatch({1,0,1,[],_}, Vsn), {ok, Vsn1} = rebar_packages:find_highest_matching( - <<"goodpkg">>,rebar_verl:parse_version(<<"1.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertEqual({{1,1,1},{[],[]}}, Vsn1), + <<"goodpkg">>, <<"~> 1.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + ?assertMatch({1,1,1,[],_}, Vsn1), {ok, Vsn2} = rebar_packages:find_highest_matching( - <<"goodpkg">>,rebar_verl:parse_version(<<"2.0">>), #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertEqual({{2,0,0},{[],[]}}, Vsn2), + <<"goodpkg">>, <<"~> 2.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), + ?assertMatch({2,0,0,[],_}, Vsn2), %% regression test. ~> constraints higher than the available packages would result %% in returning the first package version instead of 'none'. - ?assertEqual(none, rebar_packages:find_highest_matching_(<<"goodpkg">>,rebar_verl:parse_version(<<"5.0">>), + ?assertMatch(none, rebar_packages:find_highest_matching_(<<"goodpkg">>, <<"5.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State)), - {ok, Vsn3} = rebar_packages:find_highest_matching_(<<"goodpkg">>,rebar_verl:parse_version(<<"3.0.0-rc.0">>), + {ok, Vsn3} = rebar_packages:find_highest_matching_(<<"goodpkg">>, <<"== 3.0.0-rc.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertEqual({{3,0,0},{[<<"rc">>,0],[]}}, Vsn3). + ?assertMatch({3,0,0,[<<"rc">>,0],_}, Vsn3). %%%%%%%%%%%%%%% %%% Helpers %%% @@ -277,7 +277,8 @@ mock_config(Name, Config) -> lists:foreach(fun({{N, Vsn}, [Deps, InnerChecksum, OuterChecksum, _]}) -> case ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(N), Vsn, <<"hexpm">>}) of false -> - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), rebar_verl:parse_version(Vsn), <<"hexpm">>}, + V = rebar_verl:parse_as_matchable(Vsn), + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), V, <<"hexpm">>}, dependencies=Deps, retired=false, inner_checksum=InnerChecksum, diff --git a/apps/rebar/test/rebar_pkg_alias_SUITE.erl b/apps/rebar/test/rebar_pkg_alias_SUITE.erl index 94266d86b..060dd9e3b 100644 --- a/apps/rebar/test/rebar_pkg_alias_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_alias_SUITE.erl @@ -229,7 +229,7 @@ mock_config(Name, Config) -> lists:foreach(fun({{N, Vsn}, [Deps, Checksum, _]}) -> case ets:member(?PACKAGE_TABLE, {ec_cnv:to_binary(N), Vsn, <<"hexpm">>}) of false -> - ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), verl:parse(Vsn), <<"hexpm">>}, + ets:insert(?PACKAGE_TABLE, #package{key={ec_cnv:to_binary(N), rebar_verl:parse_as_matchable(Vsn), <<"hexpm">>}, dependencies=[{DAppName, {pkg, DN, DV, undefined}} || {DN, DV, _, DAppName} <- Deps], retired=false, outer_checksum=Checksum}); diff --git a/apps/rebar/test/rebar_pkg_repos_SUITE.erl b/apps/rebar/test/rebar_pkg_repos_SUITE.erl index 7a3b527cc..76b5f1de8 100644 --- a/apps/rebar/test/rebar_pkg_repos_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_repos_SUITE.erl @@ -379,14 +379,14 @@ organization_merging(_Config) -> use_first_repo_match(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"B">>, {{2,0,0}, {[],[]}}, Repo2}, + ?assertMatch({ok,{package,{<<"B">>, {2,0,0,[],_}, Repo2}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Repo2, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, rebar_packages:resolve_version(<<"B">>, <<"> 1.4.0">>, undefined, undefined, ?PACKAGE_TABLE, State)), - ?assertMatch({ok,{package,{<<"B">>, {{1,4,0}, {[],[]}}, Repo3}, + ?assertMatch({ok,{package,{<<"B">>, {1,4,0,[],_}, Repo3}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Repo3, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -397,7 +397,7 @@ use_first_repo_match(Config) -> use_exact_with_hash(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"C">>, {{1,3,1}, {[],[]}}, Repo2}, + ?assertMatch({ok,{package,{<<"C">>, {1,3,1,[],_}, Repo2}, <<"inner checksum">>, <<"good outer checksum">>, false, []}, #{name := Repo2, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -407,7 +407,7 @@ use_exact_with_hash(Config) -> fail_repo_update(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"B">>, {{1,4,0}, {[],[]}}, Repo3}, + ?assertMatch({ok,{package,{<<"B">>, {1,4,0,[],_}, Repo3}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Repo3, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -418,7 +418,7 @@ ignore_match_in_excluded_repo(Config) -> State = ?config(state, Config), Repos = ?config(repos, Config), - ?assertMatch({ok,{package,{<<"B">>, {{1,4,6}, {[],[]}}, Hexpm}, + ?assertMatch({ok,{package,{<<"B">>, {1,4,6,[],_}, Hexpm}, <<"inner checksum">>,<<"outer checksum">>, #{reason := 'RETIRED_INVALID'}, []}, #{name := Hexpm, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -426,7 +426,7 @@ ignore_match_in_excluded_repo(Config) -> ?PACKAGE_TABLE, State)), [_, Repo2 | _] = Repos, - ?assertMatch({ok,{package,{<<"A">>, {{0,1,1}, {[],[]}}, Repo2}, + ?assertMatch({ok,{package,{<<"A">>, {0,1,1,[],_}, Repo2}, <<"inner checksum">>, <<"good outer checksum">>, false, []}, #{name := Repo2, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -436,23 +436,23 @@ ignore_match_in_excluded_repo(Config) -> optional_prereleases(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"B">>, {{1,5,0}, {[],[]}}, Hexpm}, + ?assertMatch({ok,{package,{<<"B">>, {1,5,0,[],_}, Hexpm}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Hexpm, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, rebar_packages:resolve_version(<<"B">>, <<"~> 1.5.0">>, undefined, undefined, ?PACKAGE_TABLE, State)), - ?assertMatch({ok,{package,{<<"B">>, {{1,5,6}, {[<<"rc">>,0],[]}}, Hexpm}, - <<"inner checksum">>,<<"outer checksum">>, true, []}, - #{name := Hexpm, - http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, - rebar_packages:resolve_version(<<"B">>, <<"1.5.6-rc.0">>, <<"inner checksum">>, <<"outer checksum">>, - ?PACKAGE_TABLE, State)), + % ?assertMatch({ok,{package,{<<"B">>, {1,5,6,[<<"rc">>,0],_}, Hexpm}, + % <<"inner checksum">>,<<"outer checksum">>, true, []}, + % #{name := Hexpm, + % http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, + % rebar_packages:resolve_version(<<"B">>, <<"1.5.6-rc.0">>, <<"inner checksum">>, <<"outer checksum">>, + % ?PACKAGE_TABLE, State)), %% allow prerelease through configuration State1 = rebar_state:set(State, deps_allow_prerelease, true), - ?assertMatch({ok,{package,{<<"B">>, {{1,5,6}, {[<<"rc">>,0],[]}}, Hexpm}, + ?assertMatch({ok,{package,{<<"B">>, {1,5,6,[<<"rc">>,0],_}, Hexpm}, <<"inner checksum">>,<<"outer checksum">>, true, []}, #{name := Hexpm, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -472,7 +472,7 @@ setup_deps_and_repos(Deps, Repos) -> insert_deps(Deps) -> lists:foreach(fun({Name, Version, Repo, Retired}) -> ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - verl:parse(Version), + rebar_verl:parse_as_matchable(Version), rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired, @@ -480,7 +480,7 @@ insert_deps(Deps) -> outer_checksum = <<"outer checksum">>}); ({Name, Version, InnerChecksum, OuterChecksum, Repo, Retired}) -> ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - verl:parse(Version), + rebar_verl:parse_as_matchable(Version), rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired, From 2474a1d61577f4d66485b562d23fd5c5d7698575 Mon Sep 17 00:00:00 2001 From: Bunny Lushington Date: Tue, 25 Jul 2023 11:33:40 -0400 Subject: [PATCH 5/7] include verl in application enumeration (#1) --- apps/rebar/src/rebar.app.src.script | 1 + 1 file changed, 1 insertion(+) diff --git a/apps/rebar/src/rebar.app.src.script b/apps/rebar/src/rebar.app.src.script index ec2ee0ca1..794933976 100644 --- a/apps/rebar/src/rebar.app.src.script +++ b/apps/rebar/src/rebar.app.src.script @@ -28,6 +28,7 @@ relx, cf, inets, + verl, eunit_formatters % OTP 24 drops HiPE | [hipe || _ <- [application:load(dialyzer)], From 4423ece1abbf04d130fc4e779aaa555460b20ac5 Mon Sep 17 00:00:00 2001 From: Benedikt Reinartz Date: Wed, 31 May 2023 07:27:03 +0200 Subject: [PATCH 6/7] Revert "Improve verl handling of matchables (will be upstreamed)" This reverts commit 2e6ecee5ef594337b7471307e31dbfdd905dd565. --- vendor/verl/src/verl.erl | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/vendor/verl/src/verl.erl b/vendor/verl/src/verl.erl index 91b98f37b..f94f358cf 100644 --- a/vendor/verl/src/verl.erl +++ b/vendor/verl/src/verl.erl @@ -6,7 +6,6 @@ is_match/2, is_match/3, parse/1, - to_matchable/2, parse_requirement/1, compile_requirement/1 ]). @@ -36,7 +35,6 @@ pre => pre(), build => build() }. --type matchable() :: {major(), minor(), patch(), pre(), boolean()}. -type requirement_t() :: #{ string => requirement(), @@ -60,7 +58,6 @@ patch/0, pre/0, build/0, - matchable/0, version_t/0, requirement_t/0, compiled_requirement/0 @@ -72,11 +69,9 @@ %%% Compares two versions, returning whether the first argument is greater, equal, or %%% less than the second argument. %%% @end --spec compare(version() | matchable() | version_t(), version() | matchable() | version_t()) -> gt | eq | lt | {error, invalid_version}. -compare({_, _, _, _, _} = Version1, {_, _, _, _, _} = Version2) -> - ver_cmp(Version1, Version2); +-spec compare(version(), version()) -> gt | eq | lt | {error, invalid_version}. compare(Version1, Version2) -> - compare(to_matchable(Version1, true), to_matchable(Version2, true)). + ver_cmp(to_matchable(Version1, true), to_matchable(Version2, true)). %%% @doc %%% Parses a semantic version, returning {ok, version_t()} or {error, invalid_version} @@ -157,7 +152,6 @@ is_match(Version, #{matchspec := Spec, compiled := true} = R, Opts) when AllowPre = proplists:get_value(allow_pre, Opts, true), ets:match_spec_run([to_matchable(Version, AllowPre)], Spec) /= []. --spec to_matchable(version() | version_t(), boolean()) -> {_, _, _, _, _}. to_matchable(#{major := Major, minor := Minor, patch := Patch, pre := Pre}, AllowPre) -> {Major, Minor, Patch, Pre, AllowPre}; to_matchable(String, AllowPre) when is_binary(String) -> From c319c8d9a8cc79025547931dc5b58393eb697fe0 Mon Sep 17 00:00:00 2001 From: Benedikt Reinartz Date: Wed, 4 Oct 2023 15:25:08 +0200 Subject: [PATCH 7/7] Current state --- apps/rebar/src/rebar_packages.erl | 10 +++--- apps/rebar/src/rebar_verl.erl | 39 +++++++++++++++++++---- apps/rebar/test/rebar_pkg_SUITE.erl | 8 ++--- apps/rebar/test/rebar_pkg_repos_SUITE.erl | 32 +++++++++---------- 4 files changed, 57 insertions(+), 32 deletions(-) diff --git a/apps/rebar/src/rebar_packages.erl b/apps/rebar/src/rebar_packages.erl index 0f6ef4c34..b081d8106 100644 --- a/apps/rebar/src/rebar_packages.erl +++ b/apps/rebar/src/rebar_packages.erl @@ -60,11 +60,11 @@ get_all_names(State) -> ets:tid(), rebar_state:t()) -> [vsn()]. get_package_versions(Dep, DepVsn, Repo, Table, State) -> AllowPreRelease = rebar_state:get(State, deps_allow_prerelease, false), - #{matchspec := [{Head, [Match], _}]} = rebar_verl:parse_requirement(DepVsn), + {Head, Match} = rebar_verl:parse_req_as_matchspec(DepVsn), ?MODULE:verify_table(State), Vsns = ets:select(Table, [{#package{key={Dep, Head, Repo}, _='_'}, - [Match], [{Head}]}]), + [Match], [#{major => '$1', minor => '$2', patch => '$3', pre => '$4', build => '$5'}]}]), handle_vsns(Vsns, AllowPreRelease). -spec get_package(unicode:unicode_binary(), unicode:unicode_binary(), @@ -77,7 +77,7 @@ get_package(Dep, Vsn, Hash, Repos, Table, State) -> MatchSpec = case is_binary(Vsn) of true -> - #{matchspec := [{Head, [Match], _}]} = rebar_verl:parse_requirement(Vsn), + {Head, Match} = rebar_verl:parse_req_as_matchspec(Vsn), [{#package{key={Dep, Head, Repo}, _='_'}, [Match], ['$_']} || Repo <- Repos]; false -> [{#package{key={Dep, Vsn, Repo}, _='_'}, [], ['$_']} || Repo <- Repos] @@ -102,7 +102,7 @@ get_package(Dep, Vsn, Hash, Repos, Table, State) -> PackagesWithProperHash; false -> lists:filter( - fun(#package{key = {_, {_, _, _, Pre, _}, _}}) -> + fun(#package{key = {_, {{_, _, _}, {Pre, _}}, _}}) -> Pre =:= [] end, PackagesWithProperHash @@ -226,7 +226,7 @@ handle_vsns(Vsns, AllowPreRelease) -> Vsn = lists:foldl( fun(Version, Highest) when AllowPreRelease orelse length(element(4, Version)) =:= 0 -> - case (Highest =:= none orelse verl:compare(Version, Highest) =:= gt) of + case (Highest =:= none orelse rebar_verl:compare(Version, Highest) =:= gt) of true -> Version; false -> diff --git a/apps/rebar/src/rebar_verl.erl b/apps/rebar/src/rebar_verl.erl index 0020b1341..43a10b74e 100644 --- a/apps/rebar/src/rebar_verl.erl +++ b/apps/rebar/src/rebar_verl.erl @@ -4,11 +4,19 @@ -export([ parse_requirement/1, + parse_req_as_matchspec/1, valid_requirement/1, parse_as_matchable/1, + compare/2, format_version/1 ]). +-type version() :: ec_semver:semver(). + +-export_type([ + version/0 + ]). + parse_requirement(Vsn) -> Vsn1 = case verl:parse(Vsn) of @@ -25,6 +33,10 @@ parse_requirement(Vsn) -> error({Error, Vsn1}) end. +parse_req_as_matchspec(Req) -> + #{matchspec := [{_Head, [Match], _}]} = parse_requirement(Req), + {{{'$1', '$2', '$3'}, {'$4', '$5'}}, Match}. + valid_requirement(Vsn) -> case verl:parse(Vsn) of {ok, _} -> @@ -42,17 +54,30 @@ parse_as_matchable(Vsn) when is_list(Vsn) -> parse_as_matchable(list_to_binary(Vsn)); parse_as_matchable(Vsn) -> case verl:parse(Vsn) of - {ok, Res} -> - verl:to_matchable(Res, true); + {ok, VerlVsn} -> + to_matchable(VerlVsn); {error, Error} -> error({Error, Vsn}) end. -format_version(Binary) when is_binary(Binary) -> - Binary; -format_version({Major, Minor, Patch, Pre, _}) -> - format_version(#{major => Major, minor => Minor, patch => Patch, pre => Pre, build => undefined}); -format_version(#{major := Major, minor := Minor, patch := Patch, pre := Pre, build := Build}) -> +to_matchable(#{major := Major, minor := Minor, patch := Patch, pre := Pre, build := _Build}) -> + {{Major, Minor, Patch}, {Pre, true}}. + +to_verl_vsn(Bin) when is_binary(Bin) -> + {ok, Vsn} = verl:parse(Bin), + Vsn; +to_verl_vsn({{Major, Minor, Patch}, {Pre, Build}}) -> + #{major => Major, minor => Minor, patch => Patch, pre => Pre, build => Build}; +to_verl_vsn(Map) when is_map(Map) -> + Map. + +compare(V1, V2) -> + verl:compare(to_verl_vsn(V1), to_verl_vsn(V2)). + +format_version(Vsn) -> + #{major := Major, minor := Minor, patch := Patch, pre := Pre, build := Build} = + to_verl_vsn(Vsn), + Base = io_lib:format("~p.~p.~p", [Major, Minor, Patch]), WithPre = case Pre of [] -> diff --git a/apps/rebar/test/rebar_pkg_SUITE.erl b/apps/rebar/test/rebar_pkg_SUITE.erl index 55f0c62f3..dcfb4b6c5 100644 --- a/apps/rebar/test/rebar_pkg_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_SUITE.erl @@ -232,13 +232,13 @@ find_highest_matching(_Config) -> State = rebar_state:new(), {ok, Vsn} = rebar_packages:find_highest_matching_( <<"goodpkg">>, <<"~> 1.0.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertMatch({1,0,1,[],_}, Vsn), + ?assertMatch({{1,0,1},{[],_}}, Vsn), {ok, Vsn1} = rebar_packages:find_highest_matching( <<"goodpkg">>, <<"~> 1.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertMatch({1,1,1,[],_}, Vsn1), + ?assertMatch({{1,1,1},{[],_}}, Vsn1), {ok, Vsn2} = rebar_packages:find_highest_matching( <<"goodpkg">>, <<"~> 2.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertMatch({2,0,0,[],_}, Vsn2), + ?assertMatch({{2,0,0},{[],_}}, Vsn2), %% regression test. ~> constraints higher than the available packages would result %% in returning the first package version instead of 'none'. @@ -248,7 +248,7 @@ find_highest_matching(_Config) -> {ok, Vsn3} = rebar_packages:find_highest_matching_(<<"goodpkg">>, <<"== 3.0.0-rc.0">>, #{name => <<"hexpm">>}, ?PACKAGE_TABLE, State), - ?assertMatch({3,0,0,[<<"rc">>,0],_}, Vsn3). + ?assertMatch({{3,0,0},{[<<"rc">>,0],_}}, Vsn3). %%%%%%%%%%%%%%% %%% Helpers %%% diff --git a/apps/rebar/test/rebar_pkg_repos_SUITE.erl b/apps/rebar/test/rebar_pkg_repos_SUITE.erl index 76b5f1de8..1a29fc63d 100644 --- a/apps/rebar/test/rebar_pkg_repos_SUITE.erl +++ b/apps/rebar/test/rebar_pkg_repos_SUITE.erl @@ -379,14 +379,14 @@ organization_merging(_Config) -> use_first_repo_match(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"B">>, {2,0,0,[],_}, Repo2}, + ?assertMatch({ok,{package,{<<"B">>, {{2,0,0}, {[],[]}}, Repo2}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Repo2, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, rebar_packages:resolve_version(<<"B">>, <<"> 1.4.0">>, undefined, undefined, ?PACKAGE_TABLE, State)), - ?assertMatch({ok,{package,{<<"B">>, {1,4,0,[],_}, Repo3}, + ?assertMatch({ok,{package,{<<"B">>, {{1,4,0}, {[],[]}}, Repo3}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Repo3, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -397,7 +397,7 @@ use_first_repo_match(Config) -> use_exact_with_hash(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"C">>, {1,3,1,[],_}, Repo2}, + ?assertMatch({ok,{package,{<<"C">>, {{1,3,1}, {[],[]}}, Repo2}, <<"inner checksum">>, <<"good outer checksum">>, false, []}, #{name := Repo2, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -407,7 +407,7 @@ use_exact_with_hash(Config) -> fail_repo_update(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"B">>, {1,4,0,[],_}, Repo3}, + ?assertMatch({ok,{package,{<<"B">>, {{1,4,0}, {[],[]}}, Repo3}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Repo3, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -418,7 +418,7 @@ ignore_match_in_excluded_repo(Config) -> State = ?config(state, Config), Repos = ?config(repos, Config), - ?assertMatch({ok,{package,{<<"B">>, {1,4,6,[],_}, Hexpm}, + ?assertMatch({ok,{package,{<<"B">>, {{1,4,6}, {[],[]}}, Hexpm}, <<"inner checksum">>,<<"outer checksum">>, #{reason := 'RETIRED_INVALID'}, []}, #{name := Hexpm, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -426,7 +426,7 @@ ignore_match_in_excluded_repo(Config) -> ?PACKAGE_TABLE, State)), [_, Repo2 | _] = Repos, - ?assertMatch({ok,{package,{<<"A">>, {0,1,1,[],_}, Repo2}, + ?assertMatch({ok,{package,{<<"A">>, {{0,1,1}, {[],[]}}, Repo2}, <<"inner checksum">>, <<"good outer checksum">>, false, []}, #{name := Repo2, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -436,23 +436,23 @@ ignore_match_in_excluded_repo(Config) -> optional_prereleases(Config) -> State = ?config(state, Config), - ?assertMatch({ok,{package,{<<"B">>, {1,5,0,[],_}, Hexpm}, + ?assertMatch({ok,{package,{<<"B">>, {{1,5,0}, {[],[]}}, Hexpm}, <<"inner checksum">>,<<"outer checksum">>, false, []}, #{name := Hexpm, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, rebar_packages:resolve_version(<<"B">>, <<"~> 1.5.0">>, undefined, undefined, ?PACKAGE_TABLE, State)), - % ?assertMatch({ok,{package,{<<"B">>, {1,5,6,[<<"rc">>,0],_}, Hexpm}, - % <<"inner checksum">>,<<"outer checksum">>, true, []}, - % #{name := Hexpm, - % http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, - % rebar_packages:resolve_version(<<"B">>, <<"1.5.6-rc.0">>, <<"inner checksum">>, <<"outer checksum">>, - % ?PACKAGE_TABLE, State)), + ?assertMatch({ok,{package,{<<"B">>, {{1,5,6}, {[<<"rc">>,0],[]}}, Hexpm}, + <<"inner checksum">>,<<"outer checksum">>, true, []}, + #{name := Hexpm, + http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, + rebar_packages:resolve_version(<<"B">>, <<"1.5.6-rc.0">>, <<"inner checksum">>, <<"outer checksum">>, + ?PACKAGE_TABLE, State)), %% allow prerelease through configuration State1 = rebar_state:set(State, deps_allow_prerelease, true), - ?assertMatch({ok,{package,{<<"B">>, {1,5,6,[<<"rc">>,0],_}, Hexpm}, + ?assertMatch({ok,{package,{<<"B">>, {{1,5,6}, {[<<"rc">>,0],[]}}, Hexpm}, <<"inner checksum">>,<<"outer checksum">>, true, []}, #{name := Hexpm, http_adapter := {rebar_httpc_adapter, #{profile := rebar}}}}, @@ -472,7 +472,7 @@ setup_deps_and_repos(Deps, Repos) -> insert_deps(Deps) -> lists:foreach(fun({Name, Version, Repo, Retired}) -> ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - rebar_verl:parse_as_matchable(Version), + ec_semver:parse(Version), rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired, @@ -480,7 +480,7 @@ insert_deps(Deps) -> outer_checksum = <<"outer checksum">>}); ({Name, Version, InnerChecksum, OuterChecksum, Repo, Retired}) -> ets:insert(?PACKAGE_TABLE, #package{key={rebar_utils:to_binary(Name), - rebar_verl:parse_as_matchable(Version), + ec_semver:parse(Version), rebar_utils:to_binary(Repo)}, dependencies=[], retired=Retired,