Skip to content

Commit 8280605

Browse files
committed
implements #189
1 parent bdf014b commit 8280605

File tree

1 file changed

+170
-3
lines changed

1 file changed

+170
-3
lines changed

src/imem_compiler.erl

+170-3
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,7 @@
11
-module(imem_compiler).
22
-include("imem_seco.hrl").
33

4-
-export([compile/1, compile/2, safe/1]).
5-
4+
-export([compile/1, compile/2, compile_mod/1, safe/1, format_error/1]).
65

76
% erlang:_/0
87
-safe([now/0, date/0, registered/0]).
@@ -133,12 +132,123 @@ nonLocalHFun({Mod, Fun} = FSpec, Args, SafeFuns) ->
133132
end
134133
end.
135134

135+
compile_mod(ModuleCodeBinStr) when is_binary(ModuleCodeBinStr) ->
136+
case erl_scan:string(binary_to_list(ModuleCodeBinStr)) of
137+
{ok, Tokens, _} ->
138+
TokenGroups = cut_dot(Tokens),
139+
case lists:foldl(
140+
fun(TokenGroup, Acc) when is_list(Acc) ->
141+
case erl_parse:parse_form(TokenGroup) of
142+
{ok, AbsForm} -> [AbsForm | Acc];
143+
{error, ErrorInfo} ->
144+
{error, #{error => [error_info(ErrorInfo)],
145+
warning => []}}
146+
end;
147+
(_, Error) -> Error
148+
end, [], TokenGroups) of
149+
Forms when is_list(Forms) ->
150+
case security_check(Forms) of
151+
List when is_list(List) ->
152+
case compile:forms(Forms, [return]) of
153+
error -> {error, #{error => <<"unknown">>}};
154+
{ok, _Module, Bin} -> {ok, Bin};
155+
{ok, _Module, Bin, []} -> {ok, Bin};
156+
{ok, _Module, Bin, Warnings} ->
157+
{warning, Bin, #{error => [],
158+
warning => error_info(Warnings)}};
159+
{error, Errors, []} ->
160+
{error, #{error => error_info(Errors),
161+
warning => []}};
162+
{error, Errors, Warnings} ->
163+
{error, #{error => error_info(Errors),
164+
warning => error_info(Warnings)}}
165+
end;
166+
{error, Errors} ->
167+
{error, #{error => error_info(Errors), warning => []}}
168+
end;
169+
Error -> Error
170+
end;
171+
{error, ErrorInfo, ErrorLocation} ->
172+
{error, {scan, ErrorInfo, ErrorLocation}}
173+
end.
174+
175+
cut_dot(Tokens) -> cut_dot(Tokens, [[]]).
176+
cut_dot([], [[]|Acc]) -> cut_dot([], Acc);
177+
cut_dot([], Acc) -> Acc;
178+
cut_dot([{dot,_} = Dot | Tokens], [A | Rest]) ->
179+
cut_dot(Tokens, [[], lists:reverse([Dot | A]) | Rest]);
180+
cut_dot([T | Tokens], [A | Rest]) -> cut_dot(Tokens, [[T | A] | Rest]).
181+
182+
error_info([]) -> [];
183+
error_info([{_, _, _} = ErrorInfo | ErrorInfos]) ->
184+
[error_info(ErrorInfo) | error_info(ErrorInfos)];
185+
error_info([{_,ErrorInfos}|Tail]) ->
186+
error_info(ErrorInfos) ++ error_info(Tail);
187+
error_info({Line, Module, ErrorDesc}) ->
188+
#{
189+
line => Line,
190+
msg => list_to_binary(Module:format_error(ErrorDesc))
191+
}.
192+
193+
format_error([]) -> [];
194+
format_error([H | T]) when is_list(H) -> [H | format_error(T)];
195+
format_error([H | T]) -> [io_lib:format("~p", [H]) | format_error(T)].
196+
197+
security_check(Forms) ->
198+
Safe = lists:usort(
199+
safe(?MODULE) ++
200+
[{'$local_mod', Fun, Arity}
201+
|| {function, _, Fun, Arity, _Body} <- Forms]),
202+
security_check(Forms, Safe).
203+
security_check(_, {error, _} = Error) -> Error;
204+
security_check([], Safe) -> Safe;
205+
security_check([{attribute, _, _, _} | Forms], Safe) -> security_check(Forms, Safe);
206+
security_check([{function, _, _Fun, _Arity, Body} | Forms], Safe) ->
207+
security_check(Forms, security_check(Body, Safe));
208+
security_check([Form | Forms], Safe) ->
209+
security_check(Forms, security_check(Form, Safe));
210+
security_check(Form, Safe) when is_tuple(Form) ->
211+
case Form of
212+
{call, Line, {remote,_,{atom,_,Mod},{atom,_,Fun}}, Args} ->
213+
safety_check(Form, Line, Mod, Fun, Args, Safe);
214+
{call, Line, {atom,_,Fun}, Args} ->
215+
safety_check(Form, Line, '$local_mod', Fun, Args, Safe);
216+
_ ->
217+
security_check(tuple_to_list(Form), Safe)
218+
end;
219+
security_check(_, Safe) -> Safe.
220+
221+
safety_check(Form, Line, Mod, Fun, Args, Safe) ->
222+
case is_safe(Mod, Fun, Args, Safe) of
223+
true ->
224+
security_check(
225+
tuple_to_list(Form),
226+
lists:usort([Mod, Fun, length(Args) | Safe])
227+
);
228+
false ->
229+
NewMod = if Mod == '$local_mod' -> erlang; true -> Mod end,
230+
case {catch safe(NewMod), lists:keymember(NewMod, 1, Safe)} of
231+
{{'EXIT', {undef, _}}, _} -> Safe;
232+
{ModSafe, false} when is_list(ModSafe), length(ModSafe) > 0 ->
233+
safety_check(Form, Line, NewMod, Fun, Args,
234+
lists:usort(ModSafe ++ Safe));
235+
_ ->
236+
{error, [{Line, ?MODULE,
237+
["unsafe function call ",
238+
NewMod, ":", Fun, "/", length(Args)]}]}
239+
end
240+
end.
241+
242+
is_safe(_, _, _, []) -> false;
243+
is_safe(M, F, Args, [{M, F, Arity} | _]) when length(Args) == Arity -> true;
244+
is_safe(M, F, A, [_ | Safe]) -> is_safe(M, F, A, Safe).
245+
136246
%% ----- TESTS ------------------------------------------------
137247
-ifdef(TEST).
138248

