Skip to content

Commit

Permalink
Abort when file:consult/1 returns an error
Browse files Browse the repository at this point in the history
 - Modified rebar_hex_repos:auth_config/1 to abort on error except in
 the case of enoent, in which we return an empty map.
 - added auth_config_errors test to test/rebar_pkg_repos_SUITE
  • Loading branch information
Bryan Paxton committed Feb 19, 2019
1 parent 80c8417 commit ac59e14
Show file tree
Hide file tree
Showing 2 changed files with 53 additions and 6 deletions.
18 changes: 14 additions & 4 deletions src/rebar_hex_repos.erl
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@

-ifdef(TEST).
%% exported for test purposes
-export([repos/1, merge_repos/1]).
-export([repos/1, merge_repos/1, auth_config_file/1]).
-endif.

-include("rebar.hrl").
Expand Down Expand Up @@ -136,11 +136,21 @@ auth_config_file(State) ->

-spec auth_config(rebar_state:t()) -> map().
auth_config(State) ->
case file:consult(auth_config_file(State)) of
AuthFile = auth_config_file(State),
case file:consult(AuthFile) of
{ok, [Config]} ->
Config;
_ ->
#{}
{error, Reason} when is_atom(Reason) ->
case Reason of
enoent ->
#{};
_ ->
% TODO: map to an english reason
?ABORT("Error reading repos auth config (~ts) : ~ts", [AuthFile, atom_to_list(Reason)])
end;
{error, {_Line, _Mod, _Term} = Err} ->
Reason = file:format_error(Err),
?ABORT("Error found in repos auth config (~ts) at line ~ts", [AuthFile, Reason])
end.

-spec update_auth_config(map(), rebar_state:t()) -> ok.
Expand Down
41 changes: 39 additions & 2 deletions test/rebar_pkg_repos_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@

all() ->
[default_repo, repo_merging, repo_replacing,
auth_merging, organization_merging, {group, resolve_version}].
auth_merging, auth_config_errors, organization_merging, {group, resolve_version}].

groups() ->
[{resolve_version, [use_first_repo_match, use_exact_with_hash, fail_repo_update,
Expand Down Expand Up @@ -119,7 +119,8 @@ init_per_testcase(optional_prereleases, Config) ->
fun(_State) -> true end),

[{state, State} | Config];
init_per_testcase(auth_merging, Config) ->
init_per_testcase(Case, Config) when Case =:= auth_merging ;
Case =:= auth_config_errors ->
meck:new(file, [passthrough, no_link, unstick]),
meck:new(rebar_packages, [passthrough, no_link]),
Config;
Expand All @@ -131,6 +132,7 @@ init_per_testcase(_, Config) ->
Config.

end_per_testcase(Case, _Config) when Case =:= auth_merging ;
Case =:= auth_config_errors ;
Case =:= organization_merging ->
meck:unload(file),
meck:unload(rebar_packages);
Expand Down Expand Up @@ -234,6 +236,41 @@ auth_merging(_Config) ->

ok.

auth_config_errors(_Config) ->
Repo1 = #{name => <<"repo-1">>,
api_url => <<"repo-1/api">>},
Repo2 = #{name => <<"repo-2">>,
repo_url => <<"repo-2/repo">>,
repo_verify => false},

State = rebar_state:new([{hex, [{repos, [Repo1, Repo2]}]}]),
meck:expect(file, consult,
fun(_) ->
{error, {3,erl_parse,["syntax error before: ","'=>'"]}}
end),

?assertThrow(rebar_abort, rebar_pkg_resource:init(pkg, State)),
meck:expect(file, consult,
fun(_) ->
{error, enoent}
end),


{ok, #resource{state=#{ repos := [
UpdatedRepo1,
UpdatedRepo2,
DefaultRepo
]}}} = rebar_pkg_resource:init(pkg, State),

?assertEqual(undefined, maps:get(write_key, UpdatedRepo1, undefined)),
?assertEqual(undefined, maps:get(read_key, UpdatedRepo1, undefined)),
?assertEqual(undefined, maps:get(repos_key, UpdatedRepo1, undefined)),
?assertEqual(undefined, maps:get(write_key, UpdatedRepo2, undefined)),
?assertEqual(undefined, maps:get(repos_key, UpdatedRepo2, undefined)),
?assertEqual(undefined, maps:get(read_key, UpdatedRepo2, undefined)),
?assertEqual(undefined, maps:get(write_key, DefaultRepo, undefined)),
ok.

organization_merging(_Config) ->
Repo1 = #{name => <<"hexpm:repo-1">>,
api_url => <<"repo-1/api">>},
Expand Down

0 comments on commit ac59e14

Please sign in to comment.