diff options
Diffstat (limited to 'erts/preloaded/src/init.erl')
| -rw-r--r-- | erts/preloaded/src/init.erl | 1372 |
1 files changed, 1372 insertions, 0 deletions
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl new file mode 100644 index 0000000000..c6f4c62f63 --- /dev/null +++ b/erts/preloaded/src/init.erl @@ -0,0 +1,1372 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights 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: +%% -id Identity : identity of the system. +%% -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, ose_inet +%% (Optional - default efile) +%% -hosts [Node] : List of hosts from which we can boot. +%% (Mandatory if -loader inet or ose_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: +%% -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]). + +% 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 = []}). + +-define(ON_LOAD_HANDLER, init__boot__on_load_handler). + +debug(false, _) -> ok; +debug(_, T) -> erlang:display(T). + +-spec get_arguments() -> [{atom(), [string()]}]. +get_arguments() -> + request(get_arguments). + +-spec get_plain_arguments() -> [string()]. +get_plain_arguments() -> + bs2ss(request(get_plain_arguments)). + +-spec get_argument(atom()) -> 'error' | {'ok', [[string()]]}. +get_argument(Arg) -> + request({get_argument, Arg}). + +-spec script_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() -> {internal_status(), term()}. +get_status() -> + request(get_status). + +-spec fetch_loaded() -> [atom()]. +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}). + +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() -> no_return(). +stop() -> init ! {stop,stop}, ok. + +-spec stop(non_neg_integer() | string()) -> no_return(). +stop(Status) -> init ! {stop,{stop,Status}}, ok. + +-spec boot([binary()]) -> no_return(). +boot(BootArgs) -> + register(init, self()), + process_flag(trap_exit, true), + start_on_load_handler_process(), + {Start0,Flags,Args} = parse_boot_args(BootArgs), + Start = map(fun prepare_run_args/1, Start0), + Flags0 = flags_to_atoms_again(Flags), + boot(Start,Flags0,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(binary_to_list(Bin)); +b2a(A) when is_atom(A) -> + A. + +b2s(Bin) when is_binary(Bin) -> + binary_to_list(Bin); +b2s(L) when is_list(L) -> + L. + +map(_F, []) -> + []; +map(F, [X|Rest]) -> + [F(X) | map(F, Rest)]. + +flags_to_atoms_again([]) -> + []; +flags_to_atoms_again([{F0,L0}|Rest]) -> + L = L0, + F = b2a(F0), + [{F,L}|flags_to_atoms_again(Rest)]; +flags_to_atoms_again([{F0}|Rest]) -> + F = b2a(F0), + [{F}|flags_to_atoms_again(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) -> + 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) when is_list(X) -> % assume string + F = flatten(X, []), + case printable_list(F) of + true -> F; + false -> "" + end; +to_string(X) when is_atom(X) -> + atom_to_list(X); +to_string(X) when is_pid(X) -> + pid_to_list(X); +to_string(X) when is_float(X) -> + float_to_list(X); +to_string(X) when is_integer(X) -> + integer_to_list(X); +to_string(_X) -> + "". % 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. + +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) ++ ")" ++ things_to_string(Rest); +things_to_string([]) -> + "". + +halt_string(String, List) -> + HaltString = String ++ things_to_string(List), + if + length(HaltString)<199 -> HaltString; + true -> first198(HaltString, 198) + end. + +first198([H|T], N) when N>0 -> + [H|first198(T, N-1)]; +first198(_, 0) -> + []. + +%% String = string() +%% List = [string() | atom() | pid() | number()] +%% Any other items in List, such as tuples, are ignored when creating +%% the string used as argument to erlang:halt/1. +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,ModLoaded} -> + Loaded = State#state.loaded, + boot_loop(BootPid,State#state{loaded = [ModLoaded|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. + case whereis(?ON_LOAD_HANDLER) of + undefined -> + %% 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; + Pid when is_pid(Pid) -> + Pid ! run_on_load, + receive + {'EXIT',Pid,on_load_done} -> + ok; + {'EXIT',Pid,Res} -> + %% Failure to run an on_load handler. + %% This is fatal during start-up. + exit(Res) + end + end, + 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) -> + File = concat([Module,objfile_extension()]), + case catch load_mod(Module,File) of + {ok, FullName} -> + {{module, Module}, [{Module, FullName}|Loaded]}; + Res -> + {Res, 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 temporary 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); + {From, {ensure_loaded, _}} -> + From ! {init, not_allowed}, + 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; + 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) -> + case catch list_to_binary(Value) 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 zombies. +alive_processes() -> + [P || P <- processes(), erlang:is_process_alive(P)]. + +get_pids(Heart) -> + Pids = alive_processes(), + 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,Id,Pgm,Nodes,Path,{Pa,Pz}) -> + case erl_prim_loader:start(Id,Pgm,Nodes) of + {ok,Pid} when Path =:= false -> + InitPath = append(Pa,["."|Pz]), + erl_prim_loader:set_path(InitPath), + add_to_kernel(Init,Pid), + Pid; + {ok,Pid} -> + erl_prim_loader:set_path(Path), + add_to_kernel(Init,Pid), + 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. + +prim_load_flags(Flags) -> + PortPgm = get_flag('-loader',Flags,<<"efile">>), + Hosts = get_flag_list('-hosts', Flags, []), + Id = get_flag('-id',Flags,none), + Path = get_flag_list('-path',Flags,false), + {PortPgm, Hosts, Id, Path}. + +%%% ------------------------------------------------- +%%% 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), + {Pgm0,Nodes,Id,Path} = prim_load_flags(Flags), + Root = b2s(get_flag('-root',Flags)), + PathFls = path_flags(Flags), + Pgm = b2s(Pgm0), + _Pid = start_prim_loader(Init,b2a(Id),Pgm,bs2as(Nodes), + 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)), + BootVars = get_flag_args('-boot_var',Flags), + ParallelLoad = + (Pgm =:= "efile") and (erlang:system_info(thread_pool_size) > 0), + + PathChoice = code_path_choice(), + eval_script(BootList,Init,PathFls,{Root,BootVars},Path, + {true,LoadMode,ParallelLoad},Deb,PathChoice), + + %% 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). + +bootfile(Flags,Root) -> + b2s(get_flag('-boot',Flags,concat([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 = concat([BootFile0,".boot"]), + case get_boot(BootFile) of + {ok, CmdList} -> + CmdList; + not_found -> %% Check for default. + BootF = concat([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}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + debug(Deb,{progress,Info}), + init ! {self(),progress,Info}, + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{preLoaded,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{path,Path}|CfgL],Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice) -> + RealPath0 = make_path(Pa, Pz, Path, Vars), + RealPath = patch_path(RealPath0, PathChoice), + erl_prim_loader:set_path(RealPath), + eval_script(CfgL,Init,{Pa,Pz},Vars,false,Ph,Deb,PathChoice); +eval_script([{path,_}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + %% Ignore, use the command line -path flag. + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,embedded,Par},Deb,PathChoice) -> + eval_script(CfgL,Init,PathFs,Vars,P,{true,embedded,Par},Deb,PathChoice); +eval_script([{kernel_load_completed}|CfgL],Init,PathFs,Vars,P,{_,E,Par},Deb,PathChoice) -> + eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); +eval_script([{primLoad,Mods}|CfgL],Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice) + when is_list(Mods) -> + if + Par =:= true -> + par_load_modules(Mods,Init); + true -> + load_modules(Mods) + end, + eval_script(CfgL,Init,PathFs,Vars,P,{true,E,Par},Deb,PathChoice); +eval_script([{primLoad,_Mods}|CfgL],Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice) -> + %% Do not load now, code_server does that dynamically! + eval_script(CfgL,Init,PathFs,Vars,P,{false,E,Par},Deb,PathChoice); +eval_script([{kernelProcess,Server,{Mod,Fun,Args}}|CfgL],Init, + PathFs,Vars,P,Ph,Deb,PathChoice) -> + debug(Deb,{start,Server}), + start_in_kernel(Server,Mod,Fun,Args,Init), + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([{apply,{Mod,Fun,Args}}|CfgL],Init,PathFs,Vars,P,Ph,Deb,PathChoice) -> + debug(Deb,{apply,{Mod,Fun,Args}}), + apply(Mod,Fun,Args), + eval_script(CfgL,Init,PathFs,Vars,P,Ph,Deb,PathChoice); +eval_script([],_,_,_,_,_,_,_) -> + ok; +eval_script(What,_,_,_,_,_,_,_) -> + exit({'unexpected command in bootfile',What}). + +load_modules([Mod|Mods]) -> + File = concat([Mod,objfile_extension()]), + {ok,Full} = load_mod(Mod,File), + init ! {self(),loaded,{Mod,Full}}, %% Tell init about loaded module + load_modules(Mods); +load_modules([]) -> + ok. + +%%% An optimization: erl_prim_loader gets the chance of loading many +%%% files in parallel, using threads. This will reduce the seek times, +%%% and loaded code can be processed while other threads are waiting +%%% for the disk. The optimization is not tried unless the loader is +%%% "efile" and there is a non-empty pool of threads. +%%% +%%% Many threads are needed to get a good result, so it would be +%%% beneficial to load several applications in parallel. However, +%%% measurements show that the file system handles one directory at a +%%% time, regardless if parallel threads are created for files on +%%% several directories (a guess: writing the meta information when +%%% the file was last read ('mtime'), forces the file system to sync +%%% between directories). + +par_load_modules(Mods,Init) -> + Ext = objfile_extension(), + ModFiles = [{Mod,concat([Mod,Ext])} || Mod <- Mods, + not erlang:module_loaded(Mod)], + Self = self(), + Fun = fun(Mod, BinCode, FullName) -> + case catch load_mod_code(Mod, BinCode, FullName) of + {ok, _} -> + Init ! {Self,loaded,{Mod,FullName}}, + ok; + _EXIT -> + {error, Mod} + end + end, + case erl_prim_loader:get_files(ModFiles, Fun) of + ok -> + ok; + {error,Mod} -> + exit({'cannot load',Mod,get_files}) + 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("$ROOT/" ++ Path, {Root,_}) -> + concat([Root, "/", Path]); +add_var([$$|Path0], {_,VarList}) -> + {Var,Path} = extract_var(Path0,[]), + Value = b2s(get_var_value(list_to_binary(Var),VarList)), + concat([Value, "/", Path]); +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),[]}. + +%% get_var_value(Var, [Vars]) where Vars == [atom()] +get_var_value(Var,[Vars|VarList]) -> + case get_var_val(Var,Vars) of + {ok, Value} -> + Value; + _ -> + get_var_value(Var,VarList) + end; +get_var_value(Var,[]) -> + exit(list_to_atom(concat(["cannot expand \$", Var, " in bootfile"]))). + +get_var_val(Var,[Var,Value|_]) -> {ok, Value}; +get_var_val(Var,[_,_|Vars]) -> get_var_val(Var,Vars); +get_var_val(_,_) -> false. + +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 = binary_to_list(Bin), + {ok,Ts,_} = erl_scan:string(Str), + Ts1 = case reverse(Ts) of + [{dot,_}|_] -> Ts; + TsR -> reverse([{dot,1} | TsR]) + end, + {ok,Expr} = erl_parse:parse_exprs(Ts1), + erl_eval:exprs(Expr, []), + ok; +start_it([_|_]=MFA) -> + Ref = make_ref(), + case catch {Ref,case MFA of + [M] -> M:start(); + [M,F] -> M:F(); + [M,F|Args] -> M:F(Args) % Args is a list + end} of + {Ref,R} -> + R; + {'EXIT',Reason} -> + exit(Reason); + Other -> + throw(Other) + end. + +%% +%% Fetch a module and load it into the system. +%% +load_mod(Mod, File) -> + case erlang:module_loaded(Mod) of + false -> + case erl_prim_loader:get_file(File) of + {ok,BinCode,FullName} -> + load_mod_code(Mod, BinCode, FullName); + _ -> + exit({'cannot load',Mod,get_file}) + end; + _ -> % Already loaded. + {ok,File} + end. + +load_mod_code(Mod, BinCode, FullName) -> + case erlang:module_loaded(Mod) of + false -> + case erlang:load_module(Mod, BinCode) of + {module,Mod} -> {ok,FullName}; + {error,on_load} -> + ?ON_LOAD_HANDLER ! {loaded,Mod}, + {ok,FullName}; + Other -> + exit({'cannot load',Mod,Other}) + end; + _ -> % Already loaded. + {ok,FullName} + 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 -> + {F,Rest} = get_args(Bs, []), + Fl = case F of + [] -> [B]; + FF -> [B,FF] + end, + parse_boot_args(Rest, Ss, + [list_to_tuple(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(X) when is_binary(X) -> + case binary_to_list(X) of + [$-|_Rest] -> flag; + _Chars -> arg %Even empty atoms + end; +check(_X) -> arg. %This should never occur + +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 catch get_flag(F,Flags) of + {'EXIT',_} -> + Default; + Value -> + Value + end. + +get_flag(F,Flags) -> + case search(F,Flags) of + {value,{F,[V]}} -> + V; + {value,{F,V}} -> + V; + {value,{F}} -> % Flag given! + true; + _ -> + exit(list_to_atom(concat(["no ",F," flag"]))) + end. + +%% +%% Internal get_flag function, with default value. +%% Return: list(atom()) +%% +get_flag_list(F,Flags,Default) -> + case catch get_flag_list(F,Flags) of + {'EXIT',_} -> + Default; + Value -> + Value + end. + +get_flag_list(F,Flags) -> + case search(F,Flags) of + {value,{F,V}} -> + V; + _ -> + exit(list_to_atom(concat(["no ",F," flag"]))) + 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) when is_list(V) -> + get_flag_args(F,Flags,[V|Acc]); +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]) -> + [$-|Fl] = atom_to_list(F), + [{list_to_atom(Fl),to_strings(V)}|get_arguments(Flags)]; +get_arguments([{F}|Flags]) -> + [$-|Fl] = atom_to_list(F), + [{list_to_atom(Fl),[]}|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) -> [binary_to_list(H)|to_strings(T)]; +to_strings([]) -> []. + +get_argument(Arg,Flags) -> + Args = get_arguments(Flags), + case get_argument1(Arg,Args) of + [] -> + error; + Value -> + {ok,Value} + end. + +get_argument1(Arg,[{Arg,V}|Args]) -> + [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([{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]}]. + +concat([A|T]) when is_atom(A) -> + atom_to_list(A) ++ concat(T); +concat([C|T]) when is_integer(C), 0 =< C, C =< 255 -> + [C|concat(T)]; +concat([Bin|T]) when is_binary(Bin) -> + binary_to_list(Bin) ++ concat(T); +concat([S|T]) -> + S ++ concat(T); +concat([]) -> + []. + +append(L, Z) -> L ++ Z. + +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 + +search(Key, [H|_T]) when is_tuple(H), element(1, H) =:= Key -> + {value, H}; +search(Key, [_|T]) -> + search(Key, T); +search(_Key, []) -> + false. + +-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. +%%% + +start_on_load_handler_process() -> + register(?ON_LOAD_HANDLER, + spawn_link(fun on_load_handler_init/0)). + +on_load_handler_init() -> + on_load_loop([]). + +on_load_loop(Mods) -> + receive + {loaded,Mod} -> + on_load_loop([Mod|Mods]); + run_on_load -> + run_on_load_handlers(Mods), + exit(on_load_done) + end. + +run_on_load_handlers([M|Ms]) -> + Fun = fun() -> + Res = erlang:call_on_load_function(M), + exit(Res) + end, + {Pid,Ref} = spawn_monitor(Fun), + receive + {'DOWN',Ref,process,Pid,OnLoadRes} -> + Keep = if + is_boolean(OnLoadRes) -> OnLoadRes; + true -> false + end, + erlang:finish_after_on_load(M, Keep), + case Keep of + false -> + exit({on_load_function_failed,M}); + true -> + run_on_load_handlers(Ms) + end + end; +run_on_load_handlers([]) -> ok. |