139249
-include_lib("eunit/include/eunit.hrl").
140250

141-
erl_value_test_() ->
251+
compile_test_() ->
142252
{inparallel,
143253
[{C, case O of
144254
'SystemException' ->
@@ -162,4 +272,61 @@ erl_value_test_() ->
162272
]
163273
]}.
164274

275+
-define(TEST_MODULES, [
276+
{"simple",
277+
<<"
278+
-module(test).
279+
-export([test/0]).
280+
test() ->
281+
ok.
282+
">>, ok},
283+
{"error",
284+
<<"
285+
-module(test).
286+
-export([test/0, test/1]).
287+
test() ->
288+
ok.
289+
">>, #{error => [#{line => 3, msg => <<"function test/1 undefined">>}],
290+
warning => []}},
291+
{"warning",
292+
<<"
293+
-module(test).
294+
-export([test/0]).
295+
test() ->
296+
X = 0,
297+
ok.
298+
">>, #{error => [],
299+
warning => [#{line => 5, msg => <<"variable 'X' is unused">>}]}},
300+
{"error and warning",
301+
<<"
302+
-module(test).
303+
-export([test/0, test/1]).
304+
test() ->
305+
X = 0,
306+
ok.
307+
">>, #{error => [#{line => 3, msg => <<"function test/1 undefined">>}],
308+
warning => [#{line => 5, msg => <<"variable 'X' is unused">>}]}},
309+
{"unsafe",
310+
<<"
311+
-module(test).
312+
313+
-export([test/0]).
314+
315+
test() ->
316+
bikram:call(bnot 1),
317+
binary_to_atom(<<\"1\">>, utf8),
318+
ok.
319+
">>, #{error => [#{line => 8, msg => <<"unsafe function call erlang:binary_to_atom/2">>}],
320+
warning => []}}
321+
]).
322+
323+
compile_mod_test_() ->
324+
{inparallel,
325+
[{T,
326+
case {O, compile_mod(C)} of
327+
{ok, Output} -> ?_assertMatch({ok, _}, Output);
328+
{O, {warning, _, Warning}} -> ?_assertEqual(O, Warning);
329+
{O, {error, Error}} -> ?_assertEqual(O, Error)
330+
end} || {T, C, O} <- ?TEST_MODULES]}.
331+
165332
-endif.

0 commit comments

Comments
 (0)