shell.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 1,268 行 · 第 1/3 页

    has_bin(T, I - 1).

%% shell_cmd(Sequence, Evaluator, Bindings, RecordTable, Dictionary)
%% shell_rep(Evaluator, Bindings, RecordTable, Dictionary) ->
%%	{Value,Evaluator,Bindings,Dictionary}
%%  Send a command to the evaluator and wait for the reply. Start a new
%%  evaluator if necessary.

shell_cmd(Es, Eval, Bs, RT, Ds) ->
    Eval ! {shell_cmd,self(),{eval,Es}},
    shell_rep(Eval, Bs, RT, Ds).

shell_rep(Ev, Bs0, RT, Ds0) ->
    receive
	{shell_rep,Ev,{value,V,Bs,Ds}} ->
	    {V,Ev,Bs,Ds};
        {shell_rep,Ev,{command_error,{Line,M,Error}}} -> 
	    io:fwrite("** ~w: ~s **\n", [Line,M:format_error(Error)]),
            {{'EXIT',Error},Ev,Bs0,Ds0};
	{shell_req,Ev,get_cmd} ->
	    Ev ! {shell_rep,self(),get()},
	    shell_rep(Ev, Bs0, RT, Ds0);
	{shell_req,Ev,exit} ->
	    Ev ! {shell_rep,self(),exit},
	    exit(normal);
	{shell_req,Ev,{update_dict,Ds}} ->	% Update dictionary
	    Ev ! {shell_rep,self(),ok},
	    shell_rep(Ev, Bs0, RT, Ds);
	{'EXIT',Ev,Reason} ->			% It has exited unnaturally
	    io:fwrite("** exited: ~P **\n", [Reason,?LINEMAX]),
	    {{'EXIT',Reason},start_eval(Bs0, RT, Ds0), Bs0, Ds0};
	{'EXIT',_Id,interrupt} ->		% Someone interrupted us
	    exit(Ev, kill),
	    shell_rep(Ev, Bs0, RT, Ds0);
	{'EXIT',_Id,R} ->
	    exit(Ev, R),
	    exit(R);
	_Other ->				% Ignore everything else
	    shell_rep(Ev, Bs0, RT, Ds0)
    end.

start_eval(Bs, RT, Ds) ->
    Self = self(),
    Eval = spawn_link(fun() -> evaluator(Self, Bs, RT, Ds) end),
    put(evaluator, Eval),
    Eval.

%% evaluator(Shell, Bindings, RecordTable, ProcessDictionary)
%%  Evaluate expressions from the shell. Use the "old" variable bindings
%%  and dictionary.

evaluator(Shell, Bs, RT, Ds) ->
    init_dict(Ds),
    case application:get_env(stdlib, restricted_shell) of
	undefined ->
	    eval_loop(Shell, Bs, RT);
	{ok,RShMod} ->
	    case get(restricted_shell_state) of
		undefined -> put(restricted_shell_state, []);
		_ -> ok
	    end,
	    put(restricted_expr_state, []),
	    restricted_eval_loop(Shell, Bs, RT, RShMod)
    end.

eval_loop(Shell, Bs0, RT) ->
    receive
	{shell_cmd,Shell,{eval,Es}} ->
            Ef = {value, 
                  fun(MForFun, As) -> apply_fun(MForFun, As, Shell) end},
            Lf = local_func_handler(Shell, RT, Ef),
            {R,Bs2} = exprs(Es, Bs0, RT, Lf, Ef),
	    Shell ! {shell_rep,self(),R},
	    eval_loop(Shell, Bs2, RT)
    end.

restricted_eval_loop(Shell, Bs0, RT, RShMod) ->
    receive
	{shell_cmd,Shell,{eval,Es}} ->
            {LFH,NLFH} = restrict_handlers(RShMod, Shell, RT),
            put(restricted_expr_state, []),
            {R,Bs2} = exprs(Es, Bs0, RT, {eval,LFH}, {value,NLFH}),
	    Shell ! {shell_rep,self(),R},
	    restricted_eval_loop(Shell, Bs2, RT, RShMod)
    end.

exprs(Es, Bs0, RT, Lf, Ef) ->
    exprs(Es, Bs0, RT, Lf, Ef, Bs0).

