%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% 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.
%%
%% %CopyrightEnd%
%%
%%
%% New initial version of init.
%% Booting from a script. The script is fetched either from
%% a local file or distributed from another erlang node.
%%
%% Flags:
%% -boot File : Absolute file name of the boot script.
%% -boot_var Var Value
%% : $Var in the boot script is expanded to
%% Value.
%% -loader LoaderMethod
%% : efile, inet
%% (Optional - default efile)
%% -hosts [Node] : List of hosts from which we can boot.
%% (Mandatory if -loader inet)
%% -mode embedded : Load all modules at startup, no automatic loading
%% -mode interactive : Auto load modules (default system behaviour).
%% -path : Override path in bootfile.
%% -pa Path+ : Add my own paths first.
%% -pz Path+ : Add my own paths last.
%% -run : Start own processes.
%% -s : Start own processes.
%%
%% Experimental flags:
%% -profile_boot : Use an 'eprof light' to profile boot sequence
%% -init_debug : Activate debug printouts in init
%% -loader_debug : Activate debug printouts in erl_prim_loader
%% -code_path_choice : strict | relaxed
-module(init).
-export([restart/0,reboot/0,stop/0,stop/1,
get_status/0,boot/1,get_arguments/0,get_plain_arguments/0,
get_argument/1,script_id/0]).
%% for the on_load functionality; not for general use
-export([run_on_load_handlers/0]).
%% internal exports
-export([fetch_loaded/0,ensure_loaded/1,make_permanent/2,
notify_when_started/1,wait_until_started/0,
objfile_extension/0, archive_extension/0,code_path_choice/0]).
-include_lib("kernel/include/file.hrl").
-type internal_status() :: 'starting' | 'started' | 'stopping'.
-record(state, {flags = [],
args = [],
start = [],
kernel = [] :: [{atom(), pid()}],
bootpid :: pid(),
status = {starting, starting} :: {internal_status(), term()},
script_id = [],
loaded = [],
subscribed = []}).
-type state() :: #state{}.
%% Data for eval_script/2.
-record(es,
{init,
debug,
path,
pa,
pz,
path_choice,
prim_load,
load_mode,
vars
}).
-define(ON_LOAD_HANDLER, init__boot__on_load_handler).
debug(false, _) -> ok;
debug(_, T) -> erlang:display(T).
-spec get_arguments() -> Flags when
Flags :: [{Flag :: atom(), Values :: [string()]}].
get_arguments() ->
request(get_arguments).
-spec get_plain_arguments() -> [Arg] when
Arg :: string().
get_plain_arguments() ->
bs2ss(request(get_plain_arguments)).
-spec get_argument(Flag) -> {'ok', Arg} | 'error' when
Flag :: atom(),
Arg :: [Values :: [string()]].
get_argument(Arg) ->
request({get_argument, Arg}).
-spec script_id() -> Id when
Id :: term().
script_id() ->
request(script_id).
bs2as(L0) when is_list(L0) ->
map(fun b2a/1, L0);
bs2as(L) ->
L.
bs2ss(L0) when is_list(L0) ->
map(fun b2s/1, L0);
bs2ss(L) ->
L.
-spec get_status() -> {InternalStatus, ProvidedStatus} when
InternalStatus :: internal_status(),
ProvidedStatus :: term().
get_status() ->
request(get_status).
-spec fetch_loaded() -> [{module(),file:filename()}].
fetch_loaded() ->
request(fetch_loaded).
%% Handle dynamic code loading until the
%% real code_server has been started.
-spec ensure_loaded(atom()) -> 'not_allowed' | {'module', atom()}.
ensure_loaded(Module) ->
request({ensure_loaded, Module}).
-spec make_permanent(file:filename(), 'false' | file:filename()) ->
'ok' | {'error', term()}.
make_permanent(Boot,Config) ->
request({make_permanent,Boot,Config}).
-spec notify_when_started(pid()) -> 'ok' | 'started'.
notify_when_started(Pid) ->
request({notify_when_started,Pid}).
-spec wait_until_started() -> 'ok'.
wait_until_started() ->
receive
{init,started} -> ok
end.
request(Req) ->
init ! {self(),Req},
receive
{init,Rep} ->
Rep
end.
-spec restart() -> 'ok'.
restart() -> init ! {stop,restart}, ok.
-spec reboot() -> 'ok'.
reboot() -> init ! {stop,reboot}, ok.
-spec stop() -> 'ok'.
stop() -> init ! {stop,stop}, ok.
-spec stop(Status) -> 'ok' when
Status :: non_neg_integer() | string().
stop(Status) when is_integer(Status), Status >= 0 ->
stop_1(Status);
stop(Status) when is_list(Status) ->
case is_bytelist(Status) of
true ->
stop_1(Status);
false ->
erlang:error(badarg)
end;
stop(_) ->
erlang:error(badarg).
is_bytelist([B|Bs]) when is_integer(B), B >= 0, B < 256 -> is_bytelist(Bs);
is_bytelist([]) -> true;
is_bytelist(_) -> false.
%% Note that we check the type of Status beforehand to ensure that
%% the call to halt(Status) by the init process cannot fail
stop_1(Status) -> init ! {stop,{stop,Status}}, ok.
-spec boot(BootArgs) -> no_return() when
BootArgs :: [binary()].
boot(BootArgs) ->
register(init, self()),
process_flag(trap_exit, true),
%% Load the zlib nif
zlib:on_load(),
%% Load the tracer nif
erl_tracer:on_load(),
{Start0,Flags,Args} = parse_boot_args(BootArgs),
%% We don't get to profile parsing of BootArgs
case b2a(get_flag(profile_boot, Flags, false)) of
false -> ok;
true -> debug_profile_start()
end,
Start = map(fun prepare_run_args/1, Start0),
boot(Start, Flags, Args).
prepare_run_args({eval, [Expr]}) ->
{eval,Expr};
prepare_run_args({_, L=[]}) ->
bs2as(L);
prepare_run_args({_, L=[_]}) ->
bs2as(L);
prepare_run_args({s, [M,F|Args]}) ->
[b2a(M), b2a(F) | bs2as(Args)];
prepare_run_args({run, [M,F|Args]}) ->
[b2a(M), b2a(F) | bs2ss(Args)].
b2a(Bin) when is_binary(Bin) ->
list_to_atom(b2s(Bin));
b2a(A) when is_atom(A) ->
A.
b2s(Bin) when is_binary(Bin) ->
try
unicode:characters_to_list(Bin,file:native_name_encoding())
catch
_:_ -> binary_to_list(Bin)
end;
b2s(L) when is_list(L) ->
L.
map(_F, []) ->
[];
map(F, [X|Rest]) ->
[F(X) | map(F, Rest)].
-spec code_path_choice() -> 'relaxed' | 'strict'.
code_path_choice() ->
case get_argument(code_path_choice) of
{ok,[["strict"]]} ->
strict;
{ok,[["relaxed"]]} ->
relaxed;
_Else ->
relaxed
end.
boot(Start,Flags,Args) ->
start_on_load_handler_process(),
BootPid = do_boot(Flags,Start),
State = #state{flags = Flags,
args = Args,
start = Start,
bootpid = BootPid},
boot_loop(BootPid,State).
%%% Convert a term to a printable string, if possible.
to_string(X, D) when is_list(X), D < 4 -> % assume string
F = flatten(X, []),
case printable_list(F) of
true when length(F) > 0 -> F;
_false ->
List = [to_string(E, D+1) || E <- X],
flatten(["[",join(List),"]"], [])
end;
to_string(X, _D) when is_list(X) ->
"[_]";
to_string(X, _D) when is_atom(X) ->
atom_to_list(X);
to_string(X, _D) when is_pid(X) ->
pid_to_list(X);
to_string(X, _D) when is_float(X) ->
float_to_list(X);
to_string(X, _D) when is_integer(X) ->
integer_to_list(X);
to_string(X, D) when is_tuple(X), D < 4 ->
List = [to_string(E, D+1) || E <- tuple_to_list(X)],
flatten(["{",join(List),"}"], []);
to_string(X, _D) when is_tuple(X) ->
"{_}";
to_string(_X, _D) ->
"". % can't do anything with it
%% This is an incorrect and narrow definition of printable characters.
%% The correct one is in io_lib:printable_list/1
%%
printable_list([H|T]) when is_integer(H), H >= 32, H =< 126 ->
printable_list(T);
printable_list([$\n|T]) -> printable_list(T);
printable_list([$\r|T]) -> printable_list(T);
printable_list([$\t|T]) -> printable_list(T);
printable_list([]) -> true;
printable_list(_) -> false.
join([] = T) ->
T;
join([_Elem] = T) ->
T;
join([Elem|T]) ->
[Elem,","|join(T)].
flatten([H|T], Tail) when is_list(H) ->
flatten(H, flatten(T, Tail));
flatten([H|T], Tail) ->
[H|flatten(T, Tail)];
flatten([], Tail) ->
Tail.
things_to_string([X|Rest]) ->
" (" ++ to_string(X, 0) ++ ")" ++ things_to_string(Rest);
things_to_string([]) ->
"".
halt_string(String, List) ->
String ++ things_to_string(List).
%% String = string()
%% List = [string() | atom() | pid() | number() | list() | tuple()]
%% Items in List are truncated if found to be too large
-spec crash(_, _) -> no_return().
crash(String, List) ->
halt(halt_string(String, List)).
%% Status is {InternalStatus,ProvidedStatus}
-spec boot_loop(pid(), state()) -> no_return().
boot_loop(BootPid, State) ->
receive
{BootPid,loaded,NewlyLoaded} ->
Loaded = NewlyLoaded ++ State#state.loaded,
boot_loop(BootPid, State#state{loaded = Loaded});
{BootPid,started,KernelPid} ->
boot_loop(BootPid, new_kernelpid(KernelPid, BootPid, State));
{BootPid,progress,started} ->
{InS,_} = State#state.status,
notify(State#state.subscribed),
boot_loop(BootPid,State#state{status = {InS,started},
subscribed = []});
{BootPid,progress,NewStatus} ->
{InS,_} = State#state.status,
boot_loop(BootPid,State#state{status = {InS,NewStatus}});
{BootPid,{script_id,Id}} ->
boot_loop(BootPid,State#state{script_id = Id});
{'EXIT',BootPid,normal} ->
{_,PS} = State#state.status,
notify(State#state.subscribed),
loop(State#state{status = {started,PS},
subscribed = []});
{'EXIT',BootPid,Reason} ->
erlang:display({"init terminating in do_boot",Reason}),
crash("init terminating in do_boot", [Reason]);
{'EXIT',Pid,Reason} ->
Kernel = State#state.kernel,
terminate(Pid,Kernel,Reason), %% If Pid is a Kernel pid, halt()!
boot_loop(BootPid,State);
{stop,Reason} ->
stop(Reason,State);
{From,fetch_loaded} -> %% Fetch and reset initially loaded modules.
From ! {init,State#state.loaded},
garb_boot_loop(BootPid,State#state{loaded = []});
{From,{ensure_loaded,Module}} ->
{Res, Loaded} = ensure_loaded(Module, State#state.loaded),
From ! {init,Res},
boot_loop(BootPid,State#state{loaded = Loaded});
Msg ->
boot_loop(BootPid,handle_msg(Msg,State))
end.
ensure_loaded(Module, Loaded) ->
case erlang:module_loaded(Module) of
true ->
{{module, Module}, Loaded};
false ->
do_ensure_loaded(Module, Loaded)
end.
do_ensure_loaded(Module, Loaded) ->
File = atom_to_list(Module) ++ objfile_extension(),
case erl_prim_loader:get_file(File) of
{ok,BinCode,FullName} ->
case do_load_module(Module, BinCode) of
ok ->
{{module, Module}, [{Module, FullName}|Loaded]};
error ->
{error, [{Module, FullName}|Loaded]}
end;
Error ->
{Error, Loaded}
end.
%% Tell subscribed processes the system has started.
notify(Pids) ->
lists:foreach(fun(Pid) -> Pid ! {init,started} end, Pids).
%% Garbage collect all info about initially loaded modules.
%% This information is temporarily stored until the code_server
%% is started.
%% We force the garbage collection as the init process holds
%% this information during the initialisation of the system and
%% it will be automatically garbed much later (perhaps not at all
%% if it is not accessed much).
garb_boot_loop(BootPid,State) ->
garbage_collect(),
boot_loop(BootPid,State).
new_kernelpid({Name,{ok,Pid}},BootPid,State) when is_pid(Pid) ->
link(Pid),
BootPid ! {self(),ok,Pid},
Kernel = State#state.kernel,
State#state{kernel = [{Name,Pid}|Kernel]};
new_kernelpid({_Name,ignore},BootPid,State) ->
BootPid ! {self(),ignore},
State;
new_kernelpid({Name,What},BootPid,State) ->
erlang:display({"could not start kernel pid",Name,What}),
clear_system(BootPid,State),
crash("could not start kernel pid", [Name, What]).
%% Here is the main loop after the system has booted.
loop(State) ->
receive
{'EXIT',Pid,Reason} ->
Kernel = State#state.kernel,
terminate(Pid,Kernel,Reason), %% If Pid is a Kernel pid, halt()!
loop(State);
{stop,Reason} ->
stop(Reason,State);
{From,fetch_loaded} -> %% The Loaded info is cleared in
Loaded = State#state.loaded, %% boot_loop but is handled here
From ! {init,Loaded}, %% anyway.
loop(State);
Msg ->
loop(handle_msg(Msg,State))
end.
handle_msg(Msg,State0) ->
case catch do_handle_msg(Msg,State0) of
{new_state,State} -> State;
_ -> State0
end.
do_handle_msg(Msg,State) ->
#state{flags = Flags,
status = Status,
script_id = Sid,
args = Args,
subscribed = Subscribed} = State,
case Msg of
{From,get_plain_arguments} ->
From ! {init,Args};
{From,get_arguments} ->
From ! {init,get_arguments(Flags)};
{From,{get_argument,Arg}} ->
From ! {init,get_argument(Arg,Flags)};
{From,get_status} ->
From ! {init,Status};
{From,script_id} ->
From ! {init,Sid};
{From,{make_permanent,Boot,Config}} ->
{Res,State1} = make_permanent(Boot,Config,Flags,State),
From ! {init,Res},
{new_state,State1};
{From,{notify_when_started,Pid}} ->
case Status of
{InS,PS} when InS =:= started ; PS =:= started ->
From ! {init,started};
_ ->
From ! {init,ok},
{new_state,State#state{subscribed = [Pid|Subscribed]}}
end;
{From, {ensure_loaded, _}} ->
From ! {init, not_allowed};
X ->
case whereis(user) of
undefined ->
catch error_logger ! {info, self(), {self(), X, []}};
User ->
User ! X,
ok
end
end.
%%% -------------------------------------------------
%%% A new release has been installed and made
%%% permanent.
%%% Both restart/0 and reboot/0 shall startup using
%%% the new release. reboot/0 uses new boot script
%%% and configuration file pointed out externally.
%%% In the restart case we have to set new -boot and
%%% -config arguments.
%%% -------------------------------------------------
make_permanent(Boot,Config,Flags0,State) ->
case set_flag(boot, Boot, Flags0) of
{ok,Flags1} ->
case set_flag(config, Config, Flags1) of
{ok,Flags} ->
{ok,State#state{flags = Flags}};
Error ->
{Error,State}
end;
Error ->
{Error,State}
end.
set_flag(_Flag,false,Flags) ->
{ok,Flags};
set_flag(Flag,Value,Flags) when is_list(Value) ->
%% The flag here can be -boot or -config, which means the value is
%% a file name! Thus the file name encoding is used when coverting.
Encoding = file:native_name_encoding(),
case catch unicode:characters_to_binary(Value,Encoding,Encoding) of
{'EXIT',_} ->
{error,badarg};
AValue ->
{ok,set_argument(Flags,Flag,AValue)}
end;
set_flag(_,_,_) ->
{error,badarg}.
%%% -------------------------------------------------
%%% Stop the system.
%%% Reason is: restart | reboot | stop
%%% According to reason terminate emulator or restart
%%% system using the same init process again.
%%% -------------------------------------------------
stop(Reason,State) ->
BootPid = State#state.bootpid,
{_,Progress} = State#state.status,
State1 = State#state{status = {stopping, Progress}},
clear_system(BootPid,State1),
do_stop(Reason,State1).
do_stop(restart,#state{start = Start, flags = Flags, args = Args}) ->
boot(Start,Flags,Args);
do_stop(reboot,_) ->
halt();
do_stop(stop,State) ->
stop_heart(State),
halt();
do_stop({stop,Status},State) ->
stop_heart(State),
halt(Status).
clear_system(BootPid,State) ->
Heart = get_heart(State#state.kernel),
shutdown_pids(Heart,BootPid,State),
unload(Heart).
stop_heart(State) ->
case get_heart(State#state.kernel) of
false ->
ok;
Pid ->
%% As heart survives a restart the Parent of heart is init.
BootPid = self(),
%% ignore timeout
shutdown_kernel_pid(Pid, BootPid, self(), State)
end.
shutdown_pids(Heart,BootPid,State) ->
Timer = shutdown_timer(State#state.flags),
catch shutdown(State#state.kernel,BootPid,Timer,State),
kill_all_pids(Heart), % Even the shutdown timer.
kill_all_ports(Heart),
flush_timout(Timer).
get_heart([{heart,Pid}|_Kernel]) -> Pid;
get_heart([_|Kernel]) -> get_heart(Kernel);
get_heart(_) -> false.
shutdown([{heart,_Pid}|Kernel],BootPid,Timer,State) ->
shutdown(Kernel, BootPid, Timer, State);
shutdown([{_Name,Pid}|Kernel],BootPid,Timer,State) ->
shutdown_kernel_pid(Pid, BootPid, Timer, State),
shutdown(Kernel,BootPid,Timer,State);
shutdown(_,_,_,_) ->
true.
%%
%% A kernel pid must handle the special case message
%% {'EXIT',Parent,Reason} and terminate upon it!
%%
shutdown_kernel_pid(Pid, BootPid, Timer, State) ->
Pid ! {'EXIT',BootPid,shutdown},
shutdown_loop(Pid, Timer, State, []).
%%
%% We have to handle init requests here in case a process
%% performs such a request and cannot shutdown (deadlock).
%% Keep all other EXIT messages in case it was another
%% kernel process. Resend these messages and handle later.
%%
shutdown_loop(Pid,Timer,State,Exits) ->
receive
{'EXIT',Pid,_} ->
resend(reverse(Exits)),
ok;
{Timer,timeout} ->
erlang:display({init,shutdown_timeout}),
throw(timeout);
{stop,_} ->
shutdown_loop(Pid,Timer,State,Exits);
{From,fetch_loaded} ->
From ! {init,State#state.loaded},
shutdown_loop(Pid,Timer,State,Exits);
{'EXIT',OtherP,Reason} ->
shutdown_loop(Pid,Timer,State,
[{'EXIT',OtherP,Reason}|Exits]);
Msg ->
State1 = handle_msg(Msg,State),
shutdown_loop(Pid,Timer,State1,Exits)
end.
resend([ExitMsg|Exits]) ->
self() ! ExitMsg,
resend(Exits);
resend(_) ->
ok.
%%
%% Kill all existing pids in the system (except init and heart).
kill_all_pids(Heart) ->
case get_pids(Heart) of
[] ->
ok;
Pids ->
kill_em(Pids),
kill_all_pids(Heart) % Continue until all are really killed.
end.
%% All except system processes.
get_pids(Heart) ->
Pids = [P || P <- processes(), not erts_internal:is_system_process(P)],
delete(Heart,self(),Pids).
delete(Heart,Init,[Heart|Pids]) -> delete(Heart,Init,Pids);
delete(Heart,Init,[Init|Pids]) -> delete(Heart,Init,Pids);
delete(Heart,Init,[Pid|Pids]) -> [Pid|delete(Heart,Init,Pids)];
delete(_,_,[]) -> [].
kill_em([Pid|Pids]) ->
exit(Pid,kill),
kill_em(Pids);
kill_em([]) ->
ok.
%%
%% Kill all existing ports in the system (except the heart port),
%% i.e. ports still existing after all processes have been killed.
%%
%% System ports like the async driver port will nowadays be immortal;
%% therefore, it is ok to send them exit signals...
%%
kill_all_ports(Heart) ->
kill_all_ports(Heart,erlang:ports()).
kill_all_ports(Heart,[P|Ps]) ->
case erlang:port_info(P,connected) of
{connected,Heart} ->
kill_all_ports(Heart,Ps);
_ ->
exit(P,kill),
kill_all_ports(Heart,Ps)
end;
kill_all_ports(_,_) ->
ok.
unload(false) ->
do_unload(sub(erlang:pre_loaded(),erlang:loaded()));
unload(_) ->
do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
do_unload([M|Mods]) ->
catch erlang:purge_module(M),
catch erlang:delete_module(M),
catch erlang:purge_module(M),
do_unload(Mods);
do_unload([]) ->
ok.
sub([H|T],L) -> sub(T,del(H,L));
sub([],L) -> L.
del(Item, [Item|T]) -> T;
del(Item, [H|T]) -> [H|del(Item, T)];
del(_Item, []) -> [].
%%% -------------------------------------------------
%%% If the terminated Pid is one of the processes
%%% added to the Kernel, take down the system brutally.
%%% We are not sure that ANYTHING can work anymore,
%%% i.e. halt the system.
%%% Sleep awhile, it is thus possible for the
%%% error_logger (if it is still alive) to write errors
%%% using the simplest method.
%%% -------------------------------------------------
terminate(Pid,Kernel,Reason) ->
case kernel_pid(Pid,Kernel) of
{ok,Name} ->
sleep(500), %% Flush error printouts!
erlang:display({"Kernel pid terminated",Name,Reason}),
crash("Kernel pid terminated", [Name, Reason]);
_ ->
false
end.
kernel_pid(Pid,[{Name,Pid}|_]) ->
{ok,Name};
kernel_pid(Pid,[_|T]) ->
kernel_pid(Pid,T);
kernel_pid(_,_) ->
false.
sleep(T) -> receive after T -> ok end.
%%% -------------------------------------------------
%%% Start the loader.
%%% The loader shall run for ever!
%%% -------------------------------------------------
start_prim_loader(Init, Path0, {Pa,Pz}) ->
Path = case Path0 of
false -> Pa ++ ["."|Pz];
_ -> Path0
end,
case erl_prim_loader:start() of
{ok,Pid} ->
erl_prim_loader:set_path(Path),
add_to_kernel(Init, Pid);
{error,Reason} ->
erlang:display({"cannot start loader",Reason}),
exit(Reason)
end.
add_to_kernel(Init,Pid) ->
Init ! {self(),started,{erl_prim_loader,{ok,Pid}}},
receive
{Init,ok,Pid} ->
unlink(Pid),
ok
end.
%%% -------------------------------------------------
%%% The boot process fetches a boot script and loads
%%% all modules specified and starts spec. processes.
%%% Processes specified with -s or -run are finally started.
%%% -------------------------------------------------
do_boot(Flags,Start) ->
Self = self(),
spawn_link(fun() -> do_boot(Self,Flags,Start) end).
do_boot(Init,Flags,Start) ->
process_flag(trap_exit,true),
Root = get_root(Flags),
Path = get_flag_list(path, Flags, false),
{Pa,Pz} = PathFls = path_flags(Flags),
start_prim_loader(Init, bs2ss(Path), PathFls),
BootFile = bootfile(Flags,Root),
BootList = get_boot(BootFile,Root),
LoadMode = b2a(get_flag(mode, Flags, false)),
Deb = b2a(get_flag(init_debug, Flags, false)),
catch ?ON_LOAD_HANDLER ! {init_debug_flag,Deb},
BootVars = get_boot_vars(Root, Flags),
PathChoice = code_path_choice(),
Es = #es{init=Init,debug=Deb,path=Path,pa=Pa,pz=Pz,
path_choice=PathChoice,
prim_load=true,load_mode=LoadMode,
vars=BootVars},
eval_script(BootList, Es),
%% To help identifying Purify windows that pop up,
%% print the node name into the Purify log.
(catch erlang:system_info({purify, "Node: " ++ atom_to_list(node())})),
start_em(Start),
case b2a(get_flag(profile_boot,Flags,false)) of
false -> ok;
true ->
debug_profile_format_mfas(debug_profile_mfas()),
debug_profile_stop()
end,
ok.
get_root(Flags) ->
case get_argument(root, Flags) of
{ok,[[Root]]} ->
Root;
_ ->
exit(no_or_multiple_root_variables)
end.
get_boot_vars(Root, Flags) ->
BootVars = get_boot_vars_1(#{}, Flags),
RootKey = <<"ROOT">>,
BootVars#{RootKey=>Root}.
get_boot_vars_1(Vars, [{boot_var,[Key,Value]}|T]) ->
get_boot_vars_1(Vars#{Key=>Value}, T);
get_boot_vars_1(_, [{boot_var,_}|_]) ->
exit(invalid_boot_var_argument);
get_boot_vars_1(Vars, [_|T]) ->
get_boot_vars_1(Vars, T);
get_boot_vars_1(Vars, []) ->
Vars.
bootfile(Flags,Root) ->
b2s(get_flag(boot, Flags, Root++"/bin/start")).
path_flags(Flags) ->
Pa = append(reverse(get_flag_args(pa, Flags))),
Pz = append(get_flag_args(pz, Flags)),
{bs2ss(Pa),bs2ss(Pz)}.
get_boot(BootFile0,Root) ->
BootFile = BootFile0 ++ ".boot",
case get_boot(BootFile) of
{ok, CmdList} ->
CmdList;
not_found -> %% Check for default.
BootF = Root ++ "/bin/" ++ BootFile,
case get_boot(BootF) of
{ok, CmdList} ->
CmdList;
not_found ->
exit({'cannot get bootfile',list_to_atom(BootFile)});
_ ->
exit({'bootfile format error',list_to_atom(BootF)})
end;
_ ->
exit({'bootfile format error',list_to_atom(BootFile)})
end.
get_boot(BootFile) ->
case erl_prim_loader:get_file(BootFile) of
{ok,Bin,_} ->
case binary_to_term(Bin) of
{script,Id,CmdList} when is_list(CmdList) ->
init ! {self(),{script_id,Id}}, % ;-)
{ok, CmdList};
_ ->
error
end;
_ ->
not_found
end.
%%
%% Eval a boot script.
%% Load modules and start processes.
%% If a start command does not spawn a new process the
%% boot process hangs (we want to ensure syncronicity).
%%
eval_script([{progress,Info}=Progress|T], #es{debug=Deb}=Es) ->
debug(Deb, Progress),
init ! {self(),progress,Info},
eval_script(T, Es);
eval_script([{preLoaded,_}|T], #es{}=Es) ->
eval_script(T, Es);
eval_script([{path,Path}|T], #es{path=false,pa=Pa,pz=Pz,
path_choice=PathChoice,
vars=Vars}=Es) ->
RealPath0 = make_path(Pa, Pz, Path, Vars),
RealPath = patch_path(RealPath0, PathChoice),
erl_prim_loader:set_path(RealPath),
eval_script(T, Es);
eval_script([{path,_}|T], #es{}=Es) ->
%% Ignore, use the command line -path flag.
eval_script(T, Es);
eval_script([{kernel_load_completed}|T], #es{load_mode=Mode}=Es0) ->
Es = case Mode of
embedded -> Es0;
_ -> Es0#es{prim_load=false}
end,
eval_script(T, Es);
eval_script([{primLoad,Mods}|T], #es{init=Init,prim_load=PrimLoad}=Es)
when is_list(Mods) ->
case PrimLoad of
true ->
load_modules(Mods, Init);
false ->
%% Do not load now, code_server does that dynamically!
ok
end,
eval_script(T, Es);
eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|T],
#es{init=Init,debug=Deb}=Es) ->
debug(Deb, {start,Server}),
start_in_kernel(Server, Mod, Fun, Args, Init),
eval_script(T, Es);
eval_script([{apply,{Mod,Fun,Args}}=Apply|T], #es{debug=Deb}=Es) ->
debug(Deb, Apply),
apply(Mod, Fun, Args),
eval_script(T, Es);
eval_script([], #es{}) ->
ok;
eval_script(What, #es{}) ->
exit({'unexpected command in bootfile',What}).
load_modules(Mods0, Init) ->
Mods = [M || M <- Mods0, not erlang:module_loaded(M)],
F = prepare_loading_fun(),
case erl_prim_loader:get_modules(Mods, F) of
{ok,{Prep0,[]}} ->
Prep = [Code || {_,{prepared,Code,_}} <- Prep0],
ok = erlang:finish_loading(Prep),
Loaded = [{Mod,Full} || {Mod,{_,_,Full}} <- Prep0],
Init ! {self(),loaded,Loaded},
Beams = [{M,Beam,Full} || {M,{on_load,Beam,Full}} <- Prep0],
load_rest(Beams, Init);
{ok,{_,[_|_]=Errors}} ->
Ms = [M || {M,_} <- Errors],
exit({load_failed,Ms})
end.
load_rest([{Mod,Beam,Full}|T], Init) ->
do_load_module(Mod, Beam),
Init ! {self(),loaded,[{Mod,Full}]},
load_rest(T, Init);
load_rest([], _) ->
ok.
prepare_loading_fun() ->
fun(Mod, FullName, Beam) ->
case erlang:prepare_loading(Mod, Beam) of
{error,_}=Error ->
Error;
Prepared ->
case erlang:has_prepared_code_on_load(Prepared) of
true ->
{ok,{on_load,Beam,FullName}};
false ->
{ok,{prepared,Prepared,FullName}}
end
end
end.
make_path(Pa, Pz, Path, Vars) ->
append([Pa,append([fix_path(Path,Vars),Pz])]).
%% For all Paths starting with $ROOT add rootdir and for those
%% starting with $xxx/, expand $xxx to the value supplied with -boot_var!
%% If $xxx cannot be expanded this process terminates.
fix_path([Path|Ps], Vars) when is_atom(Path) ->
[add_var(atom_to_list(Path), Vars)|fix_path(Ps, Vars)];
fix_path([Path|Ps], Vars) ->
[add_var(Path, Vars)|fix_path(Ps, Vars)];
fix_path(_, _) ->
[].
add_var("$"++Path0, Vars) ->
{Var,Path} = extract_var(Path0, []),
Key = list_to_binary(Var),
case Vars of
#{Key:=Value0} ->
Value = b2s(Value0),
Value ++ "/" ++ Path;
_ ->
Error0 = "cannot expand $" ++ Var ++ " in bootfile",
Error = list_to_atom(Error0),
exit(Error)
end;
add_var(Path, _) ->
Path.
extract_var([$/|Path],Var) -> {reverse(Var),Path};
extract_var([H|T],Var) -> extract_var(T,[H|Var]);
extract_var([],Var) -> {reverse(Var),[]}.
patch_path(Dirs, strict) ->
Dirs;
patch_path(Dirs, relaxed) ->
ArchiveExt = archive_extension(),
[patch_dir(Dir, ArchiveExt) || Dir <- Dirs].
patch_dir(Orig, ArchiveExt) ->
case funny_split(Orig, $/) of
["nibe", RevApp, RevArchive | RevTop] ->
App = reverse(RevApp),
case funny_splitwith(RevArchive, $.) of
{Ext, Base} when Ext =:= ArchiveExt, Base =:= App ->
%% Orig archive
Top = reverse([reverse(C) || C <- RevTop]),
Dir = join(Top ++ [App, "ebin"], "/"),
Archive = Orig;
_ ->
%% Orig directory
Top = reverse([reverse(C) || C <- [RevArchive | RevTop]]),
Archive = join(Top ++ [App ++ ArchiveExt, App, "ebin"], "/"),
Dir = Orig
end,
%% First try dir, second try archive and at last use orig if both fails
case erl_prim_loader:read_file_info(Dir) of
{ok, #file_info{type = directory}} ->
Dir;
_ ->
case erl_prim_loader:read_file_info(Archive) of
{ok, #file_info{type = directory}} ->
Archive;
_ ->
Orig
end
end;
_ ->
Orig
end.
%% Returns all lists in reverse order
funny_split(List, Sep) ->
funny_split(List, Sep, [], []).
funny_split([Sep | Tail], Sep, Path, Paths) ->
funny_split(Tail, Sep, [], [Path | Paths]);
funny_split([Head | Tail], Sep, Path, Paths) ->
funny_split(Tail, Sep, [Head | Path], Paths);
funny_split([], _Sep, Path, Paths) ->
[Path | Paths].
%% Returns {BeforeSep, AfterSep} where BeforeSep is in reverse order
funny_splitwith(List, Sep) ->
funny_splitwith(List, Sep, [], List).
funny_splitwith([Sep | Tail], Sep, Acc, _Orig) ->
{Acc, Tail};
funny_splitwith([Head | Tail], Sep, Acc, Orig) ->
funny_splitwith(Tail, Sep, [Head | Acc], Orig);
funny_splitwith([], _Sep, _Acc, Orig) ->
{[], Orig}.
-spec join([string()], string()) -> string().
join([H1, H2 | T], S) ->
H1 ++ S ++ join([H2 | T], S);
join([H], _) ->
H.
%% Servers that are located in the init kernel are linked
%% and supervised by init.
start_in_kernel(Server,Mod,Fun,Args,Init) ->
Res = apply(Mod,Fun,Args),
Init ! {self(),started,{Server,Res}},
receive
{Init,ok,Pid} ->
unlink(Pid), %% Just for sure...
ok;
{Init,ignore} ->
ignore
end.
%% Do start all processes specified at command line using -s!
%% Use apply here instead of spawn to ensure syncronicity for
%% those servers that wish to have it so.
%% Disadvantage: anything started with -s that does not
%% eventually spawn will hang the startup routine.
%% We also handle -eval here. The argument is an arbitrary
%% expression that should be parsed and evaluated.
start_em([S|Tail]) ->
case whereis(user) of
undefined ->
ok;
P when is_pid(P) -> %Let's set the group_leader()
erlang:group_leader(P, self())
end,
start_it(S),
start_em(Tail);
start_em([]) -> ok.
start_it([]) ->
ok;
start_it({eval,Bin}) ->
Str = b2s(Bin),
{ok,Ts,_} = erl_scan:string(Str),
Ts1 = case reverse(Ts) of
[{dot,_}|_] -> Ts;
TsR -> reverse([{dot,erl_anno:new(1)} | TsR])
end,
{ok,Expr} = erl_parse:parse_exprs(Ts1),
{value, _Value, _Bs} = erl_eval:exprs(Expr, erl_eval:new_bindings()),
ok;
start_it([_|_]=MFA) ->
case MFA of
[M] -> M:start();
[M,F] -> M:F();
[M,F|Args] -> M:F(Args) % Args is a list
end.
%% Load a module.
do_load_module(Mod, BinCode) ->
case erlang:load_module(Mod, BinCode) of
{module,Mod} ->
ok;
{error,on_load} ->
?ON_LOAD_HANDLER ! {loaded,Mod},
ok;
_ ->
error
end.
%% --------------------------------------------------------
%% If -shutdown_time is specified at the command line
%% this timer will inform the init process that it has to
%% force processes to terminate. It cannot be handled
%% softly any longer.
%% --------------------------------------------------------
shutdown_timer(Flags) ->
case get_flag(shutdown_time, Flags, infinity) of
infinity ->
self();
Time ->
case catch list_to_integer(binary_to_list(Time)) of
T when is_integer(T) ->
Pid = spawn(fun() -> timer(T) end),
receive
{Pid, started} ->
Pid
end;
_ ->
self()
end
end.
flush_timout(Pid) ->
receive
{Pid, timeout} -> true
after 0 -> true
end.
timer(T) ->
init ! {self(), started},
receive
after T ->
init ! {self(), timeout}
end.
%% --------------------------------------------------------
%% Parse the command line arguments and extract things to start, flags
%% and other arguments. We keep the relative of the groups.
%% --------------------------------------------------------
parse_boot_args(Args) ->
parse_boot_args(Args, [], [], []).
parse_boot_args([B|Bs], Ss, Fs, As) ->
case check(B) of
start_extra_arg ->
{reverse(Ss),reverse(Fs),lists:reverse(As, Bs)}; % BIF
start_arg ->
{S,Rest} = get_args(Bs, []),
parse_boot_args(Rest, [{s, S}|Ss], Fs, As);
start_arg2 ->
{S,Rest} = get_args(Bs, []),
parse_boot_args(Rest, [{run, S}|Ss], Fs, As);
eval_arg ->
{Expr,Rest} = get_args(Bs, []),
parse_boot_args(Rest, [{eval, Expr}|Ss], Fs, As);
{flag,A} ->
{F,Rest} = get_args(Bs, []),
Fl = {A,F},
parse_boot_args(Rest, Ss, [Fl|Fs], As);
arg ->
parse_boot_args(Bs, Ss, Fs, [B|As]);
end_args ->
parse_boot_args(Bs, Ss, Fs, As)
end;
parse_boot_args([], Start, Flags, Args) ->
{reverse(Start),reverse(Flags),reverse(Args)}.
check(<<"-extra">>) -> start_extra_arg;
check(<<"-s">>) -> start_arg;
check(<<"-run">>) -> start_arg2;
check(<<"-eval">>) -> eval_arg;
check(<<"--">>) -> end_args;
check(<<"-",Flag/binary>>) -> {flag,b2a(Flag)};
check(_) -> arg.
get_args([B|Bs], As) ->
case check(B) of
start_extra_arg -> {reverse(As), [B|Bs]};
start_arg -> {reverse(As), [B|Bs]};
start_arg2 -> {reverse(As), [B|Bs]};
eval_arg -> {reverse(As), [B|Bs]};
end_args -> {reverse(As), Bs};
{flag,_} -> {reverse(As), [B|Bs]};
arg ->
get_args(Bs, [B|As])
end;
get_args([], As) -> {reverse(As),[]}.
%%
%% Internal get_flag function, with default value.
%% Return: true if flag given without args
%% atom() if a single arg was given.
%% list(atom()) if several args were given.
%%
get_flag(F, Flags, Default) ->
case lists:keyfind(F, 1, Flags) of
{F,[]} ->
true;
{F,[V]} ->
V;
{F,V} ->
V;
_ ->
Default
end.
%%
%% Internal get_flag function, with default value.
%% Return: list(atom())
%%
get_flag_list(F, Flags, Default) ->
case lists:keyfind(F, 1, Flags) of
{F,[_|_]=V} ->
V;
_ ->
Default
end.
%%
%% Internal get_flag function.
%% Fetch all occurrences of flag.
%% Return: [Args,Args,...] where Args ::= list(atom())
%%
get_flag_args(F,Flags) -> get_flag_args(F,Flags,[]).
get_flag_args(F,[{F,V}|Flags],Acc) ->
get_flag_args(F,Flags,[V|Acc]);
get_flag_args(F,[_|Flags],Acc) ->
get_flag_args(F,Flags,Acc);
get_flag_args(_,[],Acc) ->
reverse(Acc).
get_arguments([{F,V}|Flags]) ->
[{F,to_strings(V)}|get_arguments(Flags)];
get_arguments([]) ->
[].
to_strings([H|T]) when is_atom(H) -> [atom_to_list(H)|to_strings(T)];
to_strings([H|T]) when is_binary(H) -> [b2s(H)|to_strings(T)];
to_strings([]) -> [].
get_argument(Arg, Flags) ->
case get_argument1(Arg, Flags) of
[] -> error;
Value -> {ok,Value}
end.
get_argument1(Arg, [{Arg,V}|Args]) ->
[to_strings(V)|get_argument1(Arg, Args)];
get_argument1(Arg, [_|Args]) ->
get_argument1(Arg, Args);
get_argument1(_, []) ->
[].
set_argument([{Flag,_}|Flags],Flag,Value) ->
[{Flag,[Value]}|Flags];
set_argument([Item|Flags],Flag,Value) ->
[Item|set_argument(Flags,Flag,Value)];
set_argument([],Flag,Value) ->
[{Flag,[Value]}].
append([E]) -> E;
append([H|T]) ->
H ++ append(T);
append([]) -> [].
reverse([] = L) ->
L;
reverse([_] = L) ->
L;
reverse([A, B]) ->
[B, A];
reverse([A, B | L]) ->
lists:reverse(L, [B, A]). % BIF
-spec objfile_extension() -> nonempty_string().
objfile_extension() ->
".beam".
%% case erlang:system_info(machine) of
%% "JAM" -> ".jam";
%% "VEE" -> ".vee";
%% "BEAM" -> ".beam"
%% end.
-spec archive_extension() -> nonempty_string().
archive_extension() ->
".ez".
%%%
%%% Support for handling of on_load functions.
%%%
run_on_load_handlers() ->
Ref = monitor(process, ?ON_LOAD_HANDLER),
catch ?ON_LOAD_HANDLER ! run_on_load,
receive
{'DOWN',Ref,process,_,noproc} ->
%% There is no on_load handler process,
%% probably because init:restart/0 has been
%% called and it is not the first time we
%% pass through here.
ok;
{'DOWN',Ref,process,_,on_load_done} ->
ok;
{'DOWN',Ref,process,_,Res} ->
%% Failure to run an on_load handler.
%% This is fatal during start-up.
exit(Res)
end.
start_on_load_handler_process() ->
register(?ON_LOAD_HANDLER,
spawn(fun on_load_handler_init/0)).
on_load_handler_init() ->
on_load_loop([], false).
on_load_loop(Mods, Debug0) ->
receive
{init_debug_flag,Debug} ->
on_load_loop(Mods, Debug);
{loaded,Mod} ->
on_load_loop([Mod|Mods], Debug0);
run_on_load ->
run_on_load_handlers(Mods, Debug0),
exit(on_load_done)
end.
run_on_load_handlers([M|Ms], Debug) ->
debug(Debug, {running_on_load_handler,M}),
Fun = fun() ->
Res = erlang:call_on_load_function(M),
exit(Res)
end,
{Pid,Ref} = spawn_monitor(Fun),
receive
{'DOWN',Ref,process,Pid,OnLoadRes} ->
Keep = OnLoadRes =:= ok,
erlang:finish_after_on_load(M, Keep),
case Keep of
false ->
Error = {on_load_function_failed,M},
debug(Debug, Error),
exit(Error);
true ->
debug(Debug, {on_load_handler_returned_ok,M}),
run_on_load_handlers(Ms, Debug)
end
end;
run_on_load_handlers([], _) -> ok.
%% debug profile (light variant of eprof)
debug_profile_start() ->
_ = erlang:trace_pattern({'_','_','_'},true,[call_time]),
_ = erlang:trace_pattern(on_load,true,[call_time]),
_ = erlang:trace(all,true,[call]),
ok.
debug_profile_stop() ->
_ = erlang:trace_pattern({'_','_','_'},false,[call_time]),
_ = erlang:trace_pattern(on_load,false,[call_time]),
_ = erlang:trace(all,false,[call]),
ok.
debug_profile_mfas() ->
_ = erlang:trace_pattern({'_','_','_'},pause,[call_time]),
_ = erlang:trace_pattern(on_load,pause,[call_time]),
MFAs = collect_loaded_mfas() ++ erlang:system_info(snifs),
collect_mfas(MFAs,[]).
%% debug_profile_format_mfas should be called at the end of the boot phase
%% so all pertinent modules should be loaded at that point.
debug_profile_format_mfas(MFAs0) ->
MFAs = lists:sort(MFAs0),
lists:foreach(fun({{Us,C},{M,F,A}}) ->
Str = io_lib:format("~w:~w/~w", [M,F,A]),
io:format(standard_error,"~55s - ~6w : ~w us~n", [Str,C,Us])
end, MFAs),
ok.
collect_loaded_mfas() ->
Ms = [M || M <- [element(1, Mi) || Mi <- code:all_loaded()]],
collect_loaded_mfas(Ms,[]).
collect_loaded_mfas([],MFAs) -> MFAs;
collect_loaded_mfas([M|Ms],MFAs0) ->
MFAs = [{M,F,A} || {F,A} <- M:module_info(functions)],
collect_loaded_mfas(Ms,MFAs ++ MFAs0).
collect_mfas([], Info) -> Info;
collect_mfas([MFA|MFAs],Info) ->
case erlang:trace_info(MFA,call_time) of
{call_time, []} ->
collect_mfas(MFAs,Info);
{call_time, false} ->
collect_mfas(MFAs,Info);
{call_time, Data} ->
case collect_mfa(MFA,Data,0,0) of
{{0,_},_} ->
%% ignore mfas with zero time
collect_mfas(MFAs,Info);
MfaData ->
collect_mfas(MFAs,[MfaData|Info])
end
end.
collect_mfa(Mfa,[],Count,Time) -> {{Time,Count},Mfa};
collect_mfa(Mfa,[{_Pid,C,S,Us}|Data],Count,Time) ->
collect_mfa(Mfa,Data,Count + C,Time + S * 1000000 + Us).
