From 0c3e63efe7279279f00c2f0878431e4c4bf96e85 Mon Sep 17 00:00:00 2001 From: Richard Kallos Date: Tue, 4 May 2021 18:38:01 -0400 Subject: [PATCH] Support sys.config.src in common test --- src/rebar_file_utils.erl | 79 +++++++++++++++++++++++++++++---- src/rebar_prv_common_test.erl | 16 ++++++- src/rebar_prv_eunit.erl | 3 +- src/rebar_prv_shell.erl | 62 ++++---------------------- test/rebar_ct_SUITE.erl | 12 ++++- test/rebar_file_utils_SUITE.erl | 21 +++++++-- 6 files changed, 126 insertions(+), 67 deletions(-) diff --git a/src/rebar_file_utils.erl b/src/rebar_file_utils.erl index 425f4c520..d16877122 100644 --- a/src/rebar_file_utils.erl +++ b/src/rebar_file_utils.erl @@ -28,6 +28,7 @@ -export([try_consult/1, consult_config/2, + consult_env_config/2, consult_config_terms/2, format_error/1, symlink_or_copy/2, @@ -72,15 +73,75 @@ try_consult(File) -> %% @doc Parse a sys.config file and return the configuration terms %% for all its potentially nested configs. --spec consult_config(rebar_state:t(), string()) -> [[tuple()]]. -consult_config(State, Filename) -> - Fullpath = filename:join(rebar_dir:root_dir(State), Filename), +-spec consult_config(file:filename(), string()) -> [[tuple()]]. +consult_config(RootDir, Filename) -> + Fullpath = join_if_relative_path(RootDir, Filename), ?DEBUG("Loading configuration from ~p", [Fullpath]), Config = case try_consult(Fullpath) of [T] -> T; [] -> [] end, - consult_config_terms(State, Config). + consult_config_terms(RootDir, Config). + +%% @doc Parse a sys.config.src file and return the configuration terms +%% for all its potentially nested configs. +-spec consult_env_config(file:filename(), file:filename()) -> [[tuple()]]. +consult_env_config(RootDir, Filename) -> + Fullpath = join_if_relative_path(RootDir, Filename), + RawString = case file:read_file(Fullpath) of + {error, _} -> "[]."; + {ok, Bin} -> unicode:characters_to_list(Bin) + end, + ReplacedStr = replace_env_vars(RawString), + case rebar_string:consult(unicode:characters_to_list(ReplacedStr)) of + {error, Reason} -> + throw(?PRV_ERROR({bad_term_file, Filename, Reason})); + [Terms] -> + consult_config_terms(RootDir, Terms) + end. + +-spec join_if_relative_path(file:filename(), file:filename()) -> file:filename(). +join_if_relative_path(Dir, Path) -> + case filename:pathtype(Path) of + absolute -> Path; + _ -> filename:join(Dir, Path) + end. + +%% @doc quick and simple variable substitution writeup. +%% Supports `${varname}' but not `$varname' nor nested +%% values such as `${my_${varname}}'. +%% The variable are also defined as only supporting +%% the form `[a-zA-Z_]+[a-zA-Z0-9_]*' as per the POSIX +%% standard. +-spec replace_env_vars(string()) -> unicode:charlist(). +replace_env_vars("") -> ""; +replace_env_vars("${" ++ Str) -> + case until_var_end(Str) of + {ok, VarName, Rest} -> + replace_varname(VarName) ++ replace_env_vars(Rest); + error -> + "${" ++ replace_env_vars(Str) + end; +replace_env_vars([Char|Str]) -> + [Char | replace_env_vars(Str)]. + +until_var_end(Str) -> + case re:run(Str, "([a-zA-Z_]+[a-zA-Z0-9_]*)}", [{capture, [1], list}]) of + nomatch -> + error; + {match, [Name]} -> + {ok, Name, drop_varname(Name, Str)} + end. + +replace_varname(Var) -> + %% os:getenv(Var, "") is only available in OTP-18.0 + case os:getenv(Var) of + false -> ""; + Val -> Val + end. + +drop_varname("", "}" ++ Str) -> Str; +drop_varname([_|Var], [_|Str]) -> drop_varname(Var, Str). %% @doc From a parsed sys.config file, expand all the terms to include %% its potential nested configs. It is also possible that no sub-terms @@ -91,13 +152,15 @@ consult_config(State, Filename) -> %% and evaluation of 'sys.config.src' files, giving a way to handle %% expansion that is separate from regular config handling. -spec consult_config_terms(rebar_state:t(), [tuple()]) -> [[tuple()]]. -consult_config_terms(State, Config) -> +consult_config_terms(RootDir, Config) -> JoinedConfig = lists:flatmap( fun (SubConfig) when is_list(SubConfig) -> - case lists:suffix(".config", SubConfig) of + T = {lists:suffix(".config", SubConfig), lists:suffix(".config.src", SubConfig)}, + case T of %% since consult_config returns a list in a list we take the head here - false -> hd(consult_config(State, SubConfig ++ ".config")); - true -> hd(consult_config(State, SubConfig)) + {false, false} -> hd(consult_config(RootDir, SubConfig ++ ".config")); + {true, _} -> hd(consult_config(RootDir, SubConfig)); + {_, true} -> hd(consult_env_config(RootDir, SubConfig)) end; (Entry) -> [Entry] end, Config), diff --git a/src/rebar_prv_common_test.erl b/src/rebar_prv_common_test.erl index 00e970cbf..7f4b646aa 100644 --- a/src/rebar_prv_common_test.erl +++ b/src/rebar_prv_common_test.erl @@ -304,8 +304,10 @@ select_tests(_, _, _, {error, _} = Error) -> Error; select_tests(State, ProjectApps, CmdOpts, CfgOpts) -> %% set application env if sys_config argument is provided SysConfigs = sys_config_list(CmdOpts, CfgOpts), + _ = rebar_prv_shell:maybe_set_env_vars(State, ct_opts), + RootDir = rebar_dir:root_dir(State), Configs = lists:flatmap(fun(Filename) -> - rebar_file_utils:consult_config(State, Filename) + consult_config(RootDir, Filename) end, SysConfigs), %% NB: load the applications (from user directories too) to support OTP < 17 %% to our best ability. @@ -316,6 +318,18 @@ select_tests(State, ProjectApps, CmdOpts, CfgOpts) -> Opts = merge_opts(CmdOpts,CfgOpts), discover_tests(State, ProjectApps, Opts). +consult_config(RootDir, Filename) -> + case is_src_config(Filename) of + false -> + rebar_file_utils:consult_config(RootDir, Filename); + true -> + rebar_file_utils:consult_env_config(RootDir, Filename) + end. + +-spec is_src_config(file:filename()) -> boolean(). +is_src_config(Filename) -> + filename:extension(Filename) =:= ".src". + %% Merge the option lists from command line and rebar.config: %% %% - Options set on the command line will replace the same options if diff --git a/src/rebar_prv_eunit.erl b/src/rebar_prv_eunit.erl index de23aa776..3f53c0f2d 100644 --- a/src/rebar_prv_eunit.erl +++ b/src/rebar_prv_eunit.erl @@ -515,8 +515,9 @@ apply_sys_config(State) -> proplists:get_value(sys_config, RawOpts, ""), [$,] ) ++ CfgSysCfg, + RootDir = rebar_dir:root_dir(State), Configs = lists:flatmap( - fun(Filename) -> rebar_file_utils:consult_config(State, Filename) end, + fun(Filename) -> rebar_file_utils:consult_config(RootDir, Filename) end, SysCfgs ), %% NB: load the applications (from user directories too) to support OTP < 17 diff --git a/src/rebar_prv_shell.erl b/src/rebar_prv_shell.erl index d4b1bc04b..eed9cdf45 100644 --- a/src/rebar_prv_shell.erl +++ b/src/rebar_prv_shell.erl @@ -35,6 +35,8 @@ do/1, format_error/1]). +-export([maybe_set_env_vars/2]). + -include("rebar.hrl"). -include_lib("providers/include/providers.hrl"). @@ -513,6 +515,7 @@ add_test_paths(State) -> % First try the --config flag, then try the relx sys_config -spec find_config(rebar_state:t()) -> [[tuple()]] | no_config. find_config(State) -> + RootDir = rebar_dir:root_dir(State), case first_value([fun find_config_option/1, fun find_config_rebar/1, fun find_config_relx/1], State) of @@ -521,9 +524,9 @@ find_config(State) -> Filename when is_list(Filename) -> case is_src_config(Filename) of false -> - rebar_file_utils:consult_config(State, Filename); + rebar_file_utils:consult_config(RootDir, Filename); true -> - consult_env_config(State, Filename) + rebar_file_utils:consult_env_config(RootDir, Filename) end end. @@ -578,22 +581,11 @@ find_config_relx(State) -> is_src_config(Filename) -> filename:extension(Filename) =:= ".src". --spec consult_env_config(rebar_state:t(), file:filename()) -> [[tuple()]]. -consult_env_config(State, Filename) -> - RawString = case file:read_file(Filename) of - {error, _} -> "[]."; - {ok, Bin} -> unicode:characters_to_list(Bin) - end, - ReplacedStr = replace_env_vars(RawString), - case rebar_string:consult(unicode:characters_to_list(ReplacedStr)) of - {error, Reason} -> - throw(?PRV_ERROR({bad_term_file, Filename, Reason})); - [Terms] -> - rebar_file_utils:consult_config_terms(State, Terms) - end. - maybe_set_env_vars(State) -> - EnvFile =debug_get_value(env_file, rebar_state:get(State, shell, []), undefined, + maybe_set_env_vars(State, shell). + +maybe_set_env_vars(State, Group) -> + EnvFile = debug_get_value(env_file, rebar_state:get(State, Group, []), undefined, "Found env_file from config."), {Opts, _} = rebar_state:command_parsed_args(State), EnvFile1 = debug_get_value(env_file, Opts, EnvFile, @@ -630,39 +622,3 @@ maybe_read_file(undefined) -> ignore; maybe_read_file(EnvFile) -> file:read_file(EnvFile). - -%% @doc quick and simple variable substitution writeup. -%% Supports `${varname}' but not `$varname' nor nested -%% values such as `${my_${varname}}'. -%% The variable are also defined as only supporting -%% the form `[a-zA-Z_]+[a-zA-Z0-9_]*' as per the POSIX -%% standard. --spec replace_env_vars(string()) -> unicode:charlist(). -replace_env_vars("") -> ""; -replace_env_vars("${" ++ Str) -> - case until_var_end(Str) of - {ok, VarName, Rest} -> - replace_varname(VarName) ++ replace_env_vars(Rest); - error -> - "${" ++ replace_env_vars(Str) - end; -replace_env_vars([Char|Str]) -> - [Char | replace_env_vars(Str)]. - -until_var_end(Str) -> - case re:run(Str, "([a-zA-Z_]+[a-zA-Z0-9_]*)}", [{capture, [1], list}]) of - nomatch -> - error; - {match, [Name]} -> - {ok, Name, drop_varname(Name, Str)} - end. - -replace_varname(Var) -> - %% os:getenv(Var, "") is only available in OTP-18.0 - case os:getenv(Var) of - false -> ""; - Val -> Val - end. - -drop_varname("", "}" ++ Str) -> Str; -drop_varname([_|Var], [_|Str]) -> drop_varname(Var, Str). diff --git a/test/rebar_ct_SUITE.erl b/test/rebar_ct_SUITE.erl index ba59af9c5..9965245fd 100644 --- a/test/rebar_ct_SUITE.erl +++ b/test/rebar_ct_SUITE.erl @@ -1158,6 +1158,10 @@ cmd_sys_config(Config) -> ok = filelib:ensure_dir(OtherCfgFile), ok = file:write_file(OtherCfgFile, other_sys_config_file(AppName)), + SrcCfgFile = filename:join([AppDir, "config", "source.config.src"]), + ok = filelib:ensure_dir(SrcCfgFile), + ok = file:write_file(SrcCfgFile, cfg_sys_src_config_file(AppName, "MyExpectedString")), + RebarConfig = [{ct_opts, [{sys_config, CfgFile}]}], {ok, State1} = rebar_test_utils:run_and_check(Config, RebarConfig, ["as", "test", "lock"], return), @@ -1166,6 +1170,8 @@ cmd_sys_config(Config) -> ?assertEqual({ok, other_cfg_value}, application:get_env(AppName, other_key)), + ?assertEqual({ok, "MyExpectedString"}, application:get_env(AppName, src_key)), + Providers = rebar_state:providers(State1), Namespace = rebar_state:namespace(State1), CommandProvider = providers:get_provider(ct, Providers, Namespace), @@ -1674,7 +1680,11 @@ cmd_sys_config_file(AppName) -> io_lib:format("[{~ts, [{key, cmd_value}]}].", [AppName]). cfg_sys_config_file(AppName) -> - io_lib:format("[{~ts, [{key, cfg_value}]}, \"config/other\"].", [AppName]). + io_lib:format("[{~ts, [{key, cfg_value}]}, \"config/other\", \"config/source.config.src\"].", [AppName]). other_sys_config_file(AppName) -> io_lib:format("[{~ts, [{other_key, other_cfg_value}]}].", [AppName]). + +cfg_sys_src_config_file(AppName, ExpectedValue) -> + os:putenv("SRC_VALUE", ExpectedValue), + io_lib:format("[{~ts, [{src_key, \"${SRC_VALUE}\"}]}].", [AppName]). diff --git a/test/rebar_file_utils_SUITE.erl b/test/rebar_file_utils_SUITE.erl index d771a82fa..09c8a3607 100644 --- a/test/rebar_file_utils_SUITE.erl +++ b/test/rebar_file_utils_SUITE.erl @@ -25,7 +25,8 @@ mv_file_diff/1, mv_file_dir_same/1, mv_file_dir_diff/1, - mv_no_clobber/1]). + mv_no_clobber/1, + consult_env_config/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("eunit/include/eunit.hrl"). @@ -42,7 +43,8 @@ all() -> normalized_path, resolve_link, split_dirname, - mv_warning_is_ignored]. + mv_warning_is_ignored, + consult_env_config]. groups() -> [{tmpdir, [], [raw_tmpdir, empty_tmpdir, simple_tmpdir, multi_tmpdir]}, @@ -57,9 +59,10 @@ init_per_group(_, Config) -> Config. end_per_group(_, Config) -> Config. init_per_testcase(Test, Config) -> + ExcludedInWin32 = [resolve_link, mv_warning_is_ignored, consult_env_config], case os:type() of {win32, _} -> - case lists:member(Test, [resolve_link, mv_warning_is_ignored]) of + case lists:member(Test, ExcludedInWin32) of true -> {skip, "broken in windows"}; false -> Config end; @@ -361,6 +364,18 @@ mv_no_clobber(Config) -> ?assertEqual({ok, <<"wrong-data">>}, file:read_file(DstBad)), ok. +consult_env_config(Config) -> + PrivDir = ?config(priv_dir, Config), + BaseDir = mk_base_dir(PrivDir, consult_env_config), + ?assert(filelib:is_dir(BaseDir)), + F = filename:join(BaseDir, "config.src"), + Str = "[{foo, \"${FOO}\"}, {bar, \"${BAR}\"}].", + file:write_file(F, Str), + EnvPairs = [{"FOO", "I am foo"}, {"BAR", "I am bar"}], + [os:putenv(Var, Val) || {Var, Val} <- EnvPairs], + Expected = [{foo, "I am foo"}, {bar, "I am bar"}], + [Actual] = rebar_file_utils:consult_env_config(BaseDir, F), + ?assertEqual(Expected, Actual). mk_base_dir(BasePath, Name) -> {_,_,Micro} = os:timestamp(),