exprs([E0|Es], Bs1, RT, Lf, Ef, Bs0) ->
    UsedRecords = used_record_defs(E0, RT),
    RBs = record_bindings(UsedRecords, Bs1),
    case check_command(prep_check([E0]), RBs) of
        ok ->
            E1 = expand_records(UsedRecords, E0),
            {value,V0,Bs2} = expr(E1, Bs1, Lf, Ef),
            Bs = orddict:from_list([VV || {X,_}=VV <- erl_eval:bindings(Bs2),
                                          not is_expand_variable(X)]),
            if
                Es =:= [] ->
                    VS = io_lib_pretty:print(V0, ?LINEMAX, 
                                             record_print_fun(RT)),
                    io:put_chars(VS),
                    io:nl(),
                    %% Don't send the result back if it is known to be
                    %% thrown away anyway.
                    V = case get_history_and_results() of
                            {_, 0} -> ignored;
                            _ -> V0
                        end,
                    {{value,V,Bs,get()},Bs};
                true -> 
                    exprs(Es, Bs, RT, Lf, Ef, Bs0)
            end;
        {error,Error} ->
            {{command_error,Error},Bs0}
    end.

is_expand_variable(V) ->
    case catch atom_to_list(V) of
        "rec" ++ _Integer -> true;
        _ -> false
    end.

used_record_defs(E, RT) ->
    %% Be careful to return a list where used records come before
    %% records that use them. The linter wants them ordered that way.
    UR = case used_records(E, [], RT) of
             [] -> 
                 [];
             L0 ->
                 L1 = lists:zip(L0, lists:seq(1, length(L0))),
                 L2 = lists:keysort(2, lists:ukeysort(1, L1)),
                 [R || {R, _} <- L2]
         end,
    record_defs(RT, UR).

used_records(E, U0, RT) ->
    case used_records(E) of
        {name,Name,E1} ->
            U = used_records(ets:lookup(RT, Name), [Name | U0], RT),
            used_records(E1, U, RT);
        {expr,[E1 | Es]} ->
            used_records(Es, used_records(E1, U0, RT), RT);
        _ ->
            U0
    end.

used_records({record_index,_,Name,F}) ->
    {name, Name, F};
used_records({record,_,Name,Is}) ->
    {name, Name, Is};
used_records({record_field,_,R,Name,F}) ->
    {name, Name, [R | F]};
used_records({record,_,R,Name,Ups}) ->
    {name, Name, [R | Ups]};
used_records({record_field,_,R,F}) -> % illegal
    {expr, [R | F]};
used_records({call,_,{atom,_,record},[A,{atom,_,Name}]}) ->
    {name, Name, A};
used_records({call,_,{atom,_,is_record},[A,{atom,_,Name}]}) ->
    {name, Name, A};
used_records({call,_,{remote,_,{atom,_,erlang},{atom,_,is_record}},
              [A,{atom,_,Name}]}) ->
    {name, Name, A};
used_records({call,_,{atom,_,record_info},[A,{atom,_,Name}]}) ->
    {name, Name, A};
used_records({call,Line,{tuple,_,[M,F]},As}) ->
    used_records({call,Line,{remote,Line,M,F},As});
used_records(T) when is_tuple(T) ->
    {expr, tuple_to_list(T)};
used_records(E) ->
    {expr, E}.

restrict_handlers(RShMod, Shell, RT) ->
    { fun(F,As,Binds) -> 
	      local_allowed(F, As, RShMod, Binds, Shell, RT) 
      end,
      fun(MF,As) -> 
	      non_local_allowed(MF, As, RShMod, Shell) 
      end }.

local_allowed(F, As, RShMod, Bs, Shell, RT) when is_atom(F) ->
    {LFH,NLFH} = restrict_handlers(RShMod, Shell, RT),
    case not_restricted(F, As) of % Not restricted is the same as builtin. 
				  % variable and record manipulations local 
	                          % to the shell process. Those are never
	                          % restricted.
	true ->
	    Res = local_func(F, As, Bs, Shell, RT, {eval,LFH}, {value,NLFH}),
	    Res;
	false ->
            {AsEv,Bs1} = expr_list(As, Bs, {eval,LFH}, {value,NLFH}),
	    case RShMod:local_allowed(F, AsEv, {get(restricted_shell_state),
						get(restricted_expr_state)}) of
		{Result,{RShShSt,RShExprSt}} ->
		    put(restricted_shell_state, RShShSt),
		    put(restricted_expr_state, RShExprSt),
		    if not Result -> 
			    shell_req(Shell, {update_dict,get()}),
			    exit({disallowed,{F,AsEv}});
		       true -> % This is never a builtin, 
                               % those are handled above.
			    non_builtin_local_func(F,AsEv,Bs1)
		    end;
		Unexpected ->  % The user supplied non conforming module
		    exit({bad_return_value,
			  {RShMod,local_allowed},Unexpected})
	    end
    end.

non_local_allowed(MForFun, As, RShMod, Shell) ->
    case RShMod:non_local_allowed(MForFun, As, {get(restricted_shell_state),
						get(restricted_expr_state)}) of
	{Result,{RShShSt,RShExprSt}} ->
	    put(restricted_shell_state, RShShSt),
	    put(restricted_expr_state, RShExprSt),
            case Result of 
                false -> 
		    shell_req(Shell, {update_dict,get()}),
		    exit({disallowed,{MForFun,As}});
                {redirect, NewMForFun, NewAs} ->
                    apply_fun(NewMForFun, NewAs, Shell);
                _ -> 
		    apply_fun(MForFun, As, Shell)
	    end;
	Unexpected ->				% the user didn't read the manual
	    exit({bad_return_value,
		  {RShMod,non_local_allowed},Unexpected})
    end.

%% The commands implemented in shell should not be checked if allowed
%% This *has* to correspond to the function local_func/7!
%% (especially true for f/1, the argument must not be evaluated).
not_restricted(f, []) ->
    true;
not_restricted(f, [_]) ->
    true;
not_restricted(h, []) ->
    true;
not_restricted(b, []) ->
    true;
not_restricted(which, [_]) ->
    true;
not_restricted(import, [_]) ->
    true;
not_restricted(import_all, [_]) ->
    true;
not_restricted(use, [_]) ->
    true;
not_restricted(use_all, [_]) ->
    true;
not_restricted(history, [_]) ->
    true;
not_restricted(results, [_]) ->
    true;
not_restricted(exit, []) ->
    true;
not_restricted(rd, [_,_]) ->
    true;
not_restricted(rf, []) ->
    true;
not_restricted(rf, [_]) ->
    true;
not_restricted(rl, []) ->
    true;
not_restricted(rl, [_]) ->
    true;
not_restricted(rp, [_]) ->
    true;
not_restricted(rr, [_]) ->
    true;
not_restricted(rr, [_,_]) ->
    true;
not_restricted(rr, [_,_,_]) ->
    true;
not_restricted(_, _) ->
    false.

%% When erlang:garbage_collect() is called from the shell,
%% the shell process process that spawned the evaluating 
%% process is garbage collected as well.
%% To garbage collect the evaluating process only the command
%% garbage_collect(self()). can be used.
apply_fun({erlang,garbage_collect}, [], Shell) ->
    erlang:garbage_collect(Shell),
    catch erlang:garbage_collect(whereis(user)),
    erlang:garbage_collect();
apply_fun(MForFun, As, _Shell) ->
    apply(MForFun, As).

prep_check({call,Line,{atom,_,f},[{var,_,_Name}]}) ->
    %% Do not emit a warning for f(V) when V is unbound.
    {atom,Line,ok};
prep_check({value,_CommandN,_Val}) ->
    %% erl_lint cannot handle the history expansion {value,_,_}.
    {atom,0,ok};
prep_check(T) when is_tuple(T) ->
    list_to_tuple(prep_check(tuple_to_list(T)));
prep_check([E | Es]) ->
    [prep_check(E) | prep_check(Es)];
prep_check(E) ->
    E.

expand_records([], E0) ->
    E0;
expand_records(UsedRecords, E0) ->
    RecordDefs = [Def || {_Name,Def} <- UsedRecords],
    L = 1,
    E = prep_rec(E0),
    Forms = RecordDefs ++ [{function,L,foo,0,[{clause,L,[],[],[E]}]}],
    [{function,L,foo,0,[{clause,L,[],[],[NE]}]}] = 
        erl_expand_records:module(Forms, [strict_record_tests]), 
    prep_rec(NE).

prep_rec({value,CommandN,V}) ->
    %% erl_expand_records cannot handle the history expansion {value,_,_}.
    {atom,{value,CommandN,V},ok};
prep_rec({atom,{value,CommandN,V},ok}) -> 
    %% Undo the effect of the previous clause...
    {value,CommandN,V};
prep_rec(T) when is_tuple(T) -> list_to_tuple(prep_rec(tuple_to_list(T)));
prep_rec([E | Es]) -> [prep_rec(E) | prep_rec(Es)];
prep_rec(E) -> E.

init_dict([{K,V}|Ds]) ->
    put(K, V),
    init_dict(Ds);
init_dict([]) -> true.

%% local_func(Function, Args, Bindings, Shell, RecordTable, 
%%            LocalFuncHandler, ExternalFuncHandler) -> {value,Val,Bs}
%%  Evaluate local functions, including shell commands.
%%
%% Note that the predicate not_restricted/2 has to correspond to what's 
%% handled internally - it should return 'true' for all local functions 
%% handled in this module (i.e. those that are not eventually handled by 
%% non_builtin_local_func/3 (user_default/shell_default).

local_func(h, [], Bs, Shell, RT, _Lf, _Ef) ->
    Cs = shell_req(Shell, get_cmd),
    Cs1 = lists:filter(fun({{command, _},_}) -> true;
			  ({{result, _},_}) -> true;
			  (_) -> false
		       end,
		       Cs),
    Cs2 = lists:map(fun({{T, N}, V}) -> {{N, T}, V} end,
		    Cs1),
    Cs3 = lists:keysort(1, Cs2),
    {value,list_commands(Cs3, RT),Bs};
local_func(b, [], Bs, _Shell, RT, _Lf, _Ef) ->
    {value,list_bindings(erl_eval:bindings(Bs), RT),Bs};
local_func(f, [], _Bs, _Shell, _RT, _Lf, _Ef) ->
    {value,ok,erl_eval:new_bindings()};
local_func(f, [{var,_,Name}], Bs, _Shell, _RT, _Lf, _Ef) ->
    {value,ok,erl_eval:del_binding(Name, Bs)};
local_func(f, [_Other], _Bs, _Shell, _RT, _Lf, _Ef) ->
    exit({function_clause,[{shell,f,1}]});
local_func(rd, [{atom,_,RecName},RecDef0], Bs, _Shell, RT, _Lf, _Ef) ->
    RecDef = expand_value(RecDef0),
    RDs = lists:flatten(erl_pp:expr(RecDef)),
    Attr = lists:concat(["-record('", RecName, "',", RDs, ")."]),
    {ok, Tokens, _} = erl_scan:string(Attr),
    case erl_parse:parse_form(Tokens) of
        {ok,AttrForm} ->
            [RN] = add_records([AttrForm], Bs, RT),
            {value,RN,Bs};
        {error,{_Line,M,ErrDesc}} ->
            ErrStr = io_lib:fwrite("~s", [M:format_error(ErrDesc)]),
            exit(lists:flatten(ErrStr))
    end;
local_func(rd, [_,_], _Bs, _Shell, _RT, _Lf, _Ef) ->
    exit({function_clause,[{shell,rd,2}]});
local_func(rf, [], Bs, _Shell, RT, _Lf, _Ef) ->
    true = ets:delete_all_objects(RT),
    {value,initiate_records(Bs, RT),Bs};
local_func(rf, [A], Bs0, _Shell, RT, Lf, Ef) ->
    {[Recs],Bs} = expr_list([A], Bs0, Lf, Ef),
    if '_' =:= Recs ->
            true = ets:delete_all_objects(RT);
       true -> 
            lists:foreach(fun(Name) -> true = ets:delete(RT, Name)
                          end, listify(Recs))
    end,
    {value,ok,Bs};
local_func(rl, [], Bs, _Shell, RT, _Lf, _Ef) ->
    {value,list_records(ets:tab2list(RT)),Bs};
local_func(rl, [A], Bs0, _Shell, RT, Lf, Ef) ->
    {[Recs],Bs} = expr_list([A], Bs0, Lf, Ef),
    {value,list_records(record_defs(RT, listify(Recs))),Bs};
local_func(rp, [A], Bs0, _Shell, RT, Lf, Ef) ->
    {[V],Bs} = expr_list([A], Bs0, Lf, Ef),
    io:put_chars(io_lib_pretty:print(V, record_print_fun(RT))),
    io:nl(),
    {value,ok,Bs};
local_func(rr, [A], Bs0, _Shell, RT, Lf, Ef) ->
    {[File],Bs} = expr_list([A], Bs0, Lf, Ef),
    {value,read_and_add_records(File, '_', [], Bs, RT),Bs};
local_func(rr, [_,_]=As0, Bs0, _Shell, RT, Lf, Ef) ->
    {[File,Sel],Bs} = expr_list(As0, Bs0, Lf, Ef),
    {value,read_and_add_records(File, Sel, [], Bs, RT),Bs};
local_func(rr, [_,_,_]=As0, Bs0, _Shell, RT, Lf, Ef) ->
    {[File,Sel,Options],Bs} = expr_list(As0, Bs0, Lf, Ef),
    {value,read_and_add_records(File, Sel, Options, Bs, RT),Bs};
local_func(which, [{atom,_,M}], Bs, _Shell, _RT, _Lf, _Ef) ->
    case erl_eval:binding({module,M}, Bs) of
	{value, M1} ->
	    {value,M1,Bs};
	unbound ->
	    {value,M,Bs}
    end;
local_func(which, [_Other], _Bs, _Shell, _RT, _Lf, _Ef) ->
    exit({function_clause,[{shell,which,1}]});
local_func(import, [M], Bs, _Shell, _RT, _Lf, _Ef) ->
    case erl_parse:package_segments(M) of
	error -> exit({function_clause,[{shell,import,1}]});
	M1 ->
	    Mod = packages:concat(M1),
	    case packages:is_valid(Mod) of
		true ->
		    Key = list_to_atom(packages:last(Mod)),
		    Mod1 = list_to_atom(Mod),
		    {value,ok,erl_eval:add_binding({module,Key}, Mod1, Bs)};