diff options
Diffstat (limited to 'lib/sasl/src')
| -rw-r--r-- | lib/sasl/src/Makefile | 100 | ||||
| -rw-r--r-- | lib/sasl/src/alarm_handler.erl | 95 | ||||
| -rw-r--r-- | lib/sasl/src/erlsrv.erl | 420 | ||||
| -rw-r--r-- | lib/sasl/src/format_lib_supp.erl | 224 | ||||
| -rw-r--r-- | lib/sasl/src/misc_supp.erl | 106 | ||||
| -rw-r--r-- | lib/sasl/src/overload.erl | 224 | ||||
| -rw-r--r-- | lib/sasl/src/rb.erl | 697 | ||||
| -rw-r--r-- | lib/sasl/src/rb_format_supp.erl | 155 | ||||
| -rw-r--r-- | lib/sasl/src/release_handler.erl | 1906 | ||||
| -rw-r--r-- | lib/sasl/src/release_handler_1.erl | 647 | ||||
| -rw-r--r-- | lib/sasl/src/sasl.app.src | 46 | ||||
| -rw-r--r-- | lib/sasl/src/sasl.appup.src | 25 | ||||
| -rw-r--r-- | lib/sasl/src/sasl.erl | 162 | ||||
| -rw-r--r-- | lib/sasl/src/sasl_report.erl | 135 | ||||
| -rw-r--r-- | lib/sasl/src/sasl_report_file_h.erl | 60 | ||||
| -rw-r--r-- | lib/sasl/src/sasl_report_tty_h.erl | 50 | ||||
| -rw-r--r-- | lib/sasl/src/si.erl | 168 | ||||
| -rw-r--r-- | lib/sasl/src/si_sasl_supp.erl | 373 | ||||
| -rw-r--r-- | lib/sasl/src/systools.erl | 109 | ||||
| -rw-r--r-- | lib/sasl/src/systools.hrl | 71 | ||||
| -rw-r--r-- | lib/sasl/src/systools_lib.erl | 219 | ||||
| -rw-r--r-- | lib/sasl/src/systools_make.erl | 2155 | ||||
| -rw-r--r-- | lib/sasl/src/systools_rc.erl | 1044 | ||||
| -rw-r--r-- | lib/sasl/src/systools_relup.erl | 560 |
24 files changed, 9751 insertions, 0 deletions
diff --git a/lib/sasl/src/Makefile b/lib/sasl/src/Makefile new file mode 100644 index 0000000000..9a5d1e42d9 --- /dev/null +++ b/lib/sasl/src/Makefile @@ -0,0 +1,100 @@ +# +# %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% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(SASL_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/sasl-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +MODULES= alarm_handler sasl sasl_report \ + sasl_report_file_h sasl_report_tty_h format_lib_supp \ + misc_supp overload rb rb_format_supp release_handler \ + release_handler_1 si si_sasl_supp systools \ + systools_make systools_rc systools_relup systools_lib \ + erlsrv + +HRL_FILES= + +INTERNAL_HRL_FILES= systools.hrl + +ERL_FILES= $(MODULES:%=%.erl) + +APP_FILE= sasl.app +APPUP_FILE= sasl.appup + +APP_SRC= $(APP_FILE).src +APPUP_SRC= $(APPUP_FILE).src + +APP_TARGET= $(EBIN)/$(APP_FILE) +APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- +ERL_COMPILE_FLAGS += -I../../stdlib/include + + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +clean: + rm -f $(TARGET_FILES) + rm -f core + +docs: + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + +$(APP_TARGET): $(APP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk + sed -e 's;%VSN%;$(VSN);' $< > $@ + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src + $(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: diff --git a/lib/sasl/src/alarm_handler.erl b/lib/sasl/src/alarm_handler.erl new file mode 100644 index 0000000000..b118a8cafd --- /dev/null +++ b/lib/sasl/src/alarm_handler.erl @@ -0,0 +1,95 @@ +%% +%% %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% +%% +-module(alarm_handler). + +%%%----------------------------------------------------------------- +%%% This is the SASL alarm handler process. +%%% It is a gen_event process. When it is started, a simple +%%% event handler which logs all alarms is installed. +%%%----------------------------------------------------------------- +-export([start_link/0, set_alarm/1, clear_alarm/1, get_alarms/0, + add_alarm_handler/1, add_alarm_handler/2, + delete_alarm_handler/1]). + +-export([init/1, + handle_event/2, handle_call/2, handle_info/2, + terminate/2]). + +start_link() -> + case gen_event:start_link({local, alarm_handler}) of + {ok, Pid} -> + gen_event:add_handler(alarm_handler, alarm_handler, []), + {ok, Pid}; + Error -> Error + end. + +%%----------------------------------------------------------------- +%% Func: set_alarm/1 +%% Args: Alarm ::= {AlarmId, term()} +%% where AlarmId ::= term() +%%----------------------------------------------------------------- +set_alarm(Alarm) -> + gen_event:notify(alarm_handler, {set_alarm, Alarm}). + +%%----------------------------------------------------------------- +%% Func: clear_alarm/1 +%% Args: AlarmId ::= term() +%%----------------------------------------------------------------- +clear_alarm(AlarmId) -> + gen_event:notify(alarm_handler, {clear_alarm, AlarmId}). + +%%----------------------------------------------------------------- +%% Func: get_alarms/0 +%% Returns: [{AlarmId, AlarmDesc}] +%%----------------------------------------------------------------- +get_alarms() -> + gen_event:call(alarm_handler, alarm_handler, get_alarms). + +add_alarm_handler(Module) when is_atom(Module) -> + gen_event:add_handler(alarm_handler, Module, []). + +add_alarm_handler(Module, Args) when is_atom(Module) -> + gen_event:add_handler(alarm_handler, Module, Args). + +delete_alarm_handler(Module) when is_atom(Module) -> + gen_event:delete_handler(alarm_handler, Module, []). + +%%----------------------------------------------------------------- +%% Default Alarm handler +%%----------------------------------------------------------------- +init(_) -> {ok, []}. + +handle_event({set_alarm, Alarm}, Alarms)-> + error_logger:info_report([{alarm_handler, {set, Alarm}}]), + {ok, [Alarm | Alarms]}; +handle_event({clear_alarm, AlarmId}, Alarms)-> + error_logger:info_report([{alarm_handler, {clear, AlarmId}}]), + {ok, lists:keydelete(AlarmId, 1, Alarms)}; +handle_event(_, Alarms)-> + {ok, Alarms}. + +handle_info(_, Alarms) -> {ok, Alarms}. + +handle_call(get_alarms, Alarms) -> {ok, Alarms, Alarms}; +handle_call(_Query, Alarms) -> {ok, {error, bad_query}, Alarms}. + +terminate(swap, Alarms) -> + {alarm_handler, Alarms}; +terminate(_, _) -> + ok. diff --git a/lib/sasl/src/erlsrv.erl b/lib/sasl/src/erlsrv.erl new file mode 100644 index 0000000000..f9804c41dc --- /dev/null +++ b/lib/sasl/src/erlsrv.erl @@ -0,0 +1,420 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-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% +%% +-module(erlsrv). + +%% Purpose : Control the external erlsrv program. + +%%-compile(export_all). +-export([get_all_services/0,get_service/1,get_service/2,store_service/1, + store_service/2, + new_service/3, new_service/4, disable_service/2, + enable_service/2, disable_service/1, enable_service/1, + remove_service/1, erlsrv/1, rename_service/2, + rename_service/3]). + +erlsrv(EVer) -> + Root = code:root_dir(), + filename:join([Root, "erts-" ++ EVer, "bin", "erlsrv.exe"]). + +current_version() -> + hd(string:tokens(erlang:system_info(version),"_ ")). + +%%% Returns {ok, Output} | failed | {error, Reason} +run_erlsrv(Command) -> + run_erlsrv(current_version(),Command). +run_erlsrv(EVer, Command) -> + case catch(open_port({spawn, erlsrv(EVer) ++ " " ++ Command}, + [{line,1000}, in, eof])) of + {'EXIT',{Reason,_}} -> + {port_error, Reason}; + Port -> + case read_all_data(Port) of + [] -> + failed; + X -> + {ok, X} + end + end. + +run_erlsrv_interactive(EVer, Commands) -> + case catch(open_port({spawn, erlsrv(EVer) ++ " readargs"}, + [{line,1000}, eof])) of + {'EXIT',{Reason,_}} -> + {port_error, Reason}; + Port -> + write_all_data(Port, Commands), + case read_all_data(Port) of + [] -> + failed; + X -> + {ok, X} + end + end. + +write_all_data(Port,[]) -> + Port ! {self(), {command, io_lib:nl()}}, + ok; +write_all_data(Port,[H|T]) -> + Port ! {self(), {command, H ++ io_lib:nl()}}, + write_all_data(Port,T). + +read_all_data(Port) -> + receive + {Port, {data, {eol,Data}}} -> + [ Data | read_all_data(Port)]; + _ -> + Port ! {self(), close}, + receive + {Port, closed} -> + [] + end + end. + + +%%% Get all registered erlsrv services. +get_all_services() -> + case run_erlsrv("list") of + failed -> + []; + {ok, [_]} -> + []; + {ok, [_H|T]} -> + F = fun(X) -> + hd(string:tokens(X,"\t ")) + end, + lists:map(F,T); + _ -> + {error, external_program_failed} + end. + +disable_service(ServiceName) -> + disable_service(current_version(), ServiceName). +disable_service(EVer, ServiceName) -> + run_erlsrv(EVer, "disable " ++ ServiceName). +enable_service(ServiceName) -> + enable_service(current_version(), ServiceName). +enable_service(EVer, ServiceName) -> + run_erlsrv(EVer, "enable " ++ ServiceName). +remove_service(ServiceName) -> + run_erlsrv("remove " ++ ServiceName). +rename_service(FromName, ToName) -> + rename_service(current_version(), FromName, ToName). +rename_service(EVer, FromName, ToName) -> + run_erlsrv(EVer, "rename " ++ FromName ++ " " ++ ToName). + +%%% Get all information about a service +%%% Returns [{Field,Value | []} ...] +%%% Field is one of: +%%% servicename : The service name (equal to parameter...) +%%% stopaction : The erlang expression that shall stop the node +%%% onfail : Action to take when erlang fails unexpectedly +%%% machine : Full pathname of the erlang machine or start_erl program +%%% workdir : The initial working directory of the erlang machine +%%% sname | name : The short name of the node +%%% priority : The OS priority of the erlang process +%%% args : All arguments correctly parsed into a list of strings +%%% comment : The service description +%%% internalservicename : The windows internal service name +%%% env : A list of environment variables and values [{"VAR", "VALUE"}] +%%% Example: +%%% [{servicename,"kalle_R4A"}, +%%% {stopaction,"erlang:halt()."}, +%%% {args,["-boot", "nisse","--","-reldir", "c:\myapproot"]} +%%% {env,[{"FOO","BAR"},{"VEGETABLE","TOMATO"}]}] + +get_service(ServiceName) -> + get_service(current_version(), ServiceName). +get_service(EVer, ServiceName) -> + case run_erlsrv(EVer, "list " ++ ServiceName) of + failed -> + {error, no_such_service}; + {port_error, Reason} -> + {error, {port_error, Reason}}; + {ok, Data} -> + Table = [{"Service name",servicename,[]}, + {"StopAction",stopaction, []}, + {"OnFail",onfail, "ignore"}, + {"Machine",machine, []}, + {"WorkDir",workdir, []}, + {"SName",sname, []}, + {"Name",name, []}, + {"Priority",priority, "default"}, + {"DebugType",debugtype, "none"}, + {"Args",args,[]}, + {"InternalServiceName",internalservicename,[]}, + {"Comment",comment,[]}], + %% Env has special treatment... + F = fun(X) -> + {Name,Value} = splitline(X), + case lists:keysearch(Name,1,Table) of + {value,{Name,_Atom,Value}} -> + []; + {value,{Name,Atom,_}} -> + {Atom,Value}; + _ -> + [] + end + end, + %%% First split by Env: + {Before, After} = split_by_env(Data), + FirstPass = lists:flatten(lists:map(F,Before)), + %%% If the arguments are there, split them to + SecondPass = split_arglist(FirstPass), + %%% And now, if After contains anything, that is vwat to + %%% have in the environment list... + EnvParts = lists:map( + fun(S) -> + X = string:strip(S,left,$\t), + case hd(string:tokens(X,"=")) of + X -> + %% Can this happen? + {X,""}; + Y -> + {Y, + lists:sublist(X,length(Y)+2, + length(X))} + end + end, + After), + case EnvParts of + [] -> + SecondPass; + _ -> + lists:append(SecondPass,[{env,EnvParts}]) + end + end. + + +store_service(Service) -> + store_service(current_version(),Service). +store_service(EmulatorVersion,Service) -> + case lists:keysearch(servicename,1,Service) of + false -> + {error, no_servicename}; + {value, {_,Name}} -> + {Action,Service1} = case get_service(Name) of + {error, no_such_service} -> + {"add",Service}; + _ -> + {"set", + lists:keydelete(internalservicename,1,Service)} + end, + Commands = [Action | build_commands(Name, Service1)], + case run_erlsrv_interactive(EmulatorVersion,Commands) of + {ok, _} -> + ok; + X -> + {error, X} + end; + _ -> + {error, malformed_description} + end. + +build_commands(Action, Service) -> + [ Action | lists:reverse(build_commands2(Service,[]))]. + +build_commands2([],A) -> + A; +build_commands2([{env,[]}|T],A) -> + build_commands2(T,A); +build_commands2([{env,[{Var,Val}|Et]}|T],A) -> + build_commands2([{env,Et}|T],[Var ++ "=" ++ Val, "-env" | A]); +build_commands2([{servicename,_}|T],A) -> + build_commands2(T,A); +build_commands2([{Atom,[]} | T],A) -> + build_commands2(T,["-" ++ atom_to_list(Atom) | A]); +build_commands2([{args,L}|T],A) -> + build_commands2(T,[concat_args(L),"-args"| A]); +build_commands2([{Atom,Value} | T],A) -> + build_commands2(T,[Value, "-" ++ atom_to_list(Atom) | A]). + +concat_args([H|T]) -> + H ++ concat_args2(T). +concat_args2([]) -> + ""; +concat_args2([H|T]) -> + " " ++ H ++ concat_args2(T). + + +new_service(NewServiceName, OldService, Data) -> + new_service(NewServiceName, OldService, Data, []). +new_service(NewServiceName, OldService, Data, RestartName) -> + Tmp0 = lists:keydelete(internalservicename,1,OldService), %Remove when + % creating new service from + % old. + Tmp1 = lists:keyreplace(servicename, 1, Tmp0, + {servicename, NewServiceName}), + Tmp = case lists:keysearch(env,1,Tmp1) of + {value, {env,Env0}} -> + Env1 = lists:keydelete("ERLSRV_SERVICE_NAME",1,Env0), + lists:keyreplace(env,1,Tmp1, + {env, [{"ERLSRV_SERVICE_NAME", + RestartName} | + Env1]}); + _ -> + Tmp1 + end, + + ArgsTmp = case lists:keysearch(args, 1, Tmp) of + false -> + []; + {value, {args, OldArgs}} -> + OldArgs + end, + Args = backstrip(ArgsTmp,"++"), %% Remove trailing ++, has no meaning + {Found, Tail} = lists:foldr(fun(A,{Flag,AccIn}) -> + case {Flag, A} of + {true, _} -> {Flag,AccIn}; + {false, "++"} -> {true, AccIn}; + _ -> {false, [A|AccIn]} + end + end, {false,[]}, Args), + + {OtherFlags, _DataDir} = case Found of + true -> + check_tail(Tail); + false -> + {[], false} + end, + NewArgs1 = case Data of + [] -> + OtherFlags; + _ -> + ["-data", Data| OtherFlags] + end, + case Found of + false -> + A = case NewArgs1 of + [] -> + []; + _ -> + ["++" | NewArgs1] + end, + case {Args,A} of + {[],[]} -> + Tmp; + {[],_} -> + Tmp ++ [{args, A}]; + {_,_} -> + lists:keyreplace(args, 1, Tmp, {args, Args ++ A}) + end; + true -> + StripArgs = backstrip(Args,["++"|Tail]), + NewArgs2 = case NewArgs1 of + [] -> + []; + _ -> + ["++" |NewArgs1] + end, + NewArgs = StripArgs ++ NewArgs2, + lists:keyreplace(args, 1, Tmp, {args, NewArgs}) + end. + + +backstrip(List,Tail) -> + lists:reverse(backstrip2(lists:reverse(List),lists:reverse(Tail))). +backstrip2([A|T1],[A|T2]) -> + backstrip2(T1,T2); +backstrip2(L,_) -> + L. + +check_tail(Tail) -> + {A,B} = check_tail(Tail, [], false), + {lists:reverse(A),B}. + +check_tail([], OtherFlags, DataDir) -> + {OtherFlags, DataDir}; +check_tail(["-data", TheDataDir|T], OtherFlags, _DataDir) -> + check_tail(T, OtherFlags, TheDataDir); +check_tail([H|T],OtherFlags,DataDir) -> + check_tail(T,[H|OtherFlags],DataDir). + + + + +%%% Recursive, The list is small +split_arglist([]) -> + []; +split_arglist([{args,Str}|T]) -> + [{args,parse_arglist(Str)}|T]; +split_arglist([H|T]) -> + [H|split_arglist(T)]. + +%% Not recursive, may be long... +parse_arglist(Str) -> + lists:reverse(parse_arglist(Str,[])). +parse_arglist(Str,Accum) -> + Stripped = string:strip(Str,left), + case length(Stripped) of + 0 -> + Accum; + _ -> + {Next, Rest} = pick_argument(Str), + parse_arglist(Rest,[Next | Accum]) + end. + +pick_argument(Str) -> + {Rev,Rest} = pick_argument(normal,Str,[]), + {lists:reverse(Rev),Rest}. + +pick_argument(_,[],Acc) -> + {Acc, ""}; +pick_argument(normal,[$ |T],Acc) -> + {Acc,T}; +pick_argument(normal,[$"|T],Acc) -> + pick_argument(quoted,T,[$"|Acc]); +pick_argument(quoted_escaped,[H|T],Acc) -> + pick_argument(quoted,T,[H|Acc]); +pick_argument(quoted,[$"|T],Acc) -> + pick_argument(normal,T,[$"|Acc]); +pick_argument(quoted,[$\\|T],Acc) -> + pick_argument(quoted_escaped,T,[$\\|Acc]); +pick_argument(quoted,[H|T],Acc) -> + pick_argument(quoted,T,[H|Acc]); +pick_argument(normal,[H|T],Acc) -> + pick_argument(normal,T,[H|Acc]). + +split_helper("Env:",{Where,0}) -> + {Where + 1, Where}; +split_helper(_, {Where,Pos}) -> + {Where + 1, Pos}. + +split_by_env(Data) -> + %%% Find Env... + case lists:foldl(fun split_helper/2,{0,0},Data) of + {_,0} -> + %% Not found, hmmmm.... + {Data,[]}; + {Len,Pos} -> + {lists:sublist(Data,Pos),lists:sublist(Data,Pos+2,Len)} + end. + + +splitline(Line) -> + case string:chr(Line,$:) of + 0 -> + {Line, ""}; + N -> + case length(string:substr(Line,N)) of + 1 -> + {string:substr(Line,1,N-1),""}; + _ -> + {string:substr(Line,1,N-1),string:substr(Line,N+2)} + end + end. diff --git a/lib/sasl/src/format_lib_supp.erl b/lib/sasl/src/format_lib_supp.erl new file mode 100644 index 0000000000..af15fd3288 --- /dev/null +++ b/lib/sasl/src/format_lib_supp.erl @@ -0,0 +1,224 @@ +%% +%% %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% +%% +-module(format_lib_supp). + +%%%--------------------------------------------------------------------- +%%% Description: +%%% This module contains generic formatting functions for the SUPPort +%%% tools. +%%% The main parts are: +%%% 1) print_info. Prints information tagged by 'header', 'data', +%%% 'table', 'items' and 'newline'. +%%%--------------------------------------------------------------------- + +%% intermodule exports +-export([print_info/2, print_info/3]). + +%% exports for use within module +-export([maxcol/2]). + +%%--------------------------------------------------------------------- +%% Format is an ordered list of: +%% {header, HeaderString} +%% {data, List_Of_KeyValue_tuples} +%% The KeyValues_tuples will be printed on one line +%% (if possible); 'Key: Value'. +%% Elements in the list may also be single terms, which are +%% printed as they are. +%% {table, {TableName, ColumnNames, Columns}} +%% ColumnNames is a tuple of names for the columns, and +%% Columns is a list, where each element is a tuple of +%% data for that column. +%% {items, {Name, Items}} +%% Items is a list of KeyValue_tuples. Will be printed as: +%% 'Name: +%% Key1: Value1 +%% KeyN: ValueN' +%% {newline, N} +%% Any other format will be ignored. +%% This list is printed in order. If the header clause is present, +%% it must be the first element in the format list. +%% ------------------------------------------------------------------ +print_info(Device, Format) -> + print_info(Device, 79, Format). +print_info(Device, Line, Format) -> + print_header(Device, Line, Format), + print_format(Device, Line, Format). + +print_header(Device, Line, [{header, Header}|_]) -> + print_header2(Device, Line, Header); +print_header(Device, Line, _) -> + print_header2(Device, Line, ""). +print_header2(Device, Line, Header) -> + Format1 = lists:concat(["~n~", Line, ".", Line, "s~n"]), + Format2 = lists:concat(["~", Line, "c~n"]), + io:format(Device, Format1, [Header]), + io:format(Device, Format2, [$=]). + +print_format(Device, _Line, []) -> + io:format(Device, '~n', []); +print_format(Device, Line, [{data, Data}|T]) -> + print_data(Device, Line, Data), + print_format(Device, Line, T); +print_format(Device, Line, [{table, Table}|T]) -> + print_table(Device, Line, Table), + print_format(Device, Line, T); +print_format(Device, Line, [{items, Items}|T]) -> + print_items(Device, Line, Items), + print_format(Device, Line, T); +print_format(Device, Line, [{newline, N}|T]) -> + print_newlines(Device, N), + print_format(Device, Line, T); +print_format(Device, Line, [_|T]) -> % ignore any erroneous format. + print_format(Device, Line, T). + +print_data(_Device, _Line, []) -> ok; +print_data(Device, Line, [{Key, Value}|T]) -> + print_one_line(Device, Line, Key, Value), + print_data(Device, Line, T); +print_data(Device, Line, [Value|T]) -> + io:format(Device, "~p~n", [Value]), + print_data(Device, Line, T). + +print_items(Device, Line, {Name, Items}) -> + print_items(Device, Line, Name, Items). + +print_table(Device, Line, {TableName, ColumnNames, Columns}) -> + print_table(Device, Line, TableName, ColumnNames, Columns). + +print_newlines(_Device, 0) -> ok; +print_newlines(Device, N) when N > 0 -> + io:format(Device, '~n', []), + print_newlines(Device, N-1). + +print_one_line(Device, Line, Key, Value) -> + StrKey = term_to_string(Key), + KeyLen = lists:min([length(StrKey), Line]), + ValueLen = Line - KeyLen, + Format1 = lists:concat(["~-", KeyLen, s]), + Format2 = lists:concat(["~", ValueLen, "s~n"]), + io:format(Device, Format1, [StrKey]), + Try = term_to_string(Value), + Length = length(Try), + if + Length < ValueLen -> + io:format(Device, Format2, [Try]); + true -> + io:format(Device, "~n ", []), + Format3 = lists:concat(["~", Line, ".9p~n"]), + io:format(Device, Format3, [Value]) + end. + +term_to_string(Value) -> + lists:flatten(io_lib:format(get_format(Value), [Value])). + +get_format(Value) -> + case misc_supp:is_string(Value) of + true -> "~s"; + false -> "~p" + end. + +make_list(0, _Elem) -> []; +make_list(N, Elem) -> [Elem|make_list(N-1, Elem)]. + + +%%----------------------------------------------------------------- +%% Items +%%----------------------------------------------------------------- +print_items(Device, Line, Name, Items) -> + print_one_line(Device, Line, Name, " "), + print_item_elements(Device, Line, Items). + +print_item_elements(_Device, _Line, []) -> ok; +print_item_elements(Device, Line, [{Key, Value}|T]) -> + print_one_line(Device, Line, lists:concat([" ", Key]), Value), + print_item_elements(Device, Line, T). + +%%----------------------------------------------------------------- +%% Table handling +%%----------------------------------------------------------------- +extra_space_between_columns() -> 3. + +find_max_col([Row | T], ColumnSizes) -> + find_max_col(T, misc_supp:multi_map({format_lib_supp, maxcol}, + [Row, ColumnSizes])); + +find_max_col([], ColumnSizes) -> ColumnSizes. + +maxcol(Term, OldMax) -> + lists:max([length(term_to_string(Term)), OldMax]). + +make_column_format(With) -> + lists:concat(["~", With + extra_space_between_columns(), s]). + +is_correct_column_length(_Length, []) -> true; +is_correct_column_length(Length, [Tuple|T]) -> + case size(Tuple) of + Length -> is_correct_column_length(Length, T); + _ -> false + end; +is_correct_column_length(_, _) -> false. + +print_table(Device, Line, TableName, _TupleOfColumnNames, []) -> + print_one_line(Device, Line, TableName, "<empty table>"), + io:format(Device, "~n", []); + +print_table(Device, Line, TableName, TupleOfColumnNames, ListOfTuples) + when is_list(ListOfTuples), is_tuple(TupleOfColumnNames) -> + case is_correct_column_length(size(TupleOfColumnNames), + ListOfTuples) of + true -> + print_one_line(Device, Line, TableName, " "), + ListOfColumnNames = tuple_to_list(TupleOfColumnNames), + ListOfLists = lists:map(fun(Tuple) -> + tuple_to_list(Tuple) + end, + ListOfTuples), + ColWidths = find_max_col([ListOfColumnNames | + ListOfLists], + make_list(length(ListOfColumnNames),0)), + Format = lists:flatten([lists:map(fun(CW) -> + make_column_format(CW) + end, + ColWidths), "~n"]), + io:format(Device, Format, ListOfColumnNames), + io:format(Device, + lists:concat(['~', extra_space_between_columns(), + 'c', '~', lists:sum(ColWidths) + + (length(ColWidths) - 1) + * extra_space_between_columns(), + 'c~n']), [$ , $-]), + lists:foreach(fun(List) -> + print_row(List, Device, Format) + end, + ListOfLists), + io:format(Device, '~n', []), + true; + false -> + {error, {'a tuple has wrong size', + {TableName, TupleOfColumnNames, ListOfTuples}}} + end. + +%%-------------------------------------------------- +%% Device MUST be 2nd arg because of extraarg ni foreach... +%%-------------------------------------------------- +print_row(Row, Device, Format) -> + io:format(Device, Format, + lists:map(fun(Term) -> term_to_string(Term) end, + Row)). diff --git a/lib/sasl/src/misc_supp.erl b/lib/sasl/src/misc_supp.erl new file mode 100644 index 0000000000..8948fdb797 --- /dev/null +++ b/lib/sasl/src/misc_supp.erl @@ -0,0 +1,106 @@ +%% +%% %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% +%% +-module(misc_supp). + +%%%--------------------------------------------------------------------- +%%% Description: +%%% This module contains MISCellaneous routines for the SUPPort tools. +%%% 1) The function format_pdict/3 is called by every process that +%%% wants to format its process dictionary. +%%% 2) Very generic functions such as, multi_map, is_string... +%%% +%%% This module is a part of the BOS. (format_pdict is called from +%%% init, memsup, disksup, overload (but not the fileserver since it +%%% formats its pdict its own way).) +%%%--------------------------------------------------------------------- + +-export([format_pdict/3, format_tuples/2, assq/2, passq/2, is_string/1, + multi_map/2]). + +%%----------------------------------------------------------------- +%% Uses format_tuples to format the data in process dictionary. +%% This function is called from format_status_info by several modules +%% that want to format its process dictionary. +%% Args: Exclude is: list of atoms to exclude +%%----------------------------------------------------------------- +format_pdict(normal, _PDict, _Exclude) -> + []; +format_pdict(all, PDict, Exclude) -> + case format_tuples(PDict, ['$sys_dict$' | Exclude]) of + [] -> []; + Data -> [{newline, 1} | Data] + end. + + +%%----------------------------------------------------------------- +%% Format all Key value tuples except for the Keys in the +%% Exclude list. +%%----------------------------------------------------------------- +format_tuples(KeyValues, Exclude) -> + case format_tuples(KeyValues, Exclude, []) of + [] -> []; + Data -> [{data, Data}] + end. +format_tuples([], _Exclude, Res) -> Res; +format_tuples([{Key, Value} | T], Exclude, Res) -> + case lists:member(Key, Exclude) of + true -> + format_tuples(T, Exclude, Res); + false -> + format_tuples(T, Exclude, [{Key, Value} | Res]) + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% "Very" generic misc stuff: +%%-------------------------------------------------- + +assq(Key, List) -> + case lists:keysearch(Key, 1, List) of + {value, {Key, Val}} -> {value, Val}; + _ -> false + end. + +%% Primitive assq. Use to get items from a process dictionary list. +passq(Key, List) -> + case lists:keysearch(Key, 1, List) of + {value, {Key, Val}} -> Val; + _ -> undefined + end. + +%% This one doesn't treat [] as a string (as io_lib:char_list) +is_string([]) -> false; +is_string(X) -> is_string_2(X). + +is_string_2([]) -> true; +is_string_2([H|T]) when is_integer(H), H >= $ , H =< 255 -> + is_string_2(T); +is_string_2(_) -> false. + +%%----------------------------------------------------------------- +%% Pre: ListOfLists is a list of N lists, each of length M. +%% Func is a function of arity N. +%% Returns: A list of length M where element Y is the result of +%% applying Func on [Elem(Y, List1), ..., Elem(Y, ListN)]. +%%----------------------------------------------------------------- +multi_map(_Func, [[] | _ListOfLists]) -> []; +multi_map(Func, ListOfLists) -> + [apply(Func, lists:map(fun(List) -> hd(List) end, ListOfLists)) | + multi_map(Func, + lists:map(fun(List) -> tl(List) end, ListOfLists))]. diff --git a/lib/sasl/src/overload.erl b/lib/sasl/src/overload.erl new file mode 100644 index 0000000000..3a9a51e8bf --- /dev/null +++ b/lib/sasl/src/overload.erl @@ -0,0 +1,224 @@ +%% +%% %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% +%% +-module(overload). + +-export([start_link/0, request/0, set_config_data/2, + get_overload_info/0]). + +-export([init/1, handle_call/3, handle_info/2, terminate/2, + format_status/2]). + +%%%----------------------------------------------------------------- +%%% This is a rewrite of overload from BS.3, by Peter H�gfeldt. +%%% +%%% DESCRIPTION +%%% +%%% This module implements a server process that keeps record of the +%%% intensity of calls of the request/0 function, and answers accept or +%%% reject depending on if the current average intensity is not greater +%%% than a specified maximum intensity. +%%% +%%% The intensity i is calculated according to the formula: +%%% i(n) = exp(-K*(T(n) - T(n-1)))*i(n-1) + Kappa +%%% where i(n) is the intensity at event n, Kappa is a constant, and +%%% T(n) is the time at event n. +%%% +%%% The constant Kappa can be thought of as 1 / T, where T is the time +%%% constant. Kappa is externally referred to as Weight. +%%% +%%% We keep track of two intensities: the total call intensity and the +%%% intensity of accepted calls. +%%%----------------------------------------------------------------- +%%% TODO +%%% +%%% 3. Hysteresis. +%%% +%%%----------------------------------------------------------------- + +-record(state, {total = 0, accept = 0, max, prev_t = get_now(), + kappa, call_counts = {0, 0}, alarm = clear}). + +-define(clear_timeout, 30000). + +start_link() -> + gen_server:start_link({local, overload}, overload, [], []). + +init([]) -> + process_flag(priority, high), + MaxIntensity = fetch_config_data(overload_max_intensity), + Kappa = fetch_config_data(overload_weight), + {ok, #state{max = MaxIntensity, kappa = Kappa}}. + +%%----------------------------------------------------------------- +%% Func: request/0 +%% Purpose: This is a request to proceed, e.g. a request to +%% establish a call. +%% Returns: accept | reject +%%----------------------------------------------------------------- +request() -> gen_server:call(overload, request). + +%%----------------------------------------------------------------- +%% Func: set_config_data/2 +%% Purpose: Set configuration data, and reset intensities. +%% Arguments: MaxIntensity (real > 0), Weight (real > 0). +%% Returns: ok | {error, What} +%% This function is for debugging purposes and is therefore not +%% documented at all. +%%----------------------------------------------------------------- +set_config_data(MaxIntensity, Weight) -> + gen_server:call(overload, {set_config_data, MaxIntensity, Weight}). +%%----------------------------------------------------------------- +%% Func: get_overload_info/0 +%% Returns: A list of tagged items: TotalIntensity, AcceptIntensity, +%% MaxIntensity, Weight, TotalRequests, AcceptedRequests. +%%----------------------------------------------------------------- +get_overload_info() -> gen_server:call(overload, get_overload_info). + +%%%----------------------------------------------------------------- +%%% Callback functions from gen_server +%%%----------------------------------------------------------------- +handle_call(request, _From, State) -> + #state{total = TI, accept = AI, kappa = Kappa, prev_t = PrevT, + alarm = Alarm} = State, + {TR, AR} = State#state.call_counts, + T = get_now(), + CurI = new_intensity(AI, T, PrevT, Kappa), + NewTI = new_intensity(TI, T, PrevT, Kappa) + Kappa, + if + CurI =< State#state.max -> + %% Hysteresis: If alarm is set, and current intensity has + %% fallen below 75% of max intensity, clear alarm. + NewAlarm = if + CurI =< 0.75*State#state.max -> + clear_alarm(Alarm); + true -> + Alarm + end, + {reply, accept, State#state{call_counts = {TR+1, AR+1}, + prev_t = T, total = NewTI, + accept = CurI + Kappa, + alarm = NewAlarm}, + ?clear_timeout}; + true -> + %% Set alarm if not already set. + NewAlarm = set_alarm(Alarm), + {reply, reject, + State#state{call_counts = {TR+1, AR}, prev_t = T, + total = NewTI, accept = CurI, + alarm = NewAlarm}, + ?clear_timeout} + end; +handle_call({set_config_data, MaxIntensity, Weight}, _From, _State) -> + {reply, ok, #state{max = MaxIntensity, kappa = Weight}, + ?clear_timeout}; +handle_call(get_overload_info, _From, State) -> + #state{max = MI, total = TI, accept = AI, kappa = Kappa, + prev_t = PrevT, call_counts = {TR, AR}} = State, + T = get_now(), + CurI = new_intensity(AI, T, PrevT, Kappa), + NewTI = new_intensity(TI, T, PrevT, Kappa), + Reply = [{total_intensity, NewTI}, {accept_intensity, CurI}, + {max_intensity, MI}, {weight, Kappa}, + {total_requests, TR}, {accepted_requests, AR}], + {reply, Reply, State#state{total = NewTI, accept = CurI}, + ?clear_timeout}. + +handle_info(timeout, State) -> + #state{total = TI, accept = AI, kappa = Kappa, prev_t = PrevT, + alarm = Alarm} = State, + T = get_now(), + CurI = new_intensity(AI, T, PrevT, Kappa), + NewTI = new_intensity(TI, T, PrevT, Kappa), + if + CurI < 0.75* State#state.max -> + NewAlarm = clear_alarm(Alarm), + {noreply, State#state{total = NewTI, accept = CurI, + alarm = NewAlarm}}; + + true -> + {noreply, State#state{total = NewTI, accept = CurI}, + ?clear_timeout} + end; + +handle_info(_, State) -> + {noreply, State, ?clear_timeout}. + +terminate(_Reason, _State) -> + ok. + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- +fetch_config_data(Tag) -> + case application:get_env(sasl, Tag) of + {ok, Value} -> Value; + _ -> fetch_default_data(Tag) + end. + +fetch_default_data(overload_max_intensity) -> 0.8; +fetch_default_data(overload_weight) -> 0.1. + +set_alarm(clear) -> + alarm_handler:set_alarm({overload, []}), + set; +set_alarm(Alarm) -> + Alarm. + +clear_alarm(set) -> + alarm_handler:clear_alarm(overload), + clear; +clear_alarm(Alarm) -> + Alarm. + +%%----------------------------------------------------------------- +%% The catch protects against floating-point exception. +%% +new_intensity(I, T, PrevT, K) -> + Diff = sub(T, PrevT)/1000, + case catch (I*math:exp(-K*Diff)) of + {'EXIT', _} -> % Assume zero. + 0.0; + Res -> + Res + end. + +%% Mask equal to 2^27 - 1, used below. +-define(mask27, 16#7ffffff). + +%% Returns number of milliseconds in the range [0, 2^27 - 1]. Must have +%% this since statistics(wall_clock) wraps. Having 2^27 -1 as the max +%% assures that we always get non-negative integers. 2^27 milliseconds +%% are approx. 37.28 hours. +get_now() -> + element(1, statistics(wall_clock)) band ?mask27. + +%% Returns (X - Y) mod 2^27 (which is in the range [0, 2^27 - 1]). +sub(X, Y) -> + (X + (bnot Y) + 1) band ?mask27. + +format_status(Opt, [PDict, #state{max = MI, total = TI, accept = AI, + kappa = K, + call_counts = {TR, AR}}]) -> + [{data, [{"Total Intensity", TI}, + {"Accept Intensity", AI}, + {"Max Intensity", MI}, + {"Weight", K}, + {"Total requests", TR}, + {"Accepted requests", AR}]} | + misc_supp:format_pdict(Opt, PDict, [])]. diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl new file mode 100644 index 0000000000..00d86285e5 --- /dev/null +++ b/lib/sasl/src/rb.erl @@ -0,0 +1,697 @@ +%% +%% %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% +%% +-module(rb). + +-behaviour(gen_server). + +%% External exports +-export([start/0, start/1, stop/0, rescan/0, rescan/1]). +-export([list/0, list/1, show/0, show/1, grep/1, start_log/1, stop_log/0]). +-export([h/0, help/0]). + +%% Internal exports +-export([start_link/1]). + +%% gen_server callbacks +-export([init/1, terminate/2, handle_call/3, + handle_cast/2, handle_info/2, code_change/3]). + +%%%----------------------------------------------------------------- +%%% Report Browser Tool. +%%% Formats Error reports written by log_mf_h +%%%----------------------------------------------------------------- + +-record(state, {dir, data, device, max, type, abort, log}). + +%%----------------------------------------------------------------- +%% Interface functions. +%% For available options; see print_options(). +%%----------------------------------------------------------------- +start() -> start([]). +start(Options) -> + supervisor:start_child(sasl_sup, + {rb_server, {rb, start_link, [Options]}, + temporary, brutal_kill, worker, [rb]}). + +start_link(Options) -> + gen_server:start_link({local, rb_server}, rb, Options, []). + +stop() -> + gen_server:call(rb_server, stop), + supervisor:delete_child(sasl_sup, rb_server). + +rescan() -> rescan([]). +rescan(Options) -> + gen_server:call(rb_server, {rescan, Options}, infinity). + +list() -> list(all). +list(Type) -> gen_server:call(rb_server, {list, Type}, infinity). + +show() -> + gen_server:call(rb_server, show, infinity). + +show(Number) when is_integer(Number) -> + gen_server:call(rb_server, {show_number, Number}, infinity); +show(Type) when is_atom(Type) -> + gen_server:call(rb_server, {show_type, Type}, infinity). + +grep(RegExp) -> gen_server:call(rb_server, {grep, RegExp}, infinity). + +start_log(FileName) -> gen_server:call(rb_server, {start_log, FileName}). + +stop_log() -> gen_server:call(rb_server, stop_log). + +h() -> help(). +help() -> + io:format("~nReport Browser Tool - usage~n"), + io:format("===========================~n"), + io:format("rb:start() - start the rb_server with default options~n"), + io:format("rb:start(Options) - where Options is a list of:~n"), + print_options(), + io:format("rb:h() - print this help~n"), + io:format("rb:help() - print this help~n"), + io:format("rb:list() - list all reports~n"), + io:format("rb:list(Type) - list all reports of type Type~n"), + io:format(" currently supported types are:~n"), + print_types(), + io:format("rb:grep(RegExp) - print reports containing RegExp~n"), + io:format("rb:rescan() - rescans the report directory with same~n"), + io:format(" options.~n"), + io:format("rb:rescan(Options) - rescans the report directory with new~n"), + io:format(" options. Options is same as in start/1.~n"), + io:format("rb:show(Number) - print report no Number~n"), + io:format("rb:show(Type) - print all reports of type Type~n"), + io:format("rb:show() - print all reports~n"), + io:format("rb:start_log(File) - redirect all reports to file~n"), + io:format("rb:stop_log() - close the log file and redirect to~n"), + io:format(" standard_io~n"), + io:format("rb:stop - stop the rb_server~n"). + +%%----------------------------------------------------------------- +%% Internal functions. +%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% MAKE SURE THESE TWO FUNCTIONS ARE UPDATED! +%%----------------------------------------------------------------- +print_options() -> + io:format(" {start_log, FileName}~n"), + io:format(" - default: standard_io~n"), + io:format(" {max, MaxNoOfReports}~n"), + io:format(" - MaxNoOfReports should be an integer or 'all'~n"), + io:format(" - default: all~n"), + io:format(" {report_dir, DirString}~n"), + io:format(" - DirString should be a string without trailing~n"), + io:format(" - directory delimiter.~n"), + io:format(" - default: {sasl, error_logger_mf_dir}~n"), + io:format(" {type, ReportType}~n"), + io:format(" - ReportType should be a supported type, 'all'~n"), + io:format(" - or a list of supported types~n"), + io:format(" - default: all~n"), + io:format(" {abort_on_error, Bool}~n"), + io:format(" - Bool: true | false~n"), + io:format(" - default: false~n"). + +print_types() -> + io:format(" - crash_report~n"), + io:format(" - supervisor_report~n"), + io:format(" - progress~n"), + io:format(" - error~n"). + + +init(Options) -> + process_flag(priority, low), + process_flag(trap_exit, true), + Log = get_option(Options, start_log, standard_io), + Device = open_log_file(Log), + Dir = get_report_dir(Options), + Max = get_option(Options, max, all), + Type = get_option(Options, type, all), + Abort = get_option(Options, abort_on_error, false), + Data = scan_files(Dir ++ "/", Max, Type), + {ok, #state{dir = Dir ++ "/", data = Data, device = Device, + max = Max, type = Type, abort = Abort, log = Log}}. + +handle_call({rescan, Options}, _From, State) -> + {Device,Log1} = + case get_option(Options, start_log, {undefined}) of + {undefined} -> + {State#state.device,State#state.log}; + Log -> + close_device(State#state.device), + {open_log_file(Log),Log} + end, + Max = get_option(Options, max, State#state.max), + Type = get_option(Options, type, State#state.type), + Abort = get_option(Options, abort_on_error, false), + Data = scan_files(State#state.dir, Max, Type), + NewState = State#state{data = Data, max = Max, type = Type, + device = Device, abort = Abort, log = Log1}, + {reply, ok, NewState}; +handle_call(stop, _From, State) -> + {stop, normal, stopped, State}; +handle_call(_, _From, #state{data = undefined}) -> + {reply, {error, no_data}, #state{}}; +handle_call({list, Type}, _From, State) -> + print_list(State#state.data, Type), + {reply, ok, State}; +handle_call({start_log, FileName}, _From, State) -> + NewDevice = open_log_file(FileName), + {reply, ok, State#state{device = NewDevice}}; +handle_call(stop_log, _From, State) -> + close_device(State#state.device), + {reply, ok, State#state{device = standard_io}}; +handle_call({show_number, Number}, _From, State) -> + #state{dir = Dir, data = Data, device = Device, abort = Abort, log = Log} = State, + NewDevice = print_report_by_num(Dir, Data, Number, Device, Abort, Log), + {reply, ok, State#state{device = NewDevice}}; +handle_call({show_type, Type}, _From, State) -> + #state{dir = Dir, data = Data, device = Device, abort = Abort, log = Log} = State, + NewDevice = print_typed_reports(Dir, Data, Type, Device, Abort, Log), + {reply, ok, State#state{device = NewDevice}}; +handle_call(show, _From, State) -> + #state{dir = Dir, data = Data, device = Device, abort = Abort, log = Log} = State, + NewDevice = print_all_reports(Dir, Data, Device, Abort, Log), + {reply, ok, State#state{device = NewDevice}}; +handle_call({grep, RegExp}, _From, State) -> + #state{dir = Dir, data = Data, device = Device, abort = Abort, log = Log} = State, + NewDevice = print_grep_reports(Dir, Data, RegExp, Device, Abort, Log), + {reply, ok, State#state{device = NewDevice}}. + +terminate(_Reason, #state{device = Device}) -> + close_device(Device). + +handle_cast(_Msg, State) -> + {noreply, State}. +handle_info(_Info, State) -> + {noreply, State}. +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%----------------------------------------------------------------- +%% Func: open_log_file/1 +%% Args: FileName | standard_io +%% Returns: A Device for later use in call to io:format +%%----------------------------------------------------------------- +open_log_file(standard_io) -> standard_io; +open_log_file(FileName) -> + case file:open(FileName, [write,append]) of + {ok, Fd} -> Fd; + Error -> + io:format("rb: Cannot open file '~s' (~w).~n", + [FileName, Error]), + io:format("rb: Using standard_io~n"), + standard_io + end. + +close_device(Fd) when is_pid(Fd) -> + catch file:close(Fd); +close_device(_) -> ok. + +get_option(Options, Key, Default) -> + case lists:keysearch(Key, 1, Options) of + {value, {_Key, Value}} -> Value; + _ -> Default + end. + +get_report_dir(Options) -> + case lists:keysearch(report_dir, 1, Options) of + {value, {_Key, RptDir}} -> RptDir; + _ -> + case catch application:get_env(sasl, error_logger_mf_dir) of + {ok, Dir} -> Dir; + _ -> + exit("cannot locate report directory") + end + end. + +%%----------------------------------------------------------------- +%% Func: scan_files(RptDir, Max, Type) +%% Args: RptDir ::= string(). +%% Max ::= integer() | all, describing how many reports +%5 to read. +%% Type ::= atom(), describing which reports to read. +%% Purpose: Scan all report files one time, and build a list of +%% small elements +%% Returns: Data, where Data is a list of +%% {Number, Type, ShortDescr, Date, Fname, FilePosition}. +%%----------------------------------------------------------------- +scan_files(RptDir, Max, Type) -> + case file:open(RptDir ++ "/index", [raw, read]) of + {ok, Fd} -> + case catch file:read(Fd, 1) of + {ok, [LastWritten]} -> + Files = make_file_list(RptDir, LastWritten), + scan_files(RptDir, Files, Max, Type); + _ -> exit("cannot read the index file") + end; + _ -> exit("cannot read the index file") + end. + +make_file_list(Dir, FirstFileNo) -> + case file:list_dir(Dir) of + {ok, FileNames} -> + FileNumbers = lists:zf(fun(Name) -> + case catch list_to_integer(Name) of + Int when is_integer(Int) -> + {true, Int}; + _ -> + false + end + end, + FileNames), + shift(lists:sort(FileNumbers), FirstFileNo); + _ -> exit({bad_directory, Dir}) + end. + +shift(List, First) -> + shift(List, First, []). + +shift([H | T], H, Res) -> + [H | Res] ++ lists:reverse(T); +shift([H | T], First, Res) -> + shift(T, First, [H | Res]); +shift([], _, Res) -> + Res. + +%%----------------------------------------------------------------- +%% Func: scan_files(Dir, Files, Max, Type) +%% Args: Files is a list of FileName. +%% Purpose: Scan the report files in the index variable. +%% Returns: {Number, Type, ShortDescr, Date, FileName, FilePosition} +%%----------------------------------------------------------------- +scan_files(Dir, Files, Max, Type) -> + scan_files(Dir, 1, Files, [], Max, Type). +scan_files(_Dir, _, [], Res, _Max, _Type) -> Res; +scan_files(_Dir, _, _Files, Res, Max, _Type) when Max =< 0 -> Res; +scan_files(Dir, No, [H|T], Res, Max, Type) -> + Data = get_report_data_from_file(Dir, No, H, Max, Type), + Len = length(Data), + NewMax = dec_max(Max, Len), + NewNo = No + Len, + NewData = Data ++ Res, + scan_files(Dir, NewNo, T, NewData, NewMax, Type). + +dec_max(all, _) -> all; +dec_max(X,Y) -> X-Y. + +get_report_data_from_file(Dir, No, FileNr, Max, Type) -> + Fname = integer_to_list(FileNr), + FileName = lists:concat([Dir, Fname]), + case file:open(FileName, [read]) of + {ok, Fd} when is_pid(Fd) -> read_reports(No, Fd, Fname, Max, Type); + _ -> [{No, unknown, "Can't open file " ++ Fname, "???", Fname, 0}] + end. + +%%----------------------------------------------------------------- +%% Func: read_reports(No, Fd, Fname, Max, Type) +%% Purpose: Read reports from one report file. +%% Returns: A list of {No, Type, ShortDescr, Date, FileName, FilePosition} +%% Note: We have to read all reports, and then check the max- +%% variable, because the reports are reversed on the file, and +%% we may need the last ones. +%%----------------------------------------------------------------- +read_reports(No, Fd, Fname, Max, Type) -> + io:format("rb: reading report..."), + case catch read_reports(Fd, [], Type) of + {ok, Res} -> + file:close(Fd), + io:format("done.~n"), + NewRes = + if + length(Res) > Max -> + lists:sublist(Res, 1, Max); + true -> + Res + end, + add_report_data(NewRes, No, Fname); + {error, [Problem | Res]} -> + file:close(Fd), + io:format("Error: ~p~n",[Problem]), + io:format("Salvaged ~p entries from corrupt report file ~s...~n", + [length(Res),Fname]), + NewRes = + if + length([Problem|Res]) > Max -> + lists:sublist([Problem|Res], 1, Max); + true -> + [Problem|Res] + end, + add_report_data(NewRes, No, Fname); + Else -> + io:format("err ~p~n", [Else]), + [{No, unknown, "Can't read reports from file " ++ Fname, + "???", Fname, 0}] + end. + +%%----------------------------------------------------------------- +%% Func: add_report_data(Res, No, FName) +%% Args: Res is a list of {Type, ShortDescr, Date, FilePos} +%% Purpose: Convert a list of {Type, ShortDescr, Date, FilePos} to +%% a list of {No, Type, ShortDescr, Date, FileName, FilePos} +%% Returns: A list of {No, Type, ShortDescr, Date, FileName, FilePos} +%%----------------------------------------------------------------- +add_report_data(Res, No, FName) -> + add_report_data(Res, No, FName, []). +add_report_data([{Type, ShortDescr, Date, FilePos}|T], No, FName, Res) -> + add_report_data(T, No+1, FName, + [{No, Type, ShortDescr, Date, FName, FilePos}|Res]); +add_report_data([], _No, _FName, Res) -> Res. + +read_reports(Fd, Res, Type) -> + {ok, FilePos} = file:position(Fd, cur), + case catch read_report(Fd) of + {ok, Report} -> + RealType = get_type(Report), + {ShortDescr, Date} = get_short_descr(Report), + Rep = {RealType, ShortDescr, Date, FilePos}, + if + Type == all-> + read_reports(Fd, [Rep | Res], Type); + RealType == Type -> + read_reports(Fd, [Rep | Res], Type); + is_list(Type) -> + case lists:member(RealType, Type) of + true -> + read_reports(Fd, [Rep | Res], Type); + _ -> + read_reports(Fd, Res, Type) + end; + true -> + read_reports(Fd, Res, Type) + end; + {error, Error} -> + {error, [{unknown, Error, [], FilePos} | Res]}; + eof -> + {ok, Res}; + {'EXIT', Reason} -> + [{unknown, Reason, [], FilePos} | Res] + end. + +read_report(Fd) -> + case io:get_chars(Fd,'',2) of + [Hi,Lo] -> + Size = get_int16(Hi,Lo), + case io:get_chars(Fd,'',Size) of + eof -> + {error,"Premature end of file"}; + List -> + Bin = list_to_binary(List), + Ref = make_ref(), + case (catch {Ref,binary_to_term(Bin)}) of + {'EXIT',_} -> + {error, "Inclomplete erlang term in log"}; + {Ref,Term} -> + {ok, Term} + end + end; + eof -> + eof + end. + +get_int16(Hi,Lo) -> + ((Hi bsl 8) band 16#ff00) bor (Lo band 16#ff). + + +%%----------------------------------------------------------------- +%% Update these functions with the reports that should be possible +%% to browse with rb. +%%----------------------------------------------------------------- +get_type({_Time, {error_report, _Pid, {_, crash_report, _}}}) -> + crash_report; +get_type({_Time, {error_report, _Pid, {_, supervisor_report, _}}}) -> + supervisor_report; +get_type({_Time, {info_report, _Pid, {_, progress, _}}}) -> + progress; +get_type({_Time, {Type, _, _}}) -> Type; +get_type(_) -> unknown. + +get_short_descr({{Date, Time}, {error_report, Pid, {_, crash_report, Rep}}}) -> + [OwnRep | _] = Rep, + Name = + case lists:keysearch(registered_name, 1, OwnRep) of + {value, {_Key, []}} -> + case lists:keysearch(initial_call, 1, OwnRep) of + {value, {_K, {M,_F,_A}}} -> M; + _ -> Pid + end; + {value, {_Key, N}} -> N; + _ -> Pid + end, + NameStr = lists:flatten(io_lib:format("~w", [Name])), + {NameStr, date_str(Date, Time)}; +get_short_descr({{Date, Time}, {error_report, Pid, {_, supervisor_report,Rep}}}) -> + Name = + case lists:keysearch(supervisor, 1, Rep) of + {value, {_Key, N}} when is_atom(N) -> N; + _ -> Pid + end, + NameStr = lists:flatten(io_lib:format("~w", [Name])), + {NameStr, date_str(Date,Time)}; +get_short_descr({{Date, Time}, {_Type, Pid, _}}) -> + NameStr = lists:flatten(io_lib:format("~w", [Pid])), + {NameStr, date_str(Date,Time)}; +get_short_descr(_) -> + {"???", "???"}. + +date_str({Y,Mo,D}=Date,{H,Mi,S}=Time) -> + case application:get_env(sasl,utc_log) of + {ok,true} -> + {{YY,MoMo,DD},{HH,MiMi,SS}} = + local_time_to_universal_time({Date,Time}), + lists:flatten(io_lib:format("~w-~2.2.0w-~2.2.0w ~2.2.0w:" + "~2.2.0w:~2.2.0w UTC", + [YY,MoMo,DD,HH,MiMi,SS])); + _ -> + lists:flatten(io_lib:format("~w-~2.2.0w-~2.2.0w ~2.2.0w:" + "~2.2.0w:~2.2.0w", + [Y,Mo,D,H,Mi,S])) + end. + +local_time_to_universal_time({Date,Time}) -> + case calendar:local_time_to_universal_time_dst({Date,Time}) of + [UCT] -> + UCT; + [UCT1,_UCT2] -> + UCT1; + [] -> % should not happen + {Date,Time} + end. + + +print_list(Data, Type) -> + Header = {"No", "Type", "Process", "Date Time"}, + Width = find_width([Header | Data], 0)+1, + DateWidth = find_date_width([Header | Data], 0) +1, + Format = lists:concat(["~4s~20s ~", Width, "s~20s~n"]), + io:format(Format, tuple_to_list(Header)), + io:format(Format, ["==", "====", "=======", "==== ===="]), + print_list(Data, Type, Width, DateWidth). +print_list([], _, _, _) -> true; +print_list([H|T], Type, Width, DateWidth) -> + print_one_report(H, Type, Width, DateWidth), + print_list(T, Type, Width, DateWidth). + +find_width([], Width) -> Width; +find_width([H|T], Width) -> + Try = length(element(3, H)), + if + Try > Width -> find_width(T, Try); + true -> find_width(T, Width) + end. +find_date_width([], Width) -> Width; +find_date_width([H|T], Width) -> + Try = length(element(4, H)), + if + Try > Width -> find_date_width(T, Try); + true -> find_date_width(T, Width) + end. + +print_one_report({No, RealType, ShortDescr, Date, _Fname, _FilePos}, + WantedType, + Width, DateWidth) -> + if + WantedType == all -> + print_short_descr(No, RealType, ShortDescr, Date, Width, + DateWidth); + WantedType == RealType -> + print_short_descr(No, RealType, ShortDescr, Date, Width, + DateWidth); + true -> ok + end. + +print_short_descr(No, Type, ShortDescr, Date, Width, DateWidth) -> + Format = lists:concat(["~4w~20w ~", Width, "s~", DateWidth,"s~n"]), + io:format(Format, [No, + Type, + io_lib:format("~s", [ShortDescr]), + Date]). + +print_report_by_num(Dir, Data, Number, Device, Abort, Log) -> + {_,Device1} = print_report(Dir, Data, Number, Device, Abort, Log), + Device1. + +print_typed_reports(_Dir, [], _Type, Device, _Abort, _Log) -> + Device; +print_typed_reports(Dir, Data, Type, Device, Abort, Log) -> + {Next,Device1} = + case element(2, hd(Data)) of + Type -> + print_report(Dir, Data, element(1, hd(Data)), Device, Abort, Log); + _ -> + {proceed,Device} + end, + if Next == abort -> + Device1; + true -> + print_typed_reports(Dir, tl(Data), Type, Device1, Abort, Log) + end. + +print_all_reports(_Dir, [], Device, _Abort, _Log) -> + Device; +print_all_reports(Dir, Data, Device, Abort, Log) -> + {Next,Device1} = print_report(Dir, Data, element(1, hd(Data)), + Device, Abort, Log), + if Next == abort -> + Device1; + true -> + print_all_reports(Dir, tl(Data), Device1, Abort, Log) + end. + +print_report(Dir, Data, Number, Device, Abort, Log) -> + case find_report(Data, Number) of + {Fname, FilePosition} -> + FileName = lists:concat([Dir, Fname]), + case file:open(FileName, [read]) of + {ok, Fd} -> + read_rep(Fd, FilePosition, Device, Abort, Log); + _ -> + io:format("rb: can't open file ~p~n", [Fname]), + {proceed,Device} + end; + no_report -> + {proceed,Device} + end. + +find_report([{No, _Type, _Descr, _Date, Fname, FilePosition}|_T], No) -> + {Fname, FilePosition}; +find_report([_H|T], No) -> + find_report(T, No); +find_report([], No) -> + io:format("There is no report with number ~p.~n", [No]), + no_report. + +print_grep_reports(_Dir, [], _RegExp, Device, _Abort, _Log) -> + Device; +print_grep_reports(Dir, Data, RegExp, Device, Abort, Log) -> + {Next,Device1} = print_grep_report(Dir, Data, element(1, hd(Data)), + Device, RegExp, Abort, Log), + if Next == abort -> + Device1; + true -> + print_grep_reports(Dir, tl(Data), RegExp, Device1, Abort, Log) + end. + +print_grep_report(Dir, Data, Number, Device, RegExp, Abort, Log) -> + {Fname, FilePosition} = find_report(Data, Number), + FileName = lists:concat([Dir, Fname]), + case file:open(FileName, [read]) of + {ok, Fd} when is_pid(Fd) -> + check_rep(Fd, FilePosition, Device, RegExp, Number, Abort, Log); + _ -> + io:format("rb: can't open file ~p~n", [Fname]), + {proceed,Device} + end. + +check_rep(Fd, FilePosition, Device, RegExp, Number, Abort, Log) -> + case read_rep_msg(Fd, FilePosition) of + {Date, Msg} -> + MsgStr = lists:flatten(io_lib:format("~p",[Msg])), + case regexp:match(MsgStr, RegExp) of + {match, _, _} -> + io:format("Found match in report number ~w~n", [Number]), + case catch rb_format_supp:print(Date, Msg, Device) of + {'EXIT', _} -> + handle_bad_form(Date, Msg, Device, Abort, Log); + _ -> + {proceed,Device} + end; + _ -> + {proceed,Device} + end; + _ -> + io:format("rb: Cannot read from file~n"), + {proceed,Device} + end. + +read_rep(Fd, FilePosition, Device, Abort, Log) -> + case read_rep_msg(Fd, FilePosition) of + {Date, Msg} -> + case catch rb_format_supp:print(Date, Msg, Device) of + {'EXIT', _} -> + handle_bad_form(Date, Msg, Device, Abort, Log); + _ -> + {proceed,Device} + end; + _ -> + io:format("rb: Cannot read from file~n"), + {proceed,Device} + end. + +handle_bad_form(Date, Msg, Device, Abort, Log) -> + io:format("rb: ERROR! A report on bad form was encountered. " ++ + "It can not be printed to the log.~n~n"), + io:format("Details:~n~p ~p~n~n", [Date,Msg]), + case {Abort,Device,open_log_file(Log)} of + {true,standard_io,standard_io} -> + io:format("rb: Logging aborted.~n"), + {abort,Device}; + {false,standard_io,standard_io} -> + io:format("rb: Logging resumed...~n~n"), + {proceed,Device}; + {_,_,standard_io} -> + io:format("rb: Can not reopen ~p. Logging aborted.~n", [Log]), + {abort,Device}; + {true,_,NewDevice} -> + io:format(NewDevice, + "~n~n************************* RB ERROR ************************~n" ++ + "A report on bad form was encountered here and the logging~n" ++ + "process was aborted. Note that there may well be remaining~n" ++ + "reports that haven't yet been logged. Please see the rb~n" ++ + "manual for more info.~n" ++ + "***********************************************************~n", []), + io:format("rb: Logging aborted.~n"), + {abort,NewDevice}; + {false,_,NewDevice} -> + io:format(NewDevice, + "~n ********* RB: UNPRINTABLE REPORT ********~n~n", []), + io:format("rb: Logging resumed...~n~n"), + {proceed,NewDevice} + end. + +read_rep_msg(Fd, FilePosition) -> + file:position(Fd, {bof, FilePosition}), + Res = + case catch read_report(Fd) of + {ok, Report} -> + {_ShortDescr, Date} = get_short_descr(Report), + {Date, Report}; + _ -> error + end, + file:close(Fd), + Res. diff --git a/lib/sasl/src/rb_format_supp.erl b/lib/sasl/src/rb_format_supp.erl new file mode 100644 index 0000000000..b1d83d14d0 --- /dev/null +++ b/lib/sasl/src/rb_format_supp.erl @@ -0,0 +1,155 @@ +%% +%% %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% +%% +-module(rb_format_supp). + +%% user interface +-export([print/3]). + +%%----------------------------------------------------------------- +%% This module prints error reports. Called from rb. +%%----------------------------------------------------------------- + +print(Date, Report, Device) -> + Line = 79, +%% Remove these comments when we can run rb in erl44!!! +% case catch sasl_report:write_report(Device, Report) of +% true -> ok; +% _ -> + {_Time, Rep} = Report, + case Rep of + {error_report, _GL, {Pid, crash_report, CrashReport}} -> + Header = format_h(Line, "CRASH REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header} | + format_c(CrashReport)]), + true; + {error_report, _GL, {Pid, supervisor_report, SupReport}} -> + Header = format_h(Line, "SUPERVISOR REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header} | + format_s(SupReport)]), + true; + {error_report, _GL, {Pid, _Type, Report1}} -> + Header = format_h(Line, "ERROR REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header}, + {data, Report1}]), + true; + {info_report, _GL, {Pid, progress, SupProgress}} -> + Header = format_h(Line, "PROGRESS REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header} | + format_p(SupProgress)]); + {info_report, _GL, {Pid, _Type, Report1}} -> + Header = format_h(Line, "INFO REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header}, + {data, Report1}]), + true; + {warning_report, _GL, {Pid, _Type, Report1}} -> + Header = format_h(Line, "WARNING REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header}, + {data, Report1}]), + true; + {error, _GL, {Pid, Format, Args}} -> + Header = format_h(Line, "ERROR REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header}]), + io:format(Device, Format, Args); + {info_msg, _GL, {Pid, Format, Args}} -> + Header = format_h(Line, "INFO REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header}]), + io:format(Device, Format, Args); + {warning_msg, _GL, {Pid, Format, Args}} -> + Header = format_h(Line, "WARNING REPORT", Pid, Date), + format_lib_supp:print_info(Device, + Line, + [{header, Header}]), + io:format(Device, Format, Args); + {Type, _GL, TypeReport} -> + io:format(Device, "~nInfo type <~w> ~s~n", + [Type, Date]), + io:format(Device, "~p", [TypeReport]); + _ -> + io:format("~nPrinting info of unknown type... ~s~n", + [Date]), + io:format(Device, "~p", [Report]) +% end + end. + +format_h(Line, Header, Pid, Date) -> + NHeader = lists:flatten(io_lib:format("~s ~w", [Header, Pid])), + DateLen = length(Date), + HeaderLen = Line - DateLen, + Format = lists:concat(["~-", HeaderLen, "s~", DateLen, "s"]), + io_lib:format(Format, [NHeader, Date]). + + +%%----------------------------------------------------------------- +%% Crash report +%%----------------------------------------------------------------- +format_c([OwnReport, LinkReport]) -> + [{items, {"Crashing process", OwnReport}}, + format_neighbours(LinkReport)]. + +format_neighbours([Data| Rest]) -> + [{newline, 1}, + {items, {"Neighbour process", Data}} | + format_neighbours(Rest)]; +format_neighbours([]) -> []. + +%%----------------------------------------------------------------- +%% Supervisor report +%%----------------------------------------------------------------- +format_s(Data) -> + SuperName = get_opt(supervisor, Data), + ErrorContext = get_opt(errorContext, Data), + Reason = get_opt(reason, Data), + ChildInfo = get_opt(offender, Data), + [{data, [{"Reporting supervisor", SuperName}]}, + {newline, 1}, + {items, {"Child process", + [{errorContext, ErrorContext}, + {reason, Reason} | + lists:map(fun(CI) -> transform_mfa(CI) end, ChildInfo)]}}]. + +transform_mfa({mfa, Value}) -> {start_function, Value}; +transform_mfa(X) -> X. + +%%----------------------------------------------------------------- +%% Progress report +%%----------------------------------------------------------------- +format_p(Data) -> + [{data, Data}]. + +get_opt(Key, List) -> + case lists:keysearch(Key, 1, List) of + {value, {_Key, Val}} -> Val; + _ -> undefined + end. diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl new file mode 100644 index 0000000000..42c3d9dd4b --- /dev/null +++ b/lib/sasl/src/release_handler.erl @@ -0,0 +1,1906 @@ +%% +%% %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% +%% +-module(release_handler). +-behaviour(gen_server). + +-include_lib("kernel/include/file.hrl"). + +%% External exports +-export([start_link/0, + create_RELEASES/1, create_RELEASES/2, create_RELEASES/4, + unpack_release/1, + check_install_release/1, install_release/1, install_release/2, + remove_release/1, + which_releases/0, make_permanent/1, reboot_old_release/1, + set_unpacked/2, set_removed/1, install_file/2]). +-export([upgrade_app/2, downgrade_app/2, downgrade_app/3, + upgrade_script/2, downgrade_script/3, + eval_appup_script/4]). + +%% Internal exports +-export([init/1, handle_call/3, handle_info/2, terminate/2, + handle_cast/2, code_change/3]). + +%% Internal exports, a client release_handler may call this functions. +-export([do_write_release/3, do_copy_file/2, do_copy_files/2, + do_copy_files/1, do_rename_files/1, do_remove_files/1, + do_write_file/2, do_ensure_RELEASES/1]). + +-record(state, {unpurged = [], + root, + rel_dir, + releases, + timer, + start_prg, + masters = false, + client_dir = false, + static_emulator = false, + pre_sync_nodes = []}). + +%%----------------------------------------------------------------- +%% status action next_status +%% ============================================= +%% - unpack unpacked +%% unpacked install current +%% remove - +%% current make_permanent permanent +%% install other old +%% remove - +%% permanent make other permanent old +%% install permanent +%% old reboot permanen +%% install current +%% remove - +%%----------------------------------------------------------------- +%% libs = [{Lib, Vsn, Dir}] +-record(release, {name, vsn, erts_vsn, libs = [], status}). + +-define(timeout, 10000). + +%%----------------------------------------------------------------- +%% Assumes the following file structure: +%% root --- lib --- Appl-Vsn1 --- <src> +%% | | |- ebin +%% | | |_ priv +%% | |_ Appl-Vsn2 +%% | +%% |- bin --- start (default; {sasl, start_prg} overrides +%% | |- run_erl +%% | |- start_erl (reads start_erl.data) +%% | |_ <to_erl> +%% | +%% |- erts-EVsn1 --- bin --- <jam44> +%% | |- <epmd> +%% | |_ erl +%% |- erts-EVsn2 +%% | +%% |- clients --- ClientName1 --- bin -- start +%% <clients use same lib and erts as master> +%% | | |_ releases --- start_erl.data +%% | | |_ Vsn1 -- start.boot +%% | |_ ClientName2 +%% | +%% |- clients --- Type1 --- lib +%% <clients use own lib and erts> +%% | | |- erts-EVsn +%% | | |- bin -- start +%% | | |_ ClientName1 -- releases -- start_erl.data +%% | | |_ start.boot (static) +%% | | |_ Vsn1 +%% | |_ Type2 +%% | +%% |- releases --- RELEASES +%% | |_ <Vsn1.tar.Z> +%% | | +%% | |- start_erl.data (generated by rh) +%% | | +%% | |_ Vsn1 --- start.boot +%% | | |- <sys.config> +%% | | |_ relup +%% | |_ Vsn2 +%% | +%% |- log --- erlang.log.N (1 .. 5) +%% +%% where <Name> means 'for example Name', and root is +%% init:get_argument(root) +%% +%% It is configurable where the start file is located, and what it +%% is called. +%% The paramater is {sasl, start_prg} = File +%% It is also configurable where the releases directory is located. +%% Default is $ROOT/releases. $RELDIR overrids, and +%% {sasl, releases_dir} overrides both. +%%----------------------------------------------------------------- +start_link() -> + gen_server:start_link({local, release_handler}, ?MODULE, [], []). + +%%----------------------------------------------------------------- +%% Args: ReleaseName is the name of the package file +%% (without .tar.Z (.tar on non unix systems)) +%% Purpose: Copies all files in the release package to their +%% directories. Checks that all required libs and erts +%% files are present. +%% Returns: {ok, Vsn} | {error, Reason} +%% Reason = {existing_release, Vsn} | +%% {no_such_file, File} | +%% {bad_rel_file, RelFile} | +%% {file_missing, FileName} | (in the tar package) +%% exit_reason() +%%----------------------------------------------------------------- +unpack_release(ReleaseName) -> + gen_server:call(release_handler, {unpack_release, ReleaseName}, infinity). + +%%----------------------------------------------------------------- +%% Purpose: Checks the relup script for the specified version. +%% The release must be unpacked. +%% Returns: {ok, FromVsn, Descr} | {error, Reason} +%% Reason = {already_installed, Vsn} | +%% {bad_relup_file, RelFile} | +%% {no_such_release, Vsn} | +%% {no_such_from_vsn, Vsn} | +%% exit_reason() +%%----------------------------------------------------------------- +check_install_release(Vsn) -> + gen_server:call(release_handler, {check_install_release, Vsn}, infinity). + + +%%----------------------------------------------------------------- +%% Purpose: Executes the relup script for the specified version. +%% The release must be unpacked. +%% Returns: {ok, FromVsn, Descr} | {error, Reason} +%% Reason = {already_installed, Vsn} | +%% {bad_relup_file, RelFile} | +%% {no_such_release, Vsn} | +%% {no_such_from_vsn, Vsn} | +%% {illegal_option, Opt}} | +%% exit_reason() +%%----------------------------------------------------------------- +install_release(Vsn) -> + gen_server:call(release_handler, + {install_release, Vsn, restart, []}, + infinity). + +install_release(Vsn, Opt) -> + case check_install_options(Opt, restart, []) of + {ok, ErrorAction, InstallOpt} -> + gen_server:call(release_handler, + {install_release, Vsn, ErrorAction, InstallOpt}, + infinity); + Error -> + Error + end. + +check_install_options([Opt | Opts], ErrAct, InstOpts) -> + case install_option(Opt) of + {error_action, EAct} -> + check_install_options(Opts, EAct, InstOpts); + true -> + check_install_options(Opts, ErrAct, [Opt | InstOpts]); + false -> + {error, {illegal_option, Opt}} + end; +check_install_options([], ErrAct, InstOpts) -> + {ok, ErrAct, InstOpts}. + +install_option(Opt = {error_action, reboot}) -> Opt; +install_option(Opt = {error_action, restart}) -> Opt; +install_option({code_change_timeout, TimeOut}) -> + check_timeout(TimeOut); +install_option({suspend_timeout, TimeOut}) -> + check_timeout(TimeOut); +install_option({update_paths, Bool}) when Bool==true; Bool==false -> + true; +install_option(_Opt) -> false. + +check_timeout(infinity) -> true; +check_timeout(Int) when is_integer(Int), Int > 0 -> true; +check_timeout(_Else) -> false. + +%%----------------------------------------------------------------- +%% Purpose: Makes the specified release version be the one that is +%% used when the system starts (or restarts). +%% The release must be installed (not unpacked). +%% Returns: ok | {error, Reason} +%% Reason = {bad_status, Status} | +%% {no_such_release, Vsn} | +%% exit_reason() +%%----------------------------------------------------------------- +make_permanent(Vsn) -> + gen_server:call(release_handler, {make_permanent, Vsn}, infinity). + +%%----------------------------------------------------------------- +%% Purpose: Reboots the system from an old release. +%%----------------------------------------------------------------- +reboot_old_release(Vsn) -> + gen_server:call(release_handler, {reboot_old_release, Vsn}, infinity). + +%%----------------------------------------------------------------- +%% Purpose: Deletes all files and directories used by the release +%% version, that are not used by any other release. +%% The release must not be permanent. +%% Returns: ok | {error, Reason} +%% Reason = {permanent, Vsn} | +%%----------------------------------------------------------------- +remove_release(Vsn) -> + gen_server:call(release_handler, {remove_release, Vsn}, infinity). + +%%----------------------------------------------------------------- +%% Args: RelFile = string() +%% Libs = [{Lib, LibVsn, Dir}] +%% Lib = LibVsn = Dir = string() +%% Purpose: Tells the release handler that a release has been +%% unpacked, without using the function unpack_release/1. +%% RelFile is an absolute file name including the extension +%% .rel. +%% The release dir will be created. The necessary files can +%% be installed by calling install_file/2. +%% The release_handler remebers where all libs are located. +%% If remove_release is called later, +%% those libs are removed as well (if no other releases uses +%% them). +%% Returns: ok | {error, Reason} +%%----------------------------------------------------------------- +set_unpacked(RelFile, LibDirs) -> + gen_server:call(release_handler, {set_unpacked, RelFile, LibDirs}). + +%%----------------------------------------------------------------- +%% Args: Vsn = string() +%% Purpose: Makes it possible to handle removal of releases +%% outside the release_handler. +%% This function won't delete any files at all. +%% Returns: ok | {error, Reason} +%%----------------------------------------------------------------- +set_removed(Vsn) -> + gen_server:call(release_handler, {set_removed, Vsn}). + +%%----------------------------------------------------------------- +%% Purpose: Makes it possible to install the start.boot, +%% sys.config and relup files if they are not part of a +%% standard release package. May be used to +%% install files that are generated, before install_release +%% is called. +%% Returns: ok | {error, {no_such_release, Vsn}} +%%----------------------------------------------------------------- +install_file(Vsn, File) when is_list(File) -> + gen_server:call(release_handler, {install_file, File, Vsn}). + +%%----------------------------------------------------------------- +%% Returns: [{Name, Vsn, [LibName], Status}] +%% Status = unpacked | current | permanent | old +%%----------------------------------------------------------------- +which_releases() -> + gen_server:call(release_handler, which_releases). + +%%----------------------------------------------------------------- +%% check_script(Script, LibDirs) -> ok | {error, Reason} +%%----------------------------------------------------------------- +check_script(Script, LibDirs) -> + release_handler_1:check_script(Script, LibDirs). + +%%----------------------------------------------------------------- +%% eval_script(Script, Apps, LibDirs, Opts) -> {ok, UnPurged} | +%% restart_new_emulator | +%% {error, Error} +%% {'EXIT', Reason} +%% If sync_nodes is present, the calling process must have called +%% net_kernel:monitor_nodes(true) before calling this function. +%% No! No other process than the release_handler can ever call this +%% function, if sync_nodes is used. +%%----------------------------------------------------------------- +eval_script(Script, Apps, LibDirs, Opts) -> + catch release_handler_1:eval_script(Script, Apps, LibDirs, Opts). + +%%----------------------------------------------------------------- +%% Func: create_RELEASES(Root, RelFile, LibDirs) -> ok | {error, Reason} +%% Types: Root = RelFile = string() +%% Purpose: Creates an initial RELEASES file. +%%----------------------------------------------------------------- +create_RELEASES([Root, RelFile | LibDirs]) -> + create_RELEASES(Root, filename:join(Root, "releases"), RelFile, LibDirs). + +create_RELEASES(Root, RelFile) -> + create_RELEASES(Root, filename:join(Root, "releases"), RelFile, []). + +create_RELEASES(Root, RelDir, RelFile, LibDirs) -> + case catch check_rel(Root, RelFile, LibDirs, false) of + {error, Reason } -> + {error, Reason}; + Rel -> + Rel2 = Rel#release{status = permanent}, + catch write_releases(RelDir, [Rel2], false) + end. + +%%----------------------------------------------------------------- +%% Func: upgrade_app(App, Dir) -> {ok, Unpurged} +%% | restart_new_emulator +%% | {error, Error} +%% Types: +%% App = atom() +%% Dir = string() assumed to be application directory, the code +%% located under Dir/ebin +%% Purpose: Upgrade to the version in Dir according to an appup file +%%----------------------------------------------------------------- +upgrade_app(App, NewDir) -> + try upgrade_script(App, NewDir) of + {ok, NewVsn, Script} -> + eval_appup_script(App, NewVsn, NewDir, Script) + catch + throw:Reason -> + {error, Reason} + end. + +%%----------------------------------------------------------------- +%% Func: downgrade_app(App, Dir) +%% downgrade_app(App, Vsn, Dir) -> {ok, Unpurged} +%% | restart_new_emulator +%% | {error, Error} +%% Types: +%% App = atom() +%% Vsn = string(), may be omitted if Dir == App-Vsn +%% Dir = string() assumed to be application directory, the code +%% located under Dir/ebin +%% Purpose: Downgrade from the version in Dir according to an appup file +%% located in the ebin dir of the _current_ version +%%----------------------------------------------------------------- +downgrade_app(App, OldDir) -> + case string:tokens(filename:basename(OldDir), "-") of + [_AppS, OldVsn] -> + downgrade_app(App, OldVsn, OldDir); + _ -> + {error, {unknown_version, App}} + end. +downgrade_app(App, OldVsn, OldDir) -> + try downgrade_script(App, OldVsn, OldDir) of + {ok, Script} -> + eval_appup_script(App, OldVsn, OldDir, Script) + catch + throw:Reason -> + {error, Reason} + end. + +upgrade_script(App, NewDir) -> + OldVsn = ensure_running(App), + OldDir = code:lib_dir(App), + {NewVsn, Script} = find_script(App, NewDir, OldVsn, up), + OldAppl = read_app(App, OldVsn, OldDir), + NewAppl = read_app(App, NewVsn, NewDir), + case systools_rc:translate_scripts(up, + [Script],[NewAppl],[OldAppl]) of + {ok, LowLevelScript} -> + {ok, NewVsn, LowLevelScript}; + {error, _SystoolsRC, Reason} -> + throw(Reason) + end. + +downgrade_script(App, OldVsn, OldDir) -> + NewVsn = ensure_running(App), + NewDir = code:lib_dir(App), + {NewVsn, Script} = find_script(App, NewDir, OldVsn, down), + OldAppl = read_app(App, OldVsn, OldDir), + NewAppl = read_app(App, NewVsn, NewDir), + case systools_rc:translate_scripts(dn, + [Script],[OldAppl],[NewAppl]) of + {ok, LowLevelScript} -> + {ok, LowLevelScript}; + {error, _SystoolsRC, Reason} -> + throw(Reason) + end. + +eval_appup_script(App, ToVsn, ToDir, Script) -> + EnvBefore = application_controller:prep_config_change(), + AppSpecL = read_appspec(App, ToDir), + Res = release_handler_1:eval_script(Script, + [], % [AppSpec] + [{App, ToVsn, ToDir}], + []), % [Opt] + case Res of + {ok, _Unpurged} -> + application_controller:change_application_data(AppSpecL,[]), + application_controller:config_change(EnvBefore); + _Res -> + ignore + end, + Res. + +ensure_running(App) -> + case lists:keysearch(App, 1, application:which_applications()) of + {value, {_App, _Descr, Vsn}} -> + Vsn; + false -> + throw({app_not_running, App}) + end. + +find_script(App, Dir, OldVsn, UpOrDown) -> + Appup = filename:join([Dir, "ebin", atom_to_list(App)++".appup"]), + case file:consult(Appup) of + {ok, [{NewVsn, UpFromScripts, DownToScripts}]} -> + Scripts = case UpOrDown of + up -> UpFromScripts; + down -> DownToScripts + end, + case lists:keysearch(OldVsn, 1, Scripts) of + {value, {_OldVsn, Script}} -> + {NewVsn, Script}; + false -> + throw({version_not_in_appup, OldVsn}) + end; + {error, enoent} -> + throw(no_appup_found); + {error, Reason} -> + throw(Reason) + end. + +read_app(App, Vsn, Dir) -> + AppS = atom_to_list(App), + Path = [filename:join(Dir, "ebin")], + case systools_make:read_application(AppS, Vsn, Path, []) of + {ok, Appl} -> + Appl; + {error, {not_found, _AppFile}} -> + throw({no_app_found, Vsn, Dir}); + {error, Reason} -> + throw(Reason) + end. + +read_appspec(App, Dir) -> + AppS = atom_to_list(App), + Path = [filename:join(Dir, "ebin")], + case file:path_consult(Path, AppS++".app") of + {ok, AppSpecL, _File} -> + AppSpecL; + {error, Reason} -> + throw(Reason) + end. + + + + + + + + +%%----------------------------------------------------------------- +%% Call-back functions from gen_server +%%----------------------------------------------------------------- +init([]) -> + {ok, [[Root]]} = init:get_argument(root), + {CliDir, Masters} = is_client(), + ReleaseDir = + case application:get_env(sasl, releases_dir) of + undefined -> + case os:getenv("RELDIR") of + false -> + if + CliDir == false -> + filename:join([Root, "releases"]); + true -> + filename:join([CliDir, "releases"]) + end; + RELDIR -> + RELDIR + end; + {ok, Dir} -> + Dir + end, + Releases = + case consult(filename:join(ReleaseDir, "RELEASES"), Masters) of + {ok, [Term]} -> + transform_release(ReleaseDir, Term, Masters); + _ -> + {Name, Vsn} = init:script_id(), + [#release{name = Name, vsn = Vsn, status = permanent}] + end, + StartPrg = + case application:get_env(start_prg) of + {ok, Found2} when is_list(Found2) -> + {do_check, Found2}; + _ -> + {no_check, filename:join([Root, "bin", "start"])} + end, + Static = + case application:get_env(static_emulator) of + {ok, SFlag} when is_atom(SFlag) -> SFlag; + _ -> false + end, + {ok, #state{root = Root, rel_dir = ReleaseDir, releases = Releases, + start_prg = StartPrg, masters = Masters, + client_dir = CliDir, static_emulator = Static}}. + +handle_call({unpack_release, ReleaseName}, _From, S) + when S#state.masters == false -> + RelDir = S#state.rel_dir, + case catch do_unpack_release(S#state.root, RelDir, + ReleaseName, S#state.releases) of + {ok, NewReleases, Vsn} -> + clean_release(RelDir, ReleaseName), + {reply, {ok, Vsn}, S#state{releases = NewReleases}}; + {error, Reason} -> + {reply, {error, Reason}, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, S} + end; +handle_call({unpack_release, _ReleaseName}, _From, S) -> + {reply, {error, client_node}, S}; + +handle_call({check_install_release, Vsn}, _From, S) -> + case catch do_check_install_release(S#state.rel_dir, + Vsn, + S#state.releases, + S#state.masters) of + {ok, CurrentVsn, Descr} -> + {reply, {ok, CurrentVsn, Descr}, S}; + {error, Reason} -> + {reply, {error, Reason}, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, S} + end; + +handle_call({install_release, Vsn, ErrorAction, Opts}, From, S) -> + NS = resend_sync_nodes(S), + case catch do_install_release(S, Vsn, Opts) of + {ok, NewReleases, CurrentVsn, Descr} -> + {reply, {ok, CurrentVsn, Descr}, NS#state{releases=NewReleases}}; + {ok, NewReleases, Unpurged, CurrentVsn, Descr} -> + Timer = + case S#state.timer of + undefined -> + {ok, Ref} = timer:send_interval(?timeout, timeout), + Ref; + Ref -> Ref + end, + NewS = NS#state{releases = NewReleases, unpurged = Unpurged, + timer = Timer}, + {reply, {ok, CurrentVsn, Descr}, NewS}; + {error, Reason} -> + {reply, {error, Reason}, NS}; + {restart_new_emulator, CurrentVsn, Descr} -> + gen_server:reply(From, {ok, CurrentVsn, Descr}), + init:reboot(), + {noreply, NS}; + {'EXIT', Reason} -> + io:format("release_handler:" + "install_release(Vsn=~p Opts=~p) failed, " + "Reason=~p~n", [Vsn, Opts, Reason]), + gen_server:reply(From, {error, Reason}), + case ErrorAction of + restart -> + init:restart(); + reboot -> + init:reboot() + end, + {noreply, NS} + end; + +handle_call({make_permanent, Vsn}, _From, S) -> + case catch do_make_permanent(S, Vsn) of + {ok, Releases, Unpurged} -> + {reply, ok, S#state{releases = Releases, unpurged = Unpurged}}; + {error, Reason} -> + {reply, {error, Reason}, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, S} + end; + +handle_call({reboot_old_release, Vsn}, From, S) -> + case catch do_reboot_old_release(S, Vsn) of + ok -> + gen_server:reply(From, ok), + init:reboot(), + {noreply, S}; + {error, Reason} -> + {reply, {error, Reason}, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, S} + end; + +handle_call({remove_release, Vsn}, _From, S) + when S#state.masters == false -> + case catch do_remove_release(S#state.root, S#state.rel_dir, + Vsn, S#state.releases) of + {ok, NewReleases} -> + {reply, ok, S#state{releases = NewReleases}}; + {error, Reason} -> + {reply, {error, Reason}, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, S} + end; +handle_call({remove_release, _Vsn}, _From, S) -> + {reply, {error, client_node}, S}; + +handle_call({set_unpacked, RelFile, LibDirs}, _From, S) -> + Root = S#state.root, + case catch do_set_unpacked(Root, S#state.rel_dir, RelFile, + LibDirs, S#state.releases, + S#state.masters) of + {ok, NewReleases, Vsn} -> + {reply, {ok, Vsn}, S#state{releases = NewReleases}}; + {error, Reason} -> + {reply, {error, Reason}, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, S} + end; + +handle_call({set_removed, Vsn}, _From, S) -> + case catch do_set_removed(S#state.rel_dir, Vsn, + S#state.releases, + S#state.masters) of + {ok, NewReleases} -> + {reply, ok, S#state{releases = NewReleases}}; + {error, Reason} -> + {reply, {error, Reason}, S}; + {'EXIT', Reason} -> + {reply, {error, Reason}, S} + end; + +handle_call({install_file, File, Vsn}, _From, S) -> + Reply = + case lists:keysearch(Vsn, #release.vsn, S#state.releases) of + {value, _} -> + Dir = filename:join([S#state.rel_dir, Vsn]), + catch copy_file(File, Dir, S#state.masters); + _ -> + {error, {no_such_release, Vsn}} + end, + {reply, Reply, S}; + +handle_call(which_releases, _From, S) -> + Reply = lists:map(fun(#release{name = Name, vsn = Vsn, libs = Libs, + status = Status}) -> + {Name, Vsn, mk_lib_name(Libs), Status} + end, S#state.releases), + {reply, Reply, S}. + +mk_lib_name([{LibName, Vsn, _Dir} | T]) -> + [lists:concat([LibName, "-", Vsn]) | mk_lib_name(T)]; +mk_lib_name([]) -> []. + +handle_info(timeout, S) -> + case soft_purge(S#state.unpurged) of + [] -> + timer:cancel(S#state.timer), + {noreply, S#state{unpurged = [], timer = undefined}}; + Unpurged -> + {noreply, S#state{unpurged = Unpurged}} + end; + +handle_info({sync_nodes, Id, Node}, S) -> + PSN = S#state.pre_sync_nodes, + {noreply, S#state{pre_sync_nodes = [{sync_nodes, Id, Node} | PSN]}}; + +handle_info(Msg, State) -> + error_logger:info_msg("release_handler: got unknown message: ~p~n", [Msg]), + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +handle_cast(_Msg, State) -> + {noreply, State}. +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%----------------------------------------------------------------- +%%% Internal functions +%%%----------------------------------------------------------------- +is_client() -> + case application:get_env(masters) of + {ok, Masters} -> + Alive = is_alive(), + case atom_list(Masters) of + true when Alive == true -> + case application:get_env(client_directory) of + {ok, ClientDir} -> + case int_list(ClientDir) of + true -> + {ClientDir, Masters}; + _ -> + exit({bad_parameter, client_directory, + ClientDir}) + end; + _ -> + {false, false} + end; + _ -> + exit({bad_parameter, masters, Masters}) + end; + _ -> + {false, false} + end. + +atom_list([A|T]) when is_atom(A) -> atom_list(T); +atom_list([]) -> true; +atom_list(_) -> false. + +int_list([I|T]) when is_integer(I) -> int_list(T); +int_list([]) -> true; +int_list(_) -> false. + +resend_sync_nodes(S) -> + lists:foreach(fun(Msg) -> self() ! Msg end, S#state.pre_sync_nodes), + S#state{pre_sync_nodes = []}. + +soft_purge(Unpurged) -> + lists:filter(fun({Mod, _PostPurgeMethod}) -> + case code:soft_purge(Mod) of + true -> false; % No proc left, don't remember Mod + false -> true % Still proc left, remember it + end + end, + Unpurged). + +brutal_purge(Unpurged) -> + lists:filter(fun({Mod, brutal_purge}) -> code:purge(Mod), false; + (_) -> true + end, + Unpurged). + +%%----------------------------------------------------------------- +%% The release package is a RelName.tar.Z (.tar on non unix) file +%% with the following contents: +%% - RelName.rel == {release, {Name, Vsn}, {erts, EVsn}, [lib()]} +%% - <files> according to [lib()] +%% - lib() = {LibName, LibVsn} +%% In the Dir, there exists a file called RELEASES, which contains +%% a [{Vsn, {erts, EVsn}, {libs, [{LibName, LibVsn, LibDir}]}}]. +%% Note that RelDir is an absolute directory name ! +%% Note that this function is not executed by a client +%% release_handler. +%%----------------------------------------------------------------- +do_unpack_release(Root, RelDir, ReleaseName, Releases) -> + Tar = filename:join(RelDir, ReleaseName ++ ".tar.gz"), + do_check_file(Tar, regular), + Rel = ReleaseName ++ ".rel", + extract_rel_file(filename:join("releases", Rel), Tar, Root), + RelFile = filename:join(RelDir, Rel), + Release = check_rel(Root, RelFile, false), + #release{vsn = Vsn} = Release, + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, _} -> throw({error, {existing_release, Vsn}}); + _ -> ok + end, + extract_tar(Root, Tar), + NewReleases = [Release#release{status = unpacked} | Releases], + write_releases(RelDir, NewReleases, false), + Dir = filename:join([RelDir, Vsn]), + copy_file(RelFile, Dir, false), + {ok, NewReleases, Vsn}. + +%% Note that this function is not executed by a client +%% release_handler. +clean_release(RelDir, ReleaseName) -> + Tar = filename:join(RelDir, ReleaseName ++ ".tar.gz"), + Rel = filename:join(RelDir, ReleaseName ++ ".rel"), + file:delete(Tar), + file:delete(Rel). + +check_rel(Root, RelFile, Masters) -> + check_rel(Root, RelFile, [], Masters). +check_rel(Root, RelFile, LibDirs, Masters) -> + case consult(RelFile, Masters) of + {ok, [RelData]} -> + check_rel_data(RelData, Root, LibDirs); + {ok, _} -> + throw({error, {bad_rel_file, RelFile}}); + {error, Reason} when is_tuple(Reason) -> + throw({error, {bad_rel_file, RelFile}}); + {error, FileError} -> % FileError is posix atom | no_master + throw({error, {FileError, RelFile}}) + end. + +check_rel_data({release, {Name, Vsn}, {erts, EVsn}, Libs}, Root, LibDirs) -> + Libs2 = + lists:map(fun(LibSpec) -> + Lib = element(1, LibSpec), + LibVsn = element(2, LibSpec), + LibName = lists:concat([Lib, "-", LibVsn]), + LibDir = + case lists:keysearch(Lib, 1, LibDirs) of + {value, {_Lib, _Vsn, Dir}} -> + Path = filename:join(Dir,LibName), + check_path(Path), + Path; + _ -> + filename:join([Root, "lib", LibName]) + end, + {Lib, LibVsn, LibDir} + end, + Libs), + #release{name = Name, vsn = Vsn, erts_vsn = EVsn, + libs = Libs2, status = unpacking}; +check_rel_data(RelData, _Root, _LibDirs) -> + throw({error, {bad_rel_data, RelData}}). + +check_path(Path) -> + case file:read_file_info(Path) of + {ok, Info} when Info#file_info.type==directory -> + ok; + {ok, _Info} -> + throw({error, {not_a_directory, Path}}); + {error, _Reason} -> + throw({error, {no_such_directory, Path}}) + end. + +do_check_install_release(RelDir, Vsn, Releases, Masters) -> + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, #release{status = current}} -> + {error, {already_installed, Vsn}}; + {value, Release} -> + LatestRelease = get_latest_release(Releases), + VsnDir = filename:join([RelDir, Vsn]), + check_file(filename:join(VsnDir, "start.boot"), regular, Masters), + IsRelup = check_opt_file(filename:join(VsnDir, "relup"), regular, Masters), + check_opt_file(filename:join(VsnDir, "sys.config"), regular, Masters), + + %% Check that all required libs are present + Libs = Release#release.libs, + lists:foreach(fun({_Lib, _LibVsn, LibDir}) -> + check_file(LibDir, directory, Masters), + Ebin = filename:join(LibDir, "ebin"), + check_file(Ebin, directory, Masters) + end, + Libs), + + if + IsRelup -> + case get_rh_script(LatestRelease, Release, RelDir, Masters) of + {ok, {CurrentVsn, Descr, Script}} -> + case catch check_script(Script, Libs) of + ok -> + {ok, CurrentVsn, Descr}; + Else -> + Else + end; + Error -> + Error + end; + true -> + {ok, Vsn, ""} + end; + _ -> + {error, {no_such_release, Vsn}} + end. + +do_install_release(#state{start_prg = StartPrg, + rel_dir = RelDir, releases = Releases, + masters = Masters, + static_emulator = Static}, + Vsn, Opts) -> + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, #release{status = current}} -> + {error, {already_installed, Vsn}}; + {value, Release} -> + LatestRelease = get_latest_release(Releases), + case get_rh_script(LatestRelease, Release, RelDir, Masters) of + {ok, {CurrentVsn, Descr, Script}} -> + mon_nodes(true), + EnvBefore = application_controller:prep_config_change(), + Apps = change_appl_data(RelDir, Release, Masters), + LibDirs = Release#release.libs, + case eval_script(Script, Apps, LibDirs, Opts) of + {ok, []} -> + application_controller:config_change(EnvBefore), + mon_nodes(false), + NewReleases = set_status(Vsn, current, Releases), + {ok, NewReleases, CurrentVsn, Descr}; + {ok, Unpurged} -> + application_controller:config_change(EnvBefore), + mon_nodes(false), + NewReleases = set_status(Vsn, current, Releases), + {ok, NewReleases, Unpurged, CurrentVsn, Descr}; + restart_new_emulator when Static == true -> + throw(static_emulator); + restart_new_emulator -> + mon_nodes(false), + {value, PermanentRelease} = + lists:keysearch(permanent, #release.status, + Releases), + NReleases = set_status(Vsn, current, Releases), + NReleases2 = set_status(Vsn,tmp_current,NReleases), + write_releases(RelDir, NReleases2, Masters), + prepare_restart_new_emulator(StartPrg, RelDir, + Release, + PermanentRelease, + Masters), + {restart_new_emulator, CurrentVsn, Descr}; + Else -> + application_controller:config_change(EnvBefore), + mon_nodes(false), + Else + end; + Error -> + Error + end; + _ -> + {error, {no_such_release, Vsn}} + end. + +%%% This code chunk updates the services in one of two ways, +%%% Either the emulator is restarted, in which case the old service +%%% is to be removed and the new enabled, or the emulator is NOT restarted +%%% in which case we try to rename the old service to the new name and try +%%% to update heart's view of what service we are really running. +do_make_services_permanent(PermanentVsn,Vsn, PermanentEVsn, EVsn) -> + PermName = hd(string:tokens(atom_to_list(node()),"@")) + ++ "_" ++ PermanentVsn, + Name = hd(string:tokens(atom_to_list(node()),"@")) + ++ "_" ++ Vsn, + case erlsrv:get_service(EVsn,Name) of + {error, _Error} -> + %% We probably do not need to replace services, just + %% rename. + case os:getenv("ERLSRV_SERVICE_NAME") == PermName of + true -> + case erlsrv:rename_service(EVsn,PermName,Name) of + {ok,_} -> + case erlsrv:get_service(EVsn,Name) of + {error,Error2} -> + throw({error,Error2}); + _Data2 -> + %% The interfaces for doing this are + %% NOT published and may be subject to + %% change. Do NOT do this anywhere else! + + os:putenv("ERLSRV_SERVICE_NAME", Name), + + %% Restart heart port program, this + %% function is only to be used here. + heart:cycle(), + ok + end; + Error3 -> + throw({error,{service_rename_failed, Error3}}) + end; + false -> + throw({error,service_name_missmatch}) + end; + Data -> + UpdData = erlsrv:new_service(Name, Data, []), + case erlsrv:store_service(EVsn,UpdData) of + ok -> + erlsrv:disable_service(PermanentEVsn, PermName), + erlsrv:enable_service(EVsn, Name), + erlsrv:remove_service(PermName), + %%% Read comments about these above... + os:putenv("ERLSRV_SERVICE_NAME", Name), + heart:cycle(), + ok; + Error4 -> + throw(Error4) + end + end. + +do_make_permanent(#state{releases = Releases, + rel_dir = RelDir, unpurged = Unpurged, + masters = Masters, + static_emulator = Static}, + Vsn) -> + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, #release{erts_vsn = EVsn, status = Status}} + when Status /= unpacked, Status /= old, Status /= permanent -> + Dir = filename:join([RelDir, Vsn]), + Sys = + case catch check_file(filename:join(Dir, "sys.config"), + regular, Masters) of + ok -> filename:join(Dir, "sys"); + _ -> false + end, + Boot = filename:join(Dir, "start.boot"), + check_file(Boot, regular, Masters), + set_permanent_files(RelDir, EVsn, Vsn, Masters, Static), + NewReleases = set_status(Vsn, permanent, Releases), + write_releases(RelDir, NewReleases, Masters), + case os:type() of + {win32, nt} -> + {value, PermanentRelease} = + lists:keysearch(permanent, #release.status, + Releases), + PermanentVsn = PermanentRelease#release.vsn, + PermanentEVsn = PermanentRelease#release.erts_vsn, + case catch do_make_services_permanent(PermanentVsn, + Vsn, + PermanentEVsn, + EVsn) of + {error,Reason} -> + throw({error,{service_update_failed, Reason}}); + _ -> + ok + end; + _ -> + ok + end, + init:make_permanent(filename:join(Dir, "start"), Sys), + {ok, NewReleases, brutal_purge(Unpurged)}; + {value, #release{status = permanent}} -> + {ok, Releases, Unpurged}; + {value, #release{status = Status}} -> + {error, {bad_status, Status}}; + false -> + {error, {no_such_release, Vsn}} + end. + + +do_back_service(OldVersion, CurrentVersion,OldEVsn,CurrentEVsn) -> + NN = hd(string:tokens(atom_to_list(node()),"@")), + OldName = NN ++ "_" ++ OldVersion, + CurrentName = NN ++ "_" ++ CurrentVersion, + UpdData = case erlsrv:get_service(CurrentEVsn,CurrentName) of + {error, Error} -> + throw({error,Error}); + Data -> + erlsrv:new_service(OldName, Data, []) + end, + case erlsrv:store_service(OldEVsn,UpdData) of + ok -> + erlsrv:disable_service(CurrentEVsn,CurrentName), + erlsrv:enable_service(OldEVsn,OldName); + Error2 -> + throw(Error2) + end, + OldErlSrv = filename:nativename(erlsrv:erlsrv(OldEVsn)), + CurrentErlSrv = filename:nativename(erlsrv:erlsrv(CurrentEVsn)), + case heart:set_cmd(CurrentErlSrv ++ " remove " ++ CurrentName ++ + " & " ++ OldErlSrv ++ " start " ++ OldName) of + ok -> + ok; + Error3 -> + throw({error, {'heart:set_cmd() error', Error3}}) + end. + +do_reboot_old_release(#state{releases = Releases, + rel_dir = RelDir, masters = Masters, + static_emulator = Static}, + Vsn) -> + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, #release{erts_vsn = EVsn, status = old}} -> + CurrentRunning = case os:type() of + {win32,nt} -> + %% Get the current release on NT + case lists:keysearch(permanent, + #release.status, + Releases) of + false -> + lists:keysearch(current, + #release.status, + Releases); + {value,CR} -> + CR + end; + _ -> + false + end, + set_permanent_files(RelDir, EVsn, Vsn, Masters, Static), + NewReleases = set_status(Vsn, permanent, Releases), + write_releases(RelDir, NewReleases, Masters), + case os:type() of + {win32,nt} -> + %% Edit up the services and set a reasonable heart + %% command + do_back_service(Vsn,CurrentRunning#release.vsn,EVsn, + CurrentRunning#release.erts_vsn); + _ -> + ok + end, + ok; + {value, #release{status = Status}} -> + {error, {bad_status, Status}}; + false -> + {error, {no_such_release, Vsn}} + end. + +%%----------------------------------------------------------------- +%% Depending of if the release_handler is running in normal, client or +%% client with static emulator the new system version is made permanent +%% in different ways. +%%----------------------------------------------------------------- +set_permanent_files(RelDir, EVsn, Vsn, false, _) -> + write_start(filename:join([RelDir, "start_erl.data"]), + EVsn ++ " " ++ Vsn, + false); +set_permanent_files(RelDir, EVsn, Vsn, Masters, false) -> + write_start(filename:join([RelDir, "start_erl.data"]), + EVsn ++ " " ++ Vsn, + Masters); +set_permanent_files(RelDir, _EVsn, Vsn, Masters, _Static) -> + VsnDir = filename:join([RelDir, Vsn]), + set_static_files(VsnDir, RelDir, Masters). + + +do_remove_service(Vsn) -> + %%% Very unconditionally remove the service. + ServiceName = hd(string:tokens(atom_to_list(node()),"@")) + ++ "_" ++ Vsn, + erlsrv:remove_service(ServiceName). + +do_remove_release(Root, RelDir, Vsn, Releases) -> + % Decide which libs should be removed + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, #release{status = permanent}} -> + {error, {permanent, Vsn}}; + {value, #release{libs = RemoveLibs, vsn = Vsn, erts_vsn = EVsn}} -> + case os:type() of + {win32, nt} -> + do_remove_service(Vsn); + _ -> + ok + end, + + NewReleases = lists:keydelete(Vsn, #release.vsn, Releases), + RemoveThese = + lists:foldl(fun(#release{libs = Libs}, Remove) -> + diff_dir(Remove, Libs) + end, RemoveLibs, NewReleases), + lists:foreach(fun({_Lib, _LVsn, LDir}) -> + remove_file(LDir) + end, RemoveThese), + remove_file(filename:join([RelDir, Vsn])), + case lists:keysearch(EVsn, #release.erts_vsn, NewReleases) of + {value, _} -> ok; + false -> % Remove erts library, no more references to it + remove_file(filename:join(Root, "erts-" ++ EVsn)) + end, + write_releases(RelDir, NewReleases, false), + {ok, NewReleases}; + false -> + {error, {no_such_release, Vsn}} + end. + +do_set_unpacked(Root, RelDir, RelFile, LibDirs, Releases, Masters) -> + Release = check_rel(Root, RelFile, LibDirs, Masters), + #release{vsn = Vsn} = Release, + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, _} -> throw({error, {existing_release, Vsn}}); + false -> ok + end, + NewReleases = [Release#release{status = unpacked} | Releases], + VsnDir = filename:join([RelDir, Vsn]), + make_dir(VsnDir, Masters), + write_releases(RelDir, NewReleases, Masters), + {ok, NewReleases, Vsn}. + +do_set_removed(RelDir, Vsn, Releases, Masters) -> + case lists:keysearch(Vsn, #release.vsn, Releases) of + {value, #release{status = permanent}} -> + {error, {permanent, Vsn}}; + {value, _} -> + NewReleases = lists:keydelete(Vsn, #release.vsn, Releases), + write_releases(RelDir, NewReleases, Masters), + {ok, NewReleases}; + false -> + {error, {no_such_release, Vsn}} + end. + + +%%----------------------------------------------------------------- +%% A relup file consists of: +%% {Vsn, [{FromVsn, Descr, RhScript}], [{ToVsn, Descr, RhScript}]}. +%% It describes how to get to this release from previous releases, +%% and how to get from this release to previous releases. +%% We can get from a FromVsn that's a substring of CurrentVsn (e.g. +%% 1.1 is a substring of 1.1.1, but not 1.2), but when we get to +%% ToVsn, we must have an exact match. +%% +%% We do not put any semantics into the version strings, i.e. we +%% don't know if going from Vsn1 to Vsn2 represents a upgrade or +%% a downgrade. For both upgrades and downgrades, the relup file +%% is located in the directory of the latest version. Since we +%% do not which version is latest, we first suppose that ToVsn > +%% CurrentVsn, i.e. we perform an upgrade. If we don't find the +%% corresponding relup instructions, we check if it's possible to +%% downgrade from CurrentVsn to ToVsn. +%%----------------------------------------------------------------- +get_rh_script(#release{vsn = CurrentVsn}, + #release{vsn = Vsn}, + RelDir, + Masters) -> + Relup = filename:join([RelDir, Vsn, "relup"]), + case try_upgrade(Vsn, CurrentVsn, Relup, Masters) of + {ok, RhScript} -> + {ok, RhScript}; + _ -> + Relup2 = filename:join([RelDir, CurrentVsn,"relup"]), + case try_downgrade(Vsn, CurrentVsn, Relup2, Masters) of + {ok, RhScript} -> + {ok, RhScript}; + _ -> + throw({error, {no_matching_relup, Vsn, CurrentVsn}}) + end + end. + +try_upgrade(ToVsn, CurrentVsn, Relup, Masters) -> + case consult(Relup, Masters) of + {ok, [{ToVsn, ListOfRhScripts, _}]} -> + case lists:keysearch(CurrentVsn, 1, ListOfRhScripts) of + {value, RhScript} -> + {ok, RhScript}; + _ -> + error + end; + {ok, _} -> + throw({error, {bad_relup_file, Relup}}); + {error, Reason} when is_tuple(Reason) -> + throw({error, {bad_relup_file, Relup}}); + {error, enoent} -> + error; + {error, FileError} -> % FileError is posix atom | no_master + throw({error, {FileError, Relup}}) + end. + +try_downgrade(ToVsn, CurrentVsn, Relup, Masters) -> + case consult(Relup, Masters) of + {ok, [{CurrentVsn, _, ListOfRhScripts}]} -> + case lists:keysearch(ToVsn, 1, ListOfRhScripts) of + {value, RhScript} -> + {ok, RhScript}; + _ -> + error + end; + {ok, _} -> + throw({error, {bad_relup_file, Relup}}); + {error, Reason} when is_tuple(Reason) -> + throw({error, {bad_relup_file, Relup}}); + {error, FileError} -> % FileError is posix atom | no_master + throw({error, {FileError, Relup}}) + end. + + +%% Status = current | tmp_current | permanent +set_status(Vsn, Status, Releases) -> + lists:zf(fun(Release) when Release#release.vsn == Vsn, + Release#release.status == permanent -> + %% If a permanent rel is installed, it keeps its + %% permanent status (not changed to current). + %% The current becomes old though. + true; + (Release) when Release#release.vsn == Vsn -> + {true, Release#release{status = Status}}; + (Release) when Release#release.status == Status -> + {true, Release#release{status = old}}; + (_) -> + true + end, Releases). + +get_latest_release(Releases) -> + case lists:keysearch(current, #release.status, Releases) of + {value, Release} -> + Release; + false -> + {value, Release} = + lists:keysearch(permanent, #release.status, Releases), + Release + end. + +%% Returns: [{Lib, Vsn, Dir}] to be removed +diff_dir([H | T], L) -> + case memlib(H, L) of + true -> diff_dir(T, L); + false -> [H | diff_dir(T, L)] + end; +diff_dir([], _) -> []. + +memlib({Lib, Vsn, _Dir}, [{Lib, Vsn, _Dir2} | _T]) -> true; +memlib(Lib, [_H | T]) -> memlib(Lib, T); +memlib(_Lib, []) -> false. + +%% recursively remove file or directory +remove_file(File) -> + case file:read_file_info(File) of + {ok, Info} when Info#file_info.type==directory -> + case file:list_dir(File) of + {ok, Files} -> + lists:foreach(fun(File2) -> + remove_file(filename:join(File,File2)) + end, Files), + case file:del_dir(File) of + ok -> ok; + {error, Reason} -> throw({error, Reason}) + end; + {error, Reason} -> + throw({error, Reason}) + end; + {ok, _Info} -> + case file:delete(File) of + ok -> ok; + {error, Reason} -> throw({error, Reason}) + end; + {error, _Reason} -> + throw({error, {no_such_file, File}}) + + end. + +do_write_file(File, Str) -> + case file:open(File, [write]) of + {ok, Fd} -> + io:put_chars(Fd, Str), + file:close(Fd), + ok; + {error, Reason} -> + {error, {Reason, File}} + end. + +%%----------------------------------------------------------------- +%% Change current applications (specifically, update their version, +%% description and env.) +%%----------------------------------------------------------------- +change_appl_data(RelDir, #release{vsn = Vsn}, Masters) -> + Dir = filename:join([RelDir, Vsn]), + BootFile = filename:join(Dir, "start.boot"), + case read_file(BootFile, Masters) of + {ok, Bin} -> + Config = case consult(filename:join(Dir, "sys.config"), Masters) of + {ok, [Conf]} -> Conf; + _ -> [] + end, + Appls = get_appls(binary_to_term(Bin)), + case application_controller:change_application_data(Appls,Config) of + ok -> Appls; + {error, Reason} -> exit({change_appl_data, Reason}) + end; + {error, _Reason} -> + throw({error, {no_such_file, BootFile}}) + end. + +%%----------------------------------------------------------------- +%% This function is dependent on the application functions and +%% the start script syntax. +%%----------------------------------------------------------------- +get_appls({script, _, Script}) -> get_appls(Script, []). + +%% kernel is taken care of separately +get_appls([{kernelProcess, application_controller, + {application_controller, start, [App]}} |T], Res) -> + get_appls(T, [App | Res]); +%% other applications but kernel +get_appls([{apply, {application, load, [App]}} |T], Res) -> + get_appls(T, [App | Res]); +get_appls([_ | T], Res) -> + get_appls(T, Res); +get_appls([], Res) -> + Res. + + +mon_nodes(true) -> + net_kernel:monitor_nodes(true); +mon_nodes(false) -> + net_kernel:monitor_nodes(false), + flush(). + +flush() -> + receive + {nodedown, _} -> flush(); + {nodeup, _} -> flush() + after + 0 -> ok + end. + +prepare_restart_nt(#release{erts_vsn = EVsn, vsn = Vsn}, + #release{erts_vsn = PermEVsn, vsn = PermVsn}, + DataFileName) -> + CurrentServiceName = hd(string:tokens(atom_to_list(node()),"@")) + ++ "_" ++ PermVsn, + FutureServiceName = hd(string:tokens(atom_to_list(node()),"@")) + ++ "_" ++ Vsn, + CurrentService = case erlsrv:get_service(PermEVsn,CurrentServiceName) of + {error, Reason} -> + throw({error, Reason}); + CS -> + CS + end, + FutureService = erlsrv:new_service(FutureServiceName, + CurrentService, + filename:nativename(DataFileName), + %% This is rather icky... On a + %% non permanent service, the + %% ERLSRV_SERVICE_NAME is + %% actually that of an old service, + %% to make heart commands work... + CurrentServiceName), + + case erlsrv:store_service(EVsn, FutureService) of + {error, Rison} -> + throw({error,Rison}); + _ -> + erlsrv:disable_service(EVsn, FutureServiceName), + ErlSrv = filename:nativename(erlsrv:erlsrv(EVsn)), + case heart:set_cmd(ErlSrv ++ " enable " ++ FutureServiceName ++ + " & " ++ ErlSrv ++ " start " ++ + FutureServiceName ++ + " & " ++ ErlSrv ++ " disable " ++ + FutureServiceName) of + ok -> + ok; + Error -> + throw({error, {'heart:set_cmd() error', Error}}) + end + end. + + +%%----------------------------------------------------------------- +%% Set things up for restarting the new emulator. The actual +%% restart is performed by calling init:reboot() higher up. +%%----------------------------------------------------------------- +prepare_restart_new_emulator(StartPrg, RelDir, + Release, PRelease, + Masters) -> + #release{erts_vsn = EVsn, vsn = Vsn} = Release, + Data = EVsn ++ " " ++ Vsn, + DataFile = write_new_start_erl(Data, RelDir, Masters), + %% Tell heart to use DataFile instead of start_erl.data + case os:type() of + {win32,nt} -> + prepare_restart_nt(Release,PRelease,DataFile); + {unix,_} -> + StartP = check_start_prg(StartPrg, Masters), + case heart:set_cmd(StartP ++ " " ++ DataFile) of + ok -> + ok; + Error -> + throw({error, {'heart:set_cmd() error', Error}}) + end + end. + +check_start_prg({do_check, StartPrg}, Masters) -> + check_file(StartPrg, regular, Masters), + StartPrg; +check_start_prg({_, StartPrg}, _) -> + StartPrg. + +write_new_start_erl(Data, RelDir, false) -> + DataFile = filename:join([RelDir, "new_start_erl.data"]), + case do_write_file(DataFile, Data) of + ok -> DataFile; + Error -> throw(Error) + end; +write_new_start_erl(Data, RelDir, Masters) -> + DataFile = filename:join([RelDir, "new_start_erl.data"]), + case at_all_masters(Masters, ?MODULE, do_write_file, + [DataFile, Data]) of + ok -> DataFile; + Error -> throw(Error) + end. + +%%----------------------------------------------------------------- +%% When a new emulator shall be restarted, the current release +%% is written with status tmp_current. When the new emulator +%% is started, this function is called. The tmp_current release +%% gets status unpacked on disk, and current in memory. If a reboot +%% is made (due to a crash), the release is just unpacked. If a crash +%% occurs before a call to transform_release is made, the old emulator +%% is started, and transform_release is called for it. The tmp_current +%% release is changed to unpacked. +%% If the release is made permanent, this is written to disk. +%%----------------------------------------------------------------- +transform_release(ReleaseDir, Releases, Masters) -> + F = fun(Release) when Release#release.status == tmp_current -> + Release#release{status = unpacked}; + (Release) -> Release + end, + case lists:map(F, Releases) of + Releases -> + Releases; + DReleases -> + write_releases(ReleaseDir, DReleases, Masters), + F1 = fun(Release) when Release#release.status == tmp_current -> + case init:script_id() of + {_Name, Vsn} when Release#release.vsn == Vsn -> + Release#release{status = current}; + _ -> + Release#release{status = unpacked} + end; + (Release) -> Release + end, + lists:map(F1, Releases) + end. + +%%----------------------------------------------------------------- +%% Functions handling files, RELEASES, start_erl.data etc. +%% This functions consider if the release_handler is a client and +%% in that case performs the operations at all master nodes or at +%% none (in case of failure). +%%----------------------------------------------------------------- + +check_opt_file(FileName, Type, Masters) -> + case catch check_file(FileName, Type, Masters) of + ok -> + true; + _Error -> + io:format("Warning: ~p missing (optional)~n", [FileName]), + false + end. + +check_file(FileName, Type, false) -> + do_check_file(FileName, Type); +check_file(FileName, Type, Masters) -> + check_file_masters(FileName, Type, Masters). + +%% Check that file exists at all masters. +check_file_masters(FileName, Type, [Master|Masters]) -> + do_check_file(Master, FileName, Type), + check_file_masters(FileName, Type, Masters); +check_file_masters(_FileName, _Type, []) -> + ok. + +%% Type == regular | directory +do_check_file(FileName, Type) -> + case file:read_file_info(FileName) of + {ok, Info} when Info#file_info.type==Type -> ok; + {error, _Reason} -> throw({error, {no_such_file, FileName}}) + end. + +do_check_file(Master, FileName, Type) -> + case rpc:call(Master, file, read_file_info, [FileName]) of + {ok, Info} when Info#file_info.type==Type -> ok; + _ -> throw({error, {no_such_file, {Master, FileName}}}) + end. + +%%----------------------------------------------------------------- +%% If Rel doesn't exists in tar it could have been created +%% by the user in another way, i.e. ignore this here. +%%----------------------------------------------------------------- +extract_rel_file(Rel, Tar, Root) -> + erl_tar:extract(Tar, [{files, [Rel]}, {cwd, Root}, compressed]). + +extract_tar(Root, Tar) -> + case erl_tar:extract(Tar, [keep_old_files, {cwd, Root}, compressed]) of + ok -> + ok; + {error, Reason, Name} -> % Old erl_tar. + throw({error, {cannot_extract_file, Name, Reason}}); + {error, {Name, Reason}} -> % New erl_tar (R3A). + throw({error, {cannot_extract_file, Name, Reason}}) + end. + +write_releases(Dir, NewReleases, false) -> + case do_write_release(Dir, "RELEASES", NewReleases) of + ok -> ok; + Error -> throw(Error) + end; +write_releases(Dir, NewReleases, Masters) -> + all_masters(Masters), + write_releases_m(Dir, NewReleases, Masters). + +do_write_release(Dir, RELEASES, NewReleases) -> + case file:open(filename:join(Dir, RELEASES), [write]) of + {ok, Fd} -> + ok = io:format(Fd, "~p.~n", [NewReleases]), + file:close(Fd), + ok; + {error, Reason} -> + {error, Reason} + end. + +%%----------------------------------------------------------------- +%% Write the "RELEASES" file at all master nodes. +%% 1. Save "RELEASES.backup" at all nodes. +%% 2. Save "RELEASES.change" at all nodes. +%% 3. Update the "RELEASES.change" file at all nodes. +%% 4. Move "RELEASES.change" to "RELEASES". +%% 5. Remove "RELEASES.backup" at all nodes. +%% +%% If one of the steps above fails, all steps is recovered from +%% (as long as possible), except for 5 which is allowed to fail. +%%----------------------------------------------------------------- +write_releases_m(Dir, NewReleases, Masters) -> + RelFile = filename:join(Dir, "RELEASES"), + Backup = filename:join(Dir, "RELEASES.backup"), + Change = filename:join(Dir, "RELEASES.change"), + ensure_RELEASES_exists(Masters, RelFile), + case at_all_masters(Masters, ?MODULE, do_copy_files, + [RelFile, [Backup, Change]]) of + ok -> + case at_all_masters(Masters, ?MODULE, do_write_release, + [Dir, "RELEASES.change", NewReleases]) of + ok -> + case at_all_masters(Masters, file, rename, + [Change, RelFile]) of + ok -> + remove_files(all, [Backup, Change], Masters), + ok; + {error, {Master, R}} -> + takewhile(Master, Masters, file, rename, + [Backup, RelFile]), + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, move_releases}}) + end; + {error, {Master, R}} -> + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, update_releases}}) + end; + {error, {Master, R}} -> + remove_files(Master, [Backup, Change], Masters), + throw({error, {Master, R, backup_releases}}) + end. + +ensure_RELEASES_exists(Masters, RelFile) -> + case at_all_masters(Masters, ?MODULE, do_ensure_RELEASES, [RelFile]) of + ok -> + ok; + {error, {Master, R}} -> + throw({error, {Master, R, ensure_RELEASES_exists}}) + end. + +copy_file(File, Dir, false) -> + case do_copy_file(File, Dir) of + ok -> ok; + Error -> throw(Error) + end; +copy_file(File, Dir, Masters) -> + all_masters(Masters), + copy_file_m(File, Dir, Masters). + +%%----------------------------------------------------------------- +%% copy File to Dir at every master node. +%% If an error occurs at a node, the total copy failed. +%% We do not have to cleanup in case of failure as this +%% copy_file is harmless. +%%----------------------------------------------------------------- +copy_file_m(File, Dir, [Master|Masters]) -> + case rpc:call(Master, ?MODULE, do_copy_file, [File, Dir]) of + ok -> copy_file_m(File, Dir, Masters); + {error, {Reason, F}} -> throw({error, {Master, Reason, F}}); + Other -> throw({error, {Master, Other, File}}) + end; +copy_file_m(_File, _Dir, []) -> + ok. + +do_copy_file(File, Dir) -> + File2 = filename:join(Dir, filename:basename(File)), + do_copy_file1(File, File2). + +do_copy_file1(File, File2) -> + case file:read_file(File) of + {ok, Bin} -> + case file:write_file(File2, Bin) of + ok -> ok; + {error, Reason} -> + {error, {Reason, File2}} + end; + {error, Reason} -> + {error, {Reason, File}} + end. + +%%----------------------------------------------------------------- +%% Copy File to a list of files. +%%----------------------------------------------------------------- +do_copy_files(File, [ToFile|ToFiles]) -> + case do_copy_file1(File, ToFile) of + ok -> do_copy_files(File, ToFiles); + Error -> Error + end; +do_copy_files(_, []) -> + ok. + +%%----------------------------------------------------------------- +%% Copy each Src file to Dest file in the list of files. +%%----------------------------------------------------------------- +do_copy_files([{Src, Dest}|Files]) -> + case do_copy_file1(Src, Dest) of + ok -> do_copy_files(Files); + Error -> Error + end; +do_copy_files([]) -> + ok. + +%%----------------------------------------------------------------- +%% Rename each Src file to Dest file in the list of files. +%%----------------------------------------------------------------- +do_rename_files([{Src, Dest}|Files]) -> + case file:rename(Src, Dest) of + ok -> do_rename_files(Files); + Error -> Error + end; +do_rename_files([]) -> + ok. + +%%----------------------------------------------------------------- +%% Remove a list of files. Ignore failure. +%%----------------------------------------------------------------- +do_remove_files([File|Files]) -> + file:delete(File), + do_remove_files(Files); +do_remove_files([]) -> + ok. + + +%%----------------------------------------------------------------- +%% Ensure that the RELEASES file exists. +%% If not create an empty RELEASES file. +%%----------------------------------------------------------------- +do_ensure_RELEASES(RelFile) -> + case file:read_file_info(RelFile) of + {ok, _} -> ok; + _ -> do_write_file(RelFile, "[]. ") + end. + +%%----------------------------------------------------------------- +%% Make a directory, ignore failures (captured later). +%%----------------------------------------------------------------- +make_dir(Dir, false) -> + file:make_dir(Dir); +make_dir(Dir, Masters) -> + lists:foreach(fun(Master) -> rpc:call(Master, file, make_dir, [Dir]) end, + Masters). + +%%----------------------------------------------------------------- +%% Check that all masters are alive. +%%----------------------------------------------------------------- +all_masters(Masters) -> + case rpc:multicall(Masters, erlang, info, [version]) of + {_, []} -> ok; + {_, BadNodes} -> throw({error, {bad_masters, BadNodes}}) + end. + +%%----------------------------------------------------------------- +%% Evaluate {M,F,A} at all masters. +%% {M,F,A} is supposed to return ok. Otherwise at_all_masters +%% returns {error, {Master, Other}}. +%%----------------------------------------------------------------- +at_all_masters([Master|Masters], M, F, A) -> + case rpc:call(Master, M, F, A) of + ok -> at_all_masters(Masters, M, F, A); + Error -> {error, {Master, Error}} + end; +at_all_masters([], _, _, _) -> + ok. + +%%----------------------------------------------------------------- +%% Evaluate {M,F,A} at all masters until Master is found. +%% Ignore {M,F,A} return value. +%%----------------------------------------------------------------- +takewhile(Master, Masters, M, F, A) -> + lists:takewhile(fun(Ma) when Ma == Master -> + false; + (Ma) -> + rpc:call(Ma, M, F, A), + true + end, Masters), + ok. + +consult(File, false) -> file:consult(File); +consult(File, Masters) -> consult_master(Masters, File). + +%%----------------------------------------------------------------- +%% consult the File at any master node. +%% If the file does not exist at one node it should +%% not exist at any other node either. +%%----------------------------------------------------------------- +consult_master([Master|Ms], File) -> + case rpc:call(Master, file, consult, [File]) of + {badrpc, _} -> consult_master(Ms, File); + Res -> Res + end; +consult_master([], _File) -> + {error, no_master}. + +read_file(File, false) -> + file:read_file(File); +read_file(File, Masters) -> + read_master(Masters, File). + +%% Ignore status of each delete ! +remove_files(Master, Files, Masters) -> + takewhile(Master, Masters, ?MODULE, do_remove_files, [Files]). + +%%----------------------------------------------------------------- +%% read the File at any master node. +%% If the file does not exist at one node it should +%% not exist at any other node either. +%%----------------------------------------------------------------- +read_master([Master|Ms], File) -> + case rpc:call(Master, file, read_file, [File]) of + {badrpc, _} -> read_master(Ms, File); + Res -> Res + end; +read_master([], _File) -> + {error, no_master}. + +%%----------------------------------------------------------------- +%% Write start_erl.data. +%%----------------------------------------------------------------- +write_start(File, Data, false) -> + case do_write_file(File, Data) of + ok -> ok; + Error -> throw(Error) + end; +write_start(File, Data, Masters) -> + all_masters(Masters), + write_start_m(File, Data, Masters). + + +%%----------------------------------------------------------------- +%% Write the "start_erl.data" file at all master nodes. +%% 1. Save "start_erl.backup" at all nodes. +%% 2. Write the "start_erl.change" file at all nodes. +%% 3. Move "start_erl.change" to "start_erl.data". +%% 4. Remove "start_erl.backup" at all nodes. +%% +%% If one of the steps above fails, all steps is recovered from +%% (as long as possible), except for 4 which is allowed to fail. +%%----------------------------------------------------------------- +write_start_m(File, Data, Masters) -> + Dir = filename:dirname(File), + Backup = filename:join(Dir, "start_erl.backup"), + Change = filename:join(Dir, "start_erl.change"), + case at_all_masters(Masters, ?MODULE, do_copy_files, + [File, [Backup]]) of + ok -> + case at_all_masters(Masters, ?MODULE, do_write_file, + [Change, Data]) of + ok -> + case at_all_masters(Masters, file, rename, + [Change, File]) of + ok -> + remove_files(all, [Backup, Change], Masters), + ok; + {error, {Master, R}} -> + takewhile(Master, Masters, file, rename, + [Backup, File]), + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, move_start_erl}}) + end; + {error, {Master, R}} -> + remove_files(all, [Backup, Change], Masters), + throw({error, {Master, R, write_start_erl}}) + end; + {error, {Master, R}} -> + remove_files(Master, [Backup], Masters), + throw({error, {Master, R, backup_start_erl}}) + end. + +%%----------------------------------------------------------------- +%% Copy the "start.boot" and "sys.config" from SrcDir to DestDir at all +%% master nodes. +%% 1. Save DestDir/"start.backup" and DestDir/"sys.backup" at all nodes. +%% 2. Copy files at all nodes. +%% 3. Remove backup files at all nodes. +%% +%% If one of the steps above fails, all steps is recovered from +%% (as long as possible), except for 3 which is allowed to fail. +%%----------------------------------------------------------------- +set_static_files(SrcDir, DestDir, Masters) -> + all_masters(Masters), + Boot = "start.boot", + Config = "sys.config", + SrcBoot = filename:join(SrcDir, Boot), + DestBoot = filename:join(DestDir, Boot), + BackupBoot = filename:join(DestDir, "start.backup"), + SrcConf = filename:join(SrcDir, Config), + DestConf = filename:join(DestDir, Config), + BackupConf = filename:join(DestDir, "sys.backup"), + + case at_all_masters(Masters, ?MODULE, do_copy_files, + [[{DestBoot, BackupBoot}, + {DestConf, BackupConf}]]) of + ok -> + case at_all_masters(Masters, ?MODULE, do_copy_files, + [[{SrcBoot, DestBoot}, + {SrcConf, DestConf}]]) of + ok -> + remove_files(all, [BackupBoot, BackupConf], Masters), + ok; + {error, {Master, R}} -> + takewhile(Master, Masters, ?MODULE, do_rename_files, + [{BackupBoot, DestBoot}, + {BackupConf, DestConf}]), + remove_files(all, [BackupBoot, BackupConf], Masters), + throw({error, {Master, R, copy_start_config}}) + end; + {error, {Master, R}} -> + remove_files(Master, [BackupBoot, BackupConf], Masters), + throw({error, {Master, R, backup_start_config}}) + end. diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl new file mode 100644 index 0000000000..e3e3caba99 --- /dev/null +++ b/lib/sasl/src/release_handler_1.erl @@ -0,0 +1,647 @@ +%% +%% %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% +%% +-module(release_handler_1). + +%% External exports +-export([eval_script/3, eval_script/4, check_script/2]). +-export([get_vsn/1]). %% exported because used in a test case + +-record(eval_state, {bins = [], stopped = [], suspended = [], apps = [], + libdirs, unpurged = [], vsns = [], newlibs = [], + opts = []}). +%%----------------------------------------------------------------- +%% bins = [{Mod, Binary, FileName}] +%% stopped = [{Mod, [pid()]}] - list of stopped pids for each module +%% suspended = [{Mod, [pid()]}] - list of suspended pids for each module +%% apps = [app_spec()] - list of all apps in the new release +%% libdirs = [{Lib, LibVsn, LibDir}] - Maps Lib to Vsn and Directory +%% unpurged = [{Mod, soft_purge | brutal_purge}] +%% vsns = [{Mod, OldVsn, NewVsn}] - remember the old vsn of a mod +%% before it is removed/a new vsn is loaded; the new vsn +%% is kept in case of a downgrade, where the code_change +%% function receives the vsn of the module to downgrade +%% *to*. +%% newlibs = [{Lib, Dir}] - list of all new libs; used to change +%% the code path +%% opts = [{Tag, Value}] - list of options +%%----------------------------------------------------------------- + + +%%%----------------------------------------------------------------- +%%% This is a low-level release handler. +%%%----------------------------------------------------------------- +check_script(Script, LibDirs) -> + case catch check_old_processes(Script) of + ok -> + {Before, _After} = split_instructions(Script), + case catch lists:foldl(fun(Instruction, EvalState1) -> + eval(Instruction, EvalState1) + end, + #eval_state{libdirs = LibDirs}, + Before) of + EvalState2 when is_record(EvalState2, eval_state) -> ok; + {error, Error} -> {error, Error}; + Other -> {error, Other} + end; + {error, Mod} -> + {error, {old_processes, Mod}} + end. + +eval_script(Script, Apps, LibDirs) -> + eval_script(Script, Apps, LibDirs, []). + +eval_script(Script, Apps, LibDirs, Opts) -> + case catch check_old_processes(Script) of + ok -> + {Before, After} = split_instructions(Script), + case catch lists:foldl(fun(Instruction, EvalState1) -> + eval(Instruction, EvalState1) + end, + #eval_state{apps = Apps, + libdirs = LibDirs, + opts = Opts}, + Before) of + EvalState2 when is_record(EvalState2, eval_state) -> + case catch lists:foldl(fun(Instruction, EvalState3) -> + eval(Instruction, EvalState3) + end, + EvalState2, + After) of + EvalState4 when is_record(EvalState4, eval_state) -> + {ok, EvalState4#eval_state.unpurged}; + restart_new_emulator -> + restart_new_emulator; + Error -> + {'EXIT', Error} + end; + {error, Error} -> {error, Error}; + Other -> {error, Other} + end; + {error, Mod} -> + {error, {old_processes, Mod}} + end. + +%%%----------------------------------------------------------------- +%%% Internal functions +%%%----------------------------------------------------------------- +split_instructions(Script) -> + split_instructions(Script, []). +split_instructions([point_of_no_return | T], Before) -> + {lists:reverse(Before), [point_of_no_return | T]}; +split_instructions([H | T], Before) -> + split_instructions(T, [H | Before]); +split_instructions([], Before) -> + {[], lists:reverse(Before)}. + +%%----------------------------------------------------------------- +%% Func: check_old_processes/1 +%% Args: Script = [instruction()] +%% Purpose: Check if there is any process that runs an old version +%% of a module that should be soft_purged, (i.e. not purged +%% at all if there is any such process). Returns {error, Mod} +%% if so, ok otherwise. +%% Returns: ok | {error, Mod} +%% Mod = atom() +%%----------------------------------------------------------------- +check_old_processes(Script) -> + lists:foreach(fun({load, {Mod, soft_purge, _PostPurgeMethod}}) -> + check_old_code(Mod); + ({remove, {Mod, soft_purge, _PostPurgeMethod}}) -> + check_old_code(Mod); + (_) -> ok + end, + Script). + +check_old_code(Mod) -> + lists:foreach(fun(Pid) -> + case erlang:check_process_code(Pid, Mod) of + false -> ok; + true -> throw({error, Mod}) + end + end, + erlang:processes()). + +%%----------------------------------------------------------------- +%% An unpurged module is a module for which there exist an old +%% version of the code. This should only be the case if there are +%% processes running the old version of the code. +%% +%% This functions evaluates each instruction. Note that the +%% instructions here are low-level instructions. e.g. lelle's +%% old synchronized_change would be translated to +%% {load_object_code, Modules}, +%% {suspend, Modules}, [{load, Module}], +%% {resume, Modules}, {purge, Modules} +%% Or, for example, if we want to do advanced external code change +%% on two modules that depend on each other, by killing them and +%% then restaring them, we could do: +%% {load_object_code, [Mod1, Mod2]}, +%% % delete old version +%% {remove, {Mod1, brutal_purge}}, {remove, {Mod2, brutal_purge}}, +%% % now, some procs migth be running prev current (now old) version +%% % kill them, and load new version +%% {load, {Mod1, brutal_purge}}, {load, {Mod2, brutal_purge}} +%% % now, there is one version of the code (new, current) +%% +%% NOTE: All load_object_code must be first in the script, +%% a point_of_no_return must be present (if load_object_code +%% is present). +%% +%% {load_object_code, {Lib, LibVsn, [Mod]} +%% read the files as binarys. do not make code out of them +%% {load, {Module, PrePurgeMethod, PostPurgeMethod}} +%% Module must have been load_object_code:ed. make code out of it +%% old procs && soft_purge => no new release +%% old procs && brutal_purge => old procs killed +%% The new old code will be gc:ed later on, if PostPurgeMethod = +%% soft_purge. If it is brutal_purge, the code is purged when +%% the release is made permanent. +%% {remove, {Module, PrePurgeMethod, PostPurgeMethod}} +%% make current version old. no current left. +%% old procs && soft_purge => no new release +%% old procs && brutal_purge => old procs killed +%% The new old code will be gc:ed later on, if PostPurgeMethod = +%% soft_purge. If it is brutal_purge, the code is purged when +%% the release is made permanent. +%% {purge, Modules} +%% kill all procs running old code, delete old code +%% {suspend, [Module | {Module, Timeout}]} +%% If a process doesn't repsond - never mind. It will be killed +%% later on (if a purge is performed). +%% Hmm, we must do something smart here... we should probably kill it, +%% but we cant, because its supervisor will restart it directly! Maybe +%% we should keep a list of those, call supervisor:terminate_child() +%% when all others are suspended, and call sup:restart_child() when the +%% others are resumed. +%% {code_change, [{Module, Extra}]} +%% {code_change, Mode, [{Module, Extra}]} Mode = up | down +%% Send code_change only to suspended procs running this code +%% {resume, [Module]} +%% resume all previously suspended processes +%% {stop, [Module]} +%% stop all procs running this code +%% {start, [Module]} +%% starts the procs that were previously stopped for this code. +%% Note that this will start processes in exactly the same place +%% in the suptree where there were procs previously. +%% {sync_nodes, Id, [Node]} +%% {sync_nodes, Id, {M, F, A}} +%% Synchronizes with the Nodes (or apply(M,F,A) == Nodes). All Nodes +%% must also exectue the same line. Waits for all these nodes to get +%% to this line. +%% point_of_no_return +%% restart_new_emulator +%% {stop_application, Appl} - Impl with apply +%% {unload_application, Appl} - Impl with {remove..} +%% {load_application, Appl} - Impl with {load..} +%% {start_application, Appl} - Impl with apply +%%----------------------------------------------------------------- +eval({load_object_code, {Lib, LibVsn, Modules}}, EvalState) -> + case lists:keysearch(Lib, 1, EvalState#eval_state.libdirs) of + {value, {Lib, LibVsn, LibDir}} -> + Ebin = filename:join(LibDir, "ebin"), + Ext = code:objfile_extension(), + {NewBins, NewVsns} = + lists:foldl(fun(Mod, {Bins, Vsns}) -> + File = lists:concat([Mod, Ext]), + FName = filename:join(Ebin, File), + case erl_prim_loader:get_file(FName) of + {ok, Bin, FName2} -> + NVsns = add_new_vsn(Mod, FName2, Vsns), + {[{Mod, Bin, FName2} | Bins],NVsns}; + error -> + throw({error, {no_such_file,FName}}) + end + end, + {EvalState#eval_state.bins, + EvalState#eval_state.vsns}, + Modules), + NewLibs = [{Lib, Ebin} | EvalState#eval_state.newlibs], + EvalState#eval_state{bins = NewBins, + newlibs = NewLibs, + vsns = NewVsns}; + {value, {Lib, LibVsn2, _LibDir}} -> + throw({error, {bad_lib_vsn, Lib, LibVsn2}}) + end; +eval(point_of_no_return, EvalState) -> + Libs = case get_opt(update_paths, EvalState, false) of + false -> + EvalState#eval_state.newlibs; % [{Lib, Path}] + true -> + lists:map(fun({Lib, _LibVsn, LibDir}) -> + Ebin= filename:join(LibDir,"ebin"), + {Lib, Ebin} + end, + EvalState#eval_state.libdirs) + end, + lists:foreach(fun({Lib, Path}) -> code:replace_path(Lib, Path) end, + Libs), + EvalState; +eval({load, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> + Bins = EvalState#eval_state.bins, + {value, {_Mod, Bin, File}} = lists:keysearch(Mod, 1, Bins), + % load_binary kills all procs running old code + % if soft_purge, we know that there are no such procs now + Vsns = EvalState#eval_state.vsns, + NewVsns = add_old_vsn(Mod, Vsns), + code:load_binary(Mod, File, Bin), + % Now, the prev current is old. There might be procs + % running it. Find them. + Unpurged = do_soft_purge(Mod,PostPurgeMethod,EvalState#eval_state.unpurged), + EvalState#eval_state{bins = lists:keydelete(Mod, 1, Bins), + unpurged = Unpurged, + vsns = NewVsns}; +eval({remove, {Mod, _PrePurgeMethod, PostPurgeMethod}}, EvalState) -> + % purge kills all procs running old code + % if soft_purge, we know that there are no such procs now + Vsns = EvalState#eval_state.vsns, + NewVsns = add_old_vsn(Mod, Vsns), + code:purge(Mod), + code:delete(Mod), + % Now, the prev current is old. There might be procs + % running it. Find them. + Unpurged = + case code:soft_purge(Mod) of + true -> EvalState#eval_state.unpurged; + false -> [{Mod, PostPurgeMethod} | EvalState#eval_state.unpurged] + end, +%% Bins = EvalState#eval_state.bins, +%% EvalState#eval_state{bins = lists:keydelete(Mod, 1, Bins), + EvalState#eval_state{unpurged = Unpurged, vsns = NewVsns}; +eval({purge, Modules}, EvalState) -> + % Now, if there are any processes still executing old code, OR + % if some new processes started after suspend but before load, + % these are killed. + lists:foreach(fun(Mod) -> code:purge(Mod) end, Modules), + EvalState; +eval({suspend, Modules}, EvalState) -> + Procs = get_supervised_procs(), + NewSuspended = + lists:foldl(fun(ModSpec, Suspended) -> + {Module, Def} = case ModSpec of + {Mod, ModTimeout} -> + {Mod, ModTimeout}; + Mod -> + {Mod, default} + end, + Timeout = get_opt(suspend_timeout, EvalState, Def), + Pids = suspend(Module, Procs, Timeout), + [{Module, Pids} | Suspended] + end, + EvalState#eval_state.suspended, + Modules), + EvalState#eval_state{suspended = NewSuspended}; +eval({resume, Modules}, EvalState) -> + NewSuspended = + lists:foldl(fun(Mod, Suspended) -> + lists:filter(fun({Mod2, Pids}) when Mod2 == Mod -> + resume(Pids), + false; + (_) -> + true + end, + Suspended) + end, + EvalState#eval_state.suspended, + Modules), + EvalState#eval_state{suspended = NewSuspended}; +eval({code_change, Modules}, EvalState) -> + eval({code_change, up, Modules}, EvalState); +eval({code_change, Mode, Modules}, EvalState) -> + Suspended = EvalState#eval_state.suspended, + Vsns = EvalState#eval_state.vsns, + Timeout = get_opt(code_change_timeout, EvalState, default), + lists:foreach(fun({Mod, Extra}) -> + Vsn = + case lists:keysearch(Mod, 1, Vsns) of + {value, {Mod, OldVsn, _NewVsn}} + when Mode == up -> OldVsn; + {value, {Mod, _OldVsn, NewVsn}} + when Mode == down -> {down, NewVsn}; + _ when Mode == up -> undefined; + _ -> {down, undefined} + end, + case lists:keysearch(Mod, 1, Suspended) of + {value, {_Mod, Pids}} -> + change_code(Pids, Mod, Vsn, Extra, Timeout); + _ -> ok + end + end, + Modules), + EvalState; +eval({stop, Modules}, EvalState) -> + Procs = get_supervised_procs(), + NewStopped = + lists:foldl(fun(Mod, Stopped) -> + Procs2 = stop(Mod, Procs), + [{Mod, Procs2} | Stopped] + end, + EvalState#eval_state.stopped, + Modules), + EvalState#eval_state{stopped = NewStopped}; +eval({start, Modules}, EvalState) -> + NewStopped = + lists:foldl(fun(Mod, Stopped) -> + lists:filter(fun({Mod2, Procs}) when Mod2 == Mod -> + start(Procs), + false; + (_) -> + true + end, + Stopped) + end, + EvalState#eval_state.stopped, + Modules), + EvalState#eval_state{stopped = NewStopped}; +eval({sync_nodes, Id, {M, F, A}}, EvalState) -> + sync_nodes(Id, apply(M, F, A)), + EvalState; +eval({sync_nodes, Id, Nodes}, EvalState) -> + sync_nodes(Id, Nodes), + EvalState; +eval({apply, {M, F, A}}, EvalState) -> + apply(M, F, A), + EvalState; +eval(restart_new_emulator, _EvalState) -> + throw(restart_new_emulator). + +get_opt(Tag, EvalState, Default) -> + case lists:keysearch(Tag, 1, EvalState#eval_state.opts) of + {value, {_Tag, Value}} -> Value; + false -> Default + end. + +%%----------------------------------------------------------------- +%% This is a first approximation. Unfortunately, we might end up +%% with the situation that after this suspendation, some new +%% processes start *before* we have loaded the new code, and these +%% will execute the old code. These processes could be terminated +%% later on (if the prev current version is purged). The same +%% goes for processes that didn't respond to the suspend message. +%%----------------------------------------------------------------- +suspend(Mod, Procs, Timeout) -> + lists:zf(fun({_Sup, _Name, Pid, Mods}) -> + case lists:member(Mod, Mods) of + true -> + case catch sys_suspend(Pid, Timeout) of + ok -> {true, Pid}; + _ -> + % If the proc hangs, make sure to + % resume it when it gets suspended! + catch sys:resume(Pid), + false + end; + false -> + false + end + end, + Procs). + +sys_suspend(Pid, default) -> + sys:suspend(Pid); +sys_suspend(Pid, Timeout) -> + sys:suspend(Pid, Timeout). + +resume(Pids) -> + lists:foreach(fun(Pid) -> catch sys:resume(Pid) end, Pids). + +change_code(Pids, Mod, Vsn, Extra, Timeout) -> + Fun = fun(Pid) -> + case Timeout of + default -> + ok = sys:change_code(Pid, Mod, Vsn, Extra); + _Else -> + ok = sys:change_code(Pid, Mod, Vsn, Extra, Timeout) + end + end, + lists:foreach(Fun, Pids). + +stop(Mod, Procs) -> + lists:zf(fun({undefined, _Name, _Pid, _Mods}) -> + false; + ({Sup, Name, _Pid, Mods}) -> + case lists:member(Mod, Mods) of + true -> + case catch supervisor:terminate_child( + Sup, Name) of + ok -> {true, {Sup, Name}}; + _ -> false + end; + false -> false + end + end, + Procs). + +start(Procs) -> + lists:foreach(fun({Sup, Name}) -> + catch supervisor:restart_child(Sup, Name) + end, + Procs). + +%%----------------------------------------------------------------- +%% Func: get_supervised_procs/0 +%% Purpose: This is the magic function. It finds all process in +%% the system and which modules they execute as a call_back or +%% process module. +%% This is achieved by asking the main supervisor for the +%% applications for all children and their modules +%% (recursively). +%% NOTE: If a supervisor is suspended, it isn't possible to call +%% which_children. Code change on a supervisor should be +%% done in another way; the only code in a supervisor is +%% code for starting children. Therefore, to change a +%% supervisor module, we should load the new version, and then +%% delete the old. Then we should perform the start changes +%% manually, by adding/deleting children. +%% Returns: [{SuperPid, ChildName, ChildPid, Mods}] +%%----------------------------------------------------------------- +%% OTP-3452. For each application the first item contains the pid +%% of the top supervisor, and the name of the supervisor call-back module. +%%----------------------------------------------------------------- + +get_supervised_procs() -> + lists:foldl( + fun(Application, Procs) -> + case application_controller:get_master(Application) of + Pid when is_pid(Pid) -> + {Root, _AppMod} = application_master:get_child(Pid), + case get_supervisor_module(Root) of + {ok, SupMod} -> + get_procs(supervisor:which_children(Root), + Root) ++ + [{undefined, undefined, Root, [SupMod]} | + Procs]; + {error, _} -> + error_logger:error_msg("release_handler: " + "cannot find top " + "supervisor for " + "application ~w~n", + [Application]), + get_procs(supervisor:which_children(Root), + Root) ++ Procs + end; + _ -> Procs + end + end, + [], + lists:map(fun({Application, _Name, _Vsn}) -> + Application + end, + application:which_applications())). + +get_procs([{Name, Pid, worker, dynamic} | T], Sup) when is_pid(Pid) -> + Mods = get_dynamic_mods(Pid), + [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; +get_procs([{Name, Pid, worker, Mods} | T], Sup) when is_pid(Pid), is_list(Mods) -> + [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; +get_procs([{Name, Pid, supervisor, Mods} | T], Sup) when is_pid(Pid) -> + [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++ + get_procs(supervisor:which_children(Pid), Pid); +get_procs([_H | T], Sup) -> + get_procs(T, Sup); +get_procs(_, _Sup) -> + []. + +get_dynamic_mods(Pid) -> + {ok,Res} = gen:call(Pid, self(), get_modules), + Res. + +%% XXXX +%% Note: The following is a terrible hack done in order to resolve the +%% problem stated in ticket OTP-3452. + +%% XXXX NOTE WELL: This record is from supervisor.erl. Also the record +%% name is really `state'. +-record(supervisor_state, {name, + strategy, + children = [], + dynamics = [], + intensity, + period, + restarts = [], + module, + args}). + +%% Return the name of the call-back module that implements the +%% (top) supervisor SupPid. +%% Returns: {ok, Module} | {error,undefined} +%% +get_supervisor_module(SupPid) -> + case catch get_supervisor_module1(SupPid) of + {ok, Module} when is_atom(Module) -> + {ok, Module}; + _Other -> + io:format("~w: reason: ~w~n", [SupPid, _Other]), + {error, undefined} + end. + +get_supervisor_module1(SupPid) -> + {status, _Pid, {module, _Mod}, + [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(SupPid), + [_Name, State, _Type, _Time] = Misc, + %% Cannot use #supervisor_state{module = Module} = State. + {ok, element(#supervisor_state.module, State)}. + +%%----------------------------------------------------------------- +%% Func: do_soft_purge/3 +%% Args: Mod = atom() +%% PostPurgeMethod = soft_purge | brutal_purge +%% Unpurged = [{Mod, PostPurgeMethod}] +%% Purpose: Check if there are any processes left running this code. +%% If so, make sure Mod is a member in the returned list. +%% Otherwise, make sure Mod isn't a member in the returned +%% list. +%% Returns: An updated list of unpurged modules. +%%----------------------------------------------------------------- +do_soft_purge(Mod, PostPurgeMethod, Unpurged) -> + IsNoOldProcsLeft = code:soft_purge(Mod), + case lists:keymember(Mod, 1, Unpurged) of + true when IsNoOldProcsLeft == true -> lists:keydelete(Mod, 1, Unpurged); + true -> Unpurged; + false when IsNoOldProcsLeft == true -> Unpurged; + false -> [{Mod, PostPurgeMethod} | Unpurged] + end. + +%%----------------------------------------------------------------- +%% Func: sync_nodes/2 +%% Args: Id = term() +%% Nodes = [atom()] +%% Purpose: Synchronizes with all nodes. +%%----------------------------------------------------------------- +sync_nodes(Id, Nodes) -> + NNodes = lists:delete(node(), Nodes), + lists:foreach(fun(Node) -> + {release_handler, Node} ! {sync_nodes, Id, node()} + end, + NNodes), + lists:foreach(fun(Node) -> + receive + {sync_nodes, Id, Node} -> + ok; + {nodedown, Node} -> + throw({sync_error, {nodedown, Node}}) + end + end, + NNodes). + +add_old_vsn(Mod, Vsns) -> + case lists:keysearch(Mod, 1, Vsns) of + {value, {Mod, undefined, NewVsn}} -> + OldVsn = get_vsn(code:which(Mod)), + lists:keyreplace(Mod, 1, Vsns, {Mod, OldVsn, NewVsn}); + {value, {Mod, _OldVsn, _NewVsn}} -> + Vsns; + false -> + OldVsn = get_vsn(code:which(Mod)), + [{Mod, OldVsn, undefined} | Vsns] + end. + +add_new_vsn(Mod, File, Vsns) -> + NewVsn = get_vsn(File), + case lists:keysearch(Mod, 1, Vsns) of + {value, {Mod, OldVsn, undefined}} -> + lists:keyreplace(Mod, 1, Vsns, {Mod, OldVsn, NewVsn}); + false -> + [{Mod, undefined, NewVsn} | Vsns] + end. + + + +%%----------------------------------------------------------------- +%% Func: get_vsn/1 +%% Args: File = string() +%% Purpose: Finds the version attribute of a module. +%% Returns: Vsn +%% Vsn = term() +%%----------------------------------------------------------------- +get_vsn(File) -> + {ok, {_Mod, Vsn}} = beam_lib:version(File), + case misc_supp:is_string(Vsn) of + true -> + Vsn; + false -> + %% If -vsn(Vsn) defines a term which is not a + %% string, the value is returned here as [Vsn]. + case Vsn of + [VsnTerm] -> + VsnTerm; + _ -> + Vsn + end + end. diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src new file mode 100644 index 0000000000..cfe4b81ab6 --- /dev/null +++ b/lib/sasl/src/sasl.app.src @@ -0,0 +1,46 @@ +%% +%% %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% +%% +{application, sasl, + [{description, "SASL CXC 138 11"}, + {vsn, "%VSN%"}, + {modules, [sasl, + alarm_handler, + format_lib_supp, + misc_supp, + overload, + rb, + rb_format_supp, + release_handler, + release_handler_1, + erlsrv, + sasl_report, + sasl_report_tty_h, + sasl_report_file_h, + systools, + systools_make, + systools_rc, + systools_relup, + systools_lib + ]}, + {registered, [sasl_sup, alarm_handler, overload, release_handler]}, + {applications, [kernel, stdlib]}, + {env, [{sasl_error_logger, tty}, + {errlog_type, all}]}, + {mod, {sasl, []}}]}. + diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src new file mode 100644 index 0000000000..64c653a4e5 --- /dev/null +++ b/lib/sasl/src/sasl.appup.src @@ -0,0 +1,25 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-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% +%% + +{"%VSN%", + [{"2.1.4", [{load_module, release_handler}, + {load_module, systools_relup}]}], + [{"2.1.4", [{load_module, release_handler}, + {load_module, systools_relup}]}] +}. diff --git a/lib/sasl/src/sasl.erl b/lib/sasl/src/sasl.erl new file mode 100644 index 0000000000..979d80159e --- /dev/null +++ b/lib/sasl/src/sasl.erl @@ -0,0 +1,162 @@ +%% +%% %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% +%% +-module(sasl). + +%% External exports +-export([start/2, stop/1]). + +%% Internal exports +-export([init/1, pred/1]). + +%%%----------------------------------------------------------------- +%%% This module implements the application SASL, +%%% and a supervisor for SASL. +%%%----------------------------------------------------------------- +-behaviour(application). + +-record(state, {sasl_error_logger, error_logger_mf}). + +start(_, []) -> + Handler = get_sasl_error_logger(), + Type = get_sasl_error_logger_type(), + Mf = get_error_logger_mf(), + add_sasl_error_logger(Handler, Type), + add_error_logger_mf(Mf), + State = #state{sasl_error_logger = Handler, error_logger_mf = Mf}, + case supervisor:start_link({local, sasl_sup}, sasl, []) of + {ok, Pid} -> {ok, Pid, State}; + Error -> Error + end. + +stop(State) -> + delete_sasl_error_logger(State#state.sasl_error_logger), + delete_error_logger_mf(State#state.error_logger_mf). + +%%----------------------------------------------------------------- +%% Internal functions +%%----------------------------------------------------------------- +get_sasl_error_logger() -> + case application:get_env(sasl, sasl_error_logger) of + {ok, false} -> undefined; + {ok, tty} -> tty; + {ok, {file, File}} when is_list(File) -> {file, File}; + {ok, Bad} -> exit({bad_config, {sasl, {sasl_error_logger, Bad}}}); + _ -> undefined + end. + +get_sasl_error_logger_type() -> + case application:get_env(sasl, errlog_type) of + {ok, error} -> error; + {ok, progress} -> progress; + {ok, all} -> all; + {ok, Bad} -> exit({bad_config, {sasl, {errlog_type, Bad}}}); + _ -> all + end. + +get_error_logger_mf() -> + case catch get_mf() of + {'EXIT', Reason} -> + exit(Reason); + Mf -> + Mf + end. + +get_mf() -> + Dir = get_mf_dir(), + MaxB = get_mf_maxb(), + MaxF = get_mf_maxf(), + {Dir, MaxB, MaxF}. + +get_mf_dir() -> + case application:get_env(sasl, error_logger_mf_dir) of + {ok, false} -> throw(undefined); + {ok, Dir} when is_list(Dir) -> Dir; + undefined -> throw(undefined); + {ok, Bad} -> exit({bad_config, {sasl, {error_logger_mf_dir, Bad}}}) + end. + +get_mf_maxb() -> + case application:get_env(sasl, error_logger_mf_maxbytes) of + {ok, MaxB} when is_integer(MaxB) -> MaxB; + undefined -> throw(undefined); + {ok, Bad} -> exit({bad_config, {sasl, {error_logger_mf_maxbytes, Bad}}}) + end. + +get_mf_maxf() -> + case application:get_env(sasl, error_logger_mf_maxfiles) of + {ok, MaxF} when is_integer(MaxF), MaxF > 0, MaxF < 256 -> MaxF; + undefined -> throw(undefined); + {ok, Bad} -> exit({bad_config, {sasl, {error_logger_mf_maxfiles, Bad}}}) + end. + +add_sasl_error_logger(undefined, _Type) -> ok; +add_sasl_error_logger(Handler, Type) -> + error_logger:add_report_handler(mod(Handler), args(Handler, Type)). + +delete_sasl_error_logger(undefined) -> ok; +delete_sasl_error_logger(Type) -> + error_logger:delete_report_handler(mod(Type)). + +mod(tty) -> sasl_report_tty_h; +mod({file, _File}) -> sasl_report_file_h. + +args({file, File}, Type) -> {File, type(Type)}; +args(_, Type) -> type(Type). + +type(error) -> error; +type(progress) -> progress; +type(_) -> all. + +add_error_logger_mf(undefined) -> ok; +add_error_logger_mf({Dir, MaxB, MaxF}) -> + error_logger:add_report_handler( + log_mf_h, log_mf_h:init(Dir, MaxB, MaxF, {sasl, pred})). + +delete_error_logger_mf(undefined) -> ok; +delete_error_logger_mf(_) -> + error_logger:delete_report_handler(log_mf_h). + +pred({_Type, GL, _Msg}) when node(GL) /= node() -> false; +pred(_) -> true. + +%%%----------------------------------------------------------------- +%%% supervisor functionality +%%%----------------------------------------------------------------- +init([]) -> + SupFlags = {one_for_one, 0, 1}, + %% Reboot node if release_handler crashes! + SafeSupervisor = {sasl_safe_sup, + {supervisor, start_link, + [{local, sasl_safe_sup}, ?MODULE, safe]}, + permanent, infinity, supervisor, [?MODULE]}, + ReleaseH = {release_handler, + {release_handler, start_link, []}, + permanent, 2000, worker, []}, % Note! [] for modules! We + % can't change code on r_h + % this way!! + {ok, {SupFlags, [SafeSupervisor, ReleaseH]}}; +init(safe) -> + SupFlags = {one_for_one, 4, 3600}, + AlarmH = {alarm_handler, + {alarm_handler, start_link, []}, + permanent, 2000, worker, dynamic}, + Overload = {overload, + {overload, start_link, []}, + permanent, 2000, worker, [overload]}, + {ok, {SupFlags, [AlarmH, Overload]}}. diff --git a/lib/sasl/src/sasl_report.erl b/lib/sasl/src/sasl_report.erl new file mode 100644 index 0000000000..bad3a75151 --- /dev/null +++ b/lib/sasl/src/sasl_report.erl @@ -0,0 +1,135 @@ +%% +%% %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% +%% +-module(sasl_report). + +-export([write_report/3]). + +write_report(Fd, What, {Time, {error_report, _GL, {Pid, Type, Report}}}) -> + case is_my_error_report(What, Type) of + true -> + Head = write_head(Type, Time, Pid), + write_report2(Fd, Head, Type, Report); + _ -> true + end; +write_report(Fd, What, {Time, {info_report, _GL, {Pid, Type, Report}}}) -> + case is_my_info_report(What, Type) of + true -> + Head = write_head(Type, Time, Pid), + write_report2(Fd, Head, Type, Report); + _ -> true + end; +write_report(_Fd, _, _) -> + false. + +is_my_error_report(all, Type) -> is_my_error_report(Type); +is_my_error_report(error, Type) -> is_my_error_report(Type); +is_my_error_report(_, _Type) -> false. +is_my_error_report(supervisor_report) -> true; +is_my_error_report(crash_report) -> true; +is_my_error_report(_) -> false. + +is_my_info_report(all, Type) -> is_my_info_report(Type); +is_my_info_report(progress, Type) -> is_my_info_report(Type); +is_my_info_report(_, _Type) -> false. +is_my_info_report(progress) -> true; +is_my_info_report(_) -> false. + +write_report2(Fd, Head, supervisor_report, Report) -> + Name = sup_get(supervisor, Report), + Context = sup_get(errorContext, Report), + Reason = sup_get(reason, Report), + Offender = sup_get(offender, Report), + io:format(Fd, Head ++ " Supervisor: ~p~n Context: ~p~n Reason: " + "~80.18p~n Offender: ~80.18p~n~n", + [Name,Context,Reason,Offender]); +write_report2(Fd, Head, progress, Report) -> + Format = format_key_val(Report), + io:format(Fd, Head ++ "~s", [Format]); +write_report2(Fd, Head, crash_report, Report) -> + Format = proc_lib:format(Report), + io:format(Fd, Head ++ "~s", [Format]). + +format_key_val([{Tag,Data}|Rep]) -> + io_lib:format(" ~16w: ~p~n",[Tag,Data]) ++ format_key_val(Rep); +format_key_val(_) -> + []. + + +sup_get(Tag, Report) -> + case lists:keysearch(Tag, 1, Report) of + {value, {_, Value}} -> + Value; + _ -> + "" + end. + +maybe_utc(Time) -> + case application:get_env(sasl,utc_log) of + {ok,true} -> + case calendar:local_time_to_universal_time_dst(Time) of + [UTC] -> + {utc,UTC}; + [UTC1,_UTC2] -> + {utc,UTC1}; + [] -> % should not happen + Time + end; + _ -> + Time + end. + +write_head(supervisor_report, Time, Pid) -> + write_head1("SUPERVISOR REPORT", maybe_utc(Time), Pid); +write_head(crash_report, Time, Pid) -> + write_head1("CRASH REPORT", maybe_utc(Time), Pid); +write_head(progress, Time, Pid) -> + write_head1("PROGRESS REPORT", maybe_utc(Time), Pid). + +write_head1(Type, {utc,{{Y,Mo,D},{H,Mi,S}}}, Pid) when node(Pid) /= node() -> + io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC (~p) ===~n", + [Type,D,month(Mo),Y,t(H),t(Mi),t(S),node(Pid)]); +write_head1(Type, {utc,{{Y,Mo,D},{H,Mi,S}}}, _) -> + io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n", + [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]); +write_head1(Type, {{Y,Mo,D},{H,Mi,S}}, Pid) when node(Pid) /= node() -> + io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s (~p) ===~n", + [Type,D,month(Mo),Y,t(H),t(Mi),t(S),node(Pid)]); +write_head1(Type, {{Y,Mo,D},{H,Mi,S}}, _) -> + io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ===~n", + [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]). + +t(X) when is_integer(X) -> + t1(integer_to_list(X)); +t(_) -> + "". +t1([X]) -> [$0,X]; +t1(X) -> X. + +month(1) -> "Jan"; +month(2) -> "Feb"; +month(3) -> "Mar"; +month(4) -> "Apr"; +month(5) -> "May"; +month(6) -> "Jun"; +month(7) -> "Jul"; +month(8) -> "Aug"; +month(9) -> "Sep"; +month(10) -> "Oct"; +month(11) -> "Nov"; +month(12) -> "Dec". diff --git a/lib/sasl/src/sasl_report_file_h.erl b/lib/sasl/src/sasl_report_file_h.erl new file mode 100644 index 0000000000..f4810d31cc --- /dev/null +++ b/lib/sasl/src/sasl_report_file_h.erl @@ -0,0 +1,60 @@ +%% +%% %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% +%% +-module(sasl_report_file_h). + +%%% +%%% A handler that can be connected to the error_logger +%%% event handler. +%%% Writes all sasl_* events formatted to file +%%% + +-export([init/1, + handle_event/2, handle_call/2, handle_info/2, + terminate/2]). + +init({File, Type}) -> + process_flag(trap_exit, true), + case file:open(File, [write]) of + {ok,Fd} -> + {ok, {Fd, File, Type}}; + What -> + What + end. + +handle_event({_Type, GL, _Msg}, State) when node(GL) /= node() -> + {ok, State}; +handle_event(Event, {Fd, File, Type}) -> + sasl_report:write_report(Fd, Type, tag_event(Event)), + {ok, {Fd, File, Type}}; +handle_event(_, State) -> + {ok, State}. + +handle_info({'EXIT', Fd, _Reason}, {Fd, _File, _Type}) -> + remove_handler; +handle_info(_, State) -> + {ok, State}. + +handle_call(_Query, _State) -> {error, bad_query}. + +terminate(_, {Fd, _File, _Type}) -> + file:close(Fd), + []. + +tag_event(Event) -> + {calendar:local_time(), Event}. diff --git a/lib/sasl/src/sasl_report_tty_h.erl b/lib/sasl/src/sasl_report_tty_h.erl new file mode 100644 index 0000000000..064f0471f2 --- /dev/null +++ b/lib/sasl/src/sasl_report_tty_h.erl @@ -0,0 +1,50 @@ +%% +%% %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% +%% +-module(sasl_report_tty_h). + +%%% +%%% A handler that can be connected to the error_logger +%%% event handler. +%%% Writes all sasl_* events formatted to stdout. +%%% + +-export([init/1, + handle_event/2, handle_call/2, handle_info/2, + terminate/2]). + +init(Type) -> +% should link to user (or group_leader???) + {ok, Type}. + +handle_event({Type, GL, _Msg}, Type) when node(GL) /= node() -> + {ok, Type}; +handle_event(Event, Type) -> + sasl_report:write_report(standard_io, Type, tag_event(Event)), + {ok, Type}. + +handle_info(_, Type) -> {ok, Type}. + +handle_call(_Query, _Type) -> {error, bad_query}. + +terminate(_Reason, _Type) -> + []. + +tag_event(Event) -> + {calendar:local_time(), Event}. + diff --git a/lib/sasl/src/si.erl b/lib/sasl/src/si.erl new file mode 100644 index 0000000000..eeed7a9f55 --- /dev/null +++ b/lib/sasl/src/si.erl @@ -0,0 +1,168 @@ +%% +%% %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% +%% +%%----------------------------------------------------------------- +%% l(format_lib_supp), l(si_sasl_supp), l(si), l(si_ms_aos_supp), l(misc_supp). +%% c(format_lib_supp), c(si_sasl_supp), c(si), c(si_ms_aos_supp), c(misc_supp). +%%----------------------------------------------------------------- + + +%%-------------------------------------------------- +%% Description: +%% Status Inspection, main module. +%%-------------------------------------------------- + +-module(si). + + +%% External exports +-export([h/0, help/0, start/0, start/1, start_log/1, stop_log/0, + abbrevs/0, pi/1, pi/2, pi/3, pi/4, ppi/1, ppi/3, stop/0]). + +%% Internal exports +-export([pi_impl/2, test/0]). + + +%%-------------------------------------------------- +%% Table of contents +%% 1. Interface +%% 2. Implementation + + +-import(si_sasl_supp, [status_info/1, make_pid/1, p/1]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 1. Interface +%%-------------------------------------------------- + +h() -> print_help(). +help() -> print_help(). + +start() -> si_sasl_supp:start(). +start(Options) -> si_sasl_supp:start(Options). + +stop() -> si_sasl_supp:stop(). + +start_log(FileName) -> + si_sasl_supp:start_log(FileName). + +stop_log() -> + si_sasl_supp:stop_log(). + +%%%----------------------------------------------------------------- +%%% All functions can be called with an option 'normal' or 'all'; +%%% default is 'normal'. +%%%----------------------------------------------------------------- + +abbrevs() -> + io:format("~p", [lists:append(si_sasl_supp:process_abbrevs(), + process_abbrevs())]). + +%%----------------------------------------------------------------- +%% Process Info that tries to determine processtype (=Module), then +%% it uses this Module:format_info to format data from status_info/1. +%%----------------------------------------------------------------- +pi(XPid) -> + si_sasl_supp:si_exec({si, pi_impl}, [normal, XPid]). + +pi(Opt, XPid) -> + si_sasl_supp:si_exec({si, pi_impl}, [si_sasl_supp:valid_opt(Opt), XPid]). + +pi(A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> + si_sasl_supp:si_exec({si, pi_impl}, [normal, {A, B, C}]). + +pi(Opt, A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> + si_sasl_supp:si_exec({si, pi_impl}, [si_sasl_supp:valid_opt(Opt), {A, B, C}]). + +%%----------------------------------------------------------------- +%% Pretty print Process_Info. +%%----------------------------------------------------------------- +ppi(XPid) -> + si_sasl_supp:ppi(XPid). +ppi(A, B, C) -> + si_sasl_supp:ppi(A, B, C). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 2. Implementation +%%-------------------------------------------------- + +print_help() -> + p("~nStatus Inspection tool - usage"), + p("=============================="), + p(" For all these functions, Opt is an optional argument"), + p(" which can be 'normal' or 'all'; default is 'normal'."), + p(" If 'all', all information will be printed."), + p(" A Pid can be: \"<A.B.C>\", {A, B, C}, B, a registered_name or an abbrev."), + p("ANY PROCESS"), + p("si:pi([Opt,] Pid) - Formatted information about any process that"), + p(" SI recognises."), + p("si:pi([Opt,] A,B,C) - Same as si:pi({A, B, C})."), + p("si:ppi(Pid) - Pretty formating of process_info."), + p(" Works for any process."), + p("MISC"), + p("si:abbrevs() - Lists valid abbreviations."), + p("si:start_log(Filename) - Logging to file."), + p("si:stop_log()"), + p("si:start() - Starts Status Inspection (the si_server)."), + p("si:start([{start_log, FileName}])"), + p("si:stop() - Shut down SI."). + + +%%-------------------------------------------------- +%% Copied (and modified) code from si_sasl_supp. +%%-------------------------------------------------- +pi_impl(Opt, XPid) -> + case make_pid(try_local_expand_abbrev(XPid)) of + Pid when is_pid(Pid) -> + case status_info(Pid) of + {status_info, Pid, {module, Module}, Data} -> + si_sasl_supp:do_best_printout(Opt, Pid, Module, Data); + {error, Reason} -> + si_sasl_supp:ppi_impl(Pid), + {error, {"can not get status info from process:", + XPid, + Reason}}; + Else -> + {error, {"unknown status info", Else}} + end; + {error, Reason} -> + {error, Reason} + end. + +%%-------------------------------------------------- +%% Functions for handling of abbreviations +%%-------------------------------------------------- +try_local_expand_abbrev(Abbrev) -> + case si_sasl_supp:expand_abbrev(Abbrev, process_abbrevs()) of + {value, {_, RealName}} -> RealName; + _ -> Abbrev + end. + +process_abbrevs() -> + []. + +%% Test get_status_info/format_status_info for all implemented servers. +test() -> + lists:foreach(fun test_all_registered/1, + lists:append(si_sasl_supp:process_abbrevs(), + process_abbrevs())). + +test_all_registered({Al, _Ful}) -> + si:pi(all, Al). diff --git a/lib/sasl/src/si_sasl_supp.erl b/lib/sasl/src/si_sasl_supp.erl new file mode 100644 index 0000000000..52dbed2e00 --- /dev/null +++ b/lib/sasl/src/si_sasl_supp.erl @@ -0,0 +1,373 @@ +%% +%% %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% +%% +-module(si_sasl_supp). + +-behaviour(gen_server). + +%%%--------------------------------------------------------------------------- +%%% Description: +%%% This module contains the BOS specific parts of the Status Inspection Tool. +%%%--------------------------------------------------------------------------- + + +%% user interface +-export([h/0, help/0, start_log/1, stop_log/0, abbrevs/0, pi/1, pi/2, pi/3, + pi/4, ppi/1, ppi/3, start/0, start/1, stop/0, start_link/1]). + +%% intermodule exports +-export([make_pid/1, make_pid/3, process_abbrevs/0, expand_abbrev/2, + status_info/1, valid_opt/1, p/1, do_best_printout/4, + si_exec/2, handle_call/3, terminate/2]). + +%% exports for use within module +-export([init/1, start_log_impl/1, pi_impl/2, ppi_impl/1]). + +%% other gen_server callbacks (not used) +-export([handle_cast/2, handle_info/2, code_change/3]). + +%%-------------------------------------------------- +%% Table of contents +%% 1. Interface +%% 2. SI - Server +%% 3. Code +%% 4. Selectors +%%-------------------------------------------------- + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 1. Interface +%% ----------------------------------------------------- + +h() -> print_help(). +help() -> print_help(). + +si_exec(Fun, Args) -> gen_server:call(si_server, {si_exec, Fun, Args}). + +start_log(FileName) -> + gen_server:call(si_server, {start_log, FileName}). + +stop_log() -> + gen_server:call(si_server, stop_log). + +abbrevs() -> + io:format("~p", [process_abbrevs()]). + +%%----------------------------------------------------------------- +%% All functions can be called with an option 'normal' or 'all'; +%% default is 'normal'. +%%----------------------------------------------------------------- +%% Process Info that tries to determine processtype (=Module), then +%% it uses this Module:format_info to format data from status_info/1. +%%----------------------------------------------------------------- +pi(XPid) -> + si_exec({si_sasl_supp, pi_impl}, [normal, XPid]). + +pi(Opt, XPid) -> + si_exec({si_sasl_supp, pi_impl}, [valid_opt(Opt), XPid]). + +pi(A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> + si_exec({si_sasl_supp, pi_impl}, [normal, {A, B, C}]). + +pi(Opt, A, B, C) when is_integer(A), is_integer(B), is_integer(C) -> + si_exec({si_sasl_supp, pi_impl}, [valid_opt(Opt), {A, B, C}]). + +%%----------------------------------------------------------------- +%% Pretty print Process_Info. +%%----------------------------------------------------------------- +ppi(XPid) -> + case whereis(si_server) of + undefined -> % You can always run ppi. + ppi_impl(XPid); % if si_server is down, use standard_io + _ -> + si_exec({si_sasl_supp, ppi_impl}, [XPid]) + end. +ppi(A, B, C) -> + case whereis(si_server) of + undefined -> % You can always run ppi. + ppi_impl({A, B, C}); % if si_server is down, use standard_io + _ -> + si_exec({si_sasl_supp, ppi_impl}, [{A, B, C}]) + end. + + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 2. SI - Server +%%-------------------------------------------------- +-record(state, {}). + +start() -> start([]). +start(Options) -> + supervisor:start_child(sasl_sup, + {si_server, {si_sasl_supp, start_link, [Options]}, + temporary, brutal_kill, worker, [si_sasl_supp]}). + +start_link(_Options) -> + gen_server:start_link({local, si_server}, si_sasl_supp, [], []). + +stop() -> + gen_server:call(si_server, stop), + supervisor:delete_child(sasl_sup, si_server). + + +init(Options) -> + process_flag(trap_exit, true), + start_log_impl(get_option(Options, start_log, standard_io)), + {ok, #state{}}. + +%%----------------------------------------------------------------- +%% If an error occurs and we're logging to file: write the error +%% to the file. +%% Always return the error. +%% The only data held by the si_server is the device in its process dictionary. +%%----------------------------------------------------------------- +handle_call({si_exec, Fun, Args}, _From, State) -> + case catch apply(Fun, Args) of + {'EXIT', Reason} -> + print_error(get(device), + "SI internal error. Reason: ~w~n", + [Reason]), + {stop, shutdown, {internal_error, Reason}, State}; + {error, Reason} -> + print_error(get(device), "~nSI error: ~w~n", [Reason]), + {reply, {error, Reason}, State}; + X -> + {reply, X, State} + end; +handle_call({start_log, FileName}, _From, State) -> + start_log_impl(FileName), + {reply, ok, State}; +handle_call(stop_log, _From, State) -> + start_log_impl(standard_io), + {reply, ok, State}; +handle_call(stop, _From, State) -> + start_log_impl(standard_io), + {stop, normal, stopped, State}. + +terminate(_Reason, _State) -> + close_device(get(device)), + ok. + +handle_cast(_Msg, State) -> + {noreply, State}. +handle_info(_Info, State) -> + {noreply, State}. +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +close_device(standard_io) -> ok; +close_device(Fd) -> file:close(Fd). + +print_error(standard_io, _, _) -> ok; +print_error(Device, Format, Args) -> + io:format(Device, Format, Args). + +get_option(Options, Key, Default) -> + case lists:keysearch(Key, 1, Options) of + {value, {_Key, Value}} -> Value; + _ -> Default + end. + +open_log_file(undefined, NewFile) -> + open_log_file(NewFile); +open_log_file(standard_io, NewFile) -> + open_log_file(NewFile); +open_log_file(OldFile, NewFile) -> + file:close(OldFile), + open_log_file(NewFile). + +open_log_file(standard_io) -> standard_io; +open_log_file(FileName) -> + case file:open(FileName, [write]) of + {ok, Fd} -> Fd; + Error -> + io:format("si_sasl_supp: Cannot open file '~s' (~w).~n", + [FileName, Error]), + io:format("si_sasl_supp: Using standard_io~n"), + standard_io + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% 3. Code +%%-------------------------------------------------- + +%%-------------------------------------------------- +%% Makes a Pid of almost anything. +%% Returns: Pid|{error, Reason} +%% Fails: Never. +%%-------------------------------------------------- +make_pid(A,B,C) when is_integer(A), is_integer(B), is_integer(C) -> + list_to_pid(lists:concat(["<",A,".",B,".",C,">"])). +make_pid(P) when is_pid(P) -> P; +make_pid(undefined) -> undefined; +make_pid(P) when is_atom(P) -> + case whereis(P) of + undefined -> + case expand_abbrev(P, process_abbrevs()) of + {error, Reason} -> {error, Reason}; + {value, {_Abbrev, FullName}} -> + case whereis(FullName) of + undefined -> + {error, {'process not registered', P}}; + Pid -> Pid + end + end; + Pid -> Pid + end; +make_pid(P) when is_list(P) -> list_to_pid(P); +make_pid({A, B, C}) -> make_pid(A, B, C); +make_pid(X) -> {error, {'can not make a pid of', X}}. + +process_abbrevs() -> + [{init, init}, + {fs, file_server}]. + +%%-------------------------------------------------- +%% Args: Abbrevs is an assoc-list of {Abbrev, RealName} +%% Returns: {value, {Abbrev, FullName}}|{error, Reason} +%%-------------------------------------------------- +expand_abbrev(ProcessName, Abbrevs) -> + case lists:keysearch(ProcessName, 1, Abbrevs) of + {value, {Abbrev, FullName}} -> + {value, {Abbrev, FullName}}; + _ -> + case lists:keysearch(ProcessName, 2, Abbrevs) of + {value, {Abbrev, FullName}} -> + {value, {Abbrev, FullName}}; + _ -> + {error, {'invalid process name', ProcessName}} + end + end. + +%%----------------------------------------------------------------- +%% This is the function that actually gets the information out +%% of the agent/server/... +%% Returns: {status_info, Pid, Type, Data} +%% | {error, Reason} +%%----------------------------------------------------------------- +status_info(Pid) when is_pid(Pid) -> + case catch sys:get_status(Pid, 5000) of + {status, Pid, Type, Info} -> + {status_info, Pid, Type, Info}; + _ -> + {error, {'process does not respond', Pid}} + end; + +status_info(X) -> + {error, {'not a pid', X}}. + +%%-------------------------------------------------- +%% Implementation starts here. +%%-------------------------------------------------- +start_log_impl(FileName) -> + put(device, open_log_file(get(device), FileName)). + +valid_opt(all) -> all; +valid_opt(_Opt) -> normal. + + +print_help() -> + p("- - - - - - - - PROCESSES - - - - - - - - - "), + p("si_sasl_supp:pi([Opt,] Pid) - Formatted information about any process that"), + p(" SI recognises."), + p("si_sasl_supp:pi([Opt,] A,B,C) - Same as si_sasl_supp:pi({A, B, C})."), + p("si_sasl_supp:ppi(Pid) - Pretty formating of process_info."), + p(" Works for any process."), + p("- - - - - - - - MISC - - - - - - - - - - - "), + p("si_sasl_supp:abbrevs() - Lists valid abbreviations."), + p("si_sasl_supp:start_log(FileNname)"), + p("si_sasl_supp:stop_log()"), + p("si_sasl_supp:start() - Starts Status Inspection (the si_server)."), + p("si_sasl_supp:start([{start_log, FileName}])"), + p("si_sasl_supp:stop() - Shut down SI."). + + + +%% Convenient shorthand +p(X) -> + io:format(lists:append(X, "~n")). + +pi_impl(Opt, XPid) -> + case make_pid(XPid) of + Pid when is_pid(Pid) -> + case status_info(Pid) of + {status_info, Pid, {module, Module}, Data} -> + do_best_printout(Opt, Pid, Module, Data); + {error, Reason} -> + ppi_impl(Pid), + {error, {"can not get status info from process:", + XPid, + Reason}} + end; + {error, Reason} -> + {error, Reason} + end. + +%%-------------------------------------------------- +%% Is there a format_info for this process? In that case, run it! +%% Return ok|{error, Reason} +%% Fails: Never. +%%-------------------------------------------------- +do_best_printout(Opt, Pid, Mod, Data) when is_pid(Pid) -> + case print_info(get(device), Pid, {Mod, format_status}, Opt, Data) of + ok -> ok; + {error, Reason} -> + ppi_impl(Pid), + {error, Reason} + end. + +ppi_impl(XPid) -> + case make_pid(XPid) of + P when is_pid(P) -> + case process_info(P) of + undefined -> + {error, {'dead process', P}}; + PI -> + Device = case get(device) of + undefined -> standard_io; + X -> X + end, + io:format(Device, "~nPretty Process Info~n", []), + io:format(Device, "-------------------~n", []), + io:format(Device, "~p~n", [PI]) + end; + _ -> {error, {no_pid, XPid}} + end. + +print_info(Device, Pid, {Module, Func}, Opt, Data) -> + case erlang:function_exported(Module, Func, 2) of + true -> + case catch apply({Module, Func}, [Opt, Data]) of + Format when is_list(Format) -> + format_lib_supp:print_info(Device, 79, + add_pid_to_format(Pid, Format)), + ok; + Other -> {error, {'invalid format', Other}} + end; + _ -> + {error, {no_such_function, Module, Func}} + end. + +add_pid_to_format(Pid, [{header, H} | T]) -> + [{header, H}, {data, [{"Pid", Pid}]} | T]; +add_pid_to_format(Pid, List) -> + [{data, [{"Pid", Pid}]} | List]. + + diff --git a/lib/sasl/src/systools.erl b/lib/sasl/src/systools.erl new file mode 100644 index 0000000000..51ef687047 --- /dev/null +++ b/lib/sasl/src/systools.erl @@ -0,0 +1,109 @@ +%% +%% %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% +%% +-module(systools). + +%% Usage: +%% systools:make_script("RelName") +%% Make a boot file from RelName.rel. +%% Generates RelName.{script,boot} +%% systools:make_tar("RelName") +%% Make a release package from RelName.rel. +%% Generates RelName.tar,Z +%% systools:script2boot(File) +%% File.script -> File.boot +%% systools:mk_relup("Target", ["UpFromRel"...], ["DownToRel"...], Opts) +%% Gather all relup scripts to the relup file +%% + +-export([script2boot/1, script2boot/3, compile_rel/3, + make_script/1, make_script/2, + make_tar/1, make_tar/2, + make_relup/3, make_relup/4]). + +-include("erl_compile.hrl"). + +%%% The behaviour_info functions have been moved to erl_internal in stdlib. + +%%----------------------------------------------------------------- +%% Options is a list of {path, Path} | silent | local where path sets +%% the search path, silent supresses error message printing on console, +%% local generates a script with references to the directories there +%% the applications are found. +%%----------------------------------------------------------------- +make_script([RelName|Opts]) when is_atom(RelName) -> + make_script([RelName], Opts); +make_script(RelName) -> make_script(RelName, []). + +make_script(RelName, Opt) -> + systools_make:make_script(RelName, Opt). + +%%----------------------------------------------------------------- +%% Options is a list of {path, Path} | silent | +%% {dirs, [src,include,examples,..]} | {erts, ErtsDir} where path +%% sets the search path, silent supresses error message printing on console, +%% dirs includes the specified directories (per application) in the +%% release package and erts specifies that the erts-Vsn/bin directory +%% should be included in the release package and there it can be found. +%%----------------------------------------------------------------- +make_tar(RelName) -> make_tar(RelName, []). + +make_tar(RelName, Opt) -> + systools_make:make_tar(RelName, Opt). + +%%----------------------------------------------------------------- +%% Create a binary form of a boot script. +%%----------------------------------------------------------------- +script2boot(File) -> + case systools_lib:file_term2binary(File ++ ".script", File ++ ".boot") of + {error,Error} -> + io:format(systools_make:format_error(Error)), + error; + _ -> + ok + end. + +script2boot(File, Output0, _Opt) -> + Input = File++".script", + Output = Output0++".boot", + case systools_lib:file_term2binary(Input, Output) of + {error,Error} -> + io:format(systools_make:format_error(Error)), + error; + _ -> + ok + end. + +%%----------------------------------------------------------------- +%% Options is a list of {path, Path} | silent | noexec where path sets +%% search path, silent supresses error message printing on console, +%% noexec supresses writing the output "relup" file +%%----------------------------------------------------------------- +make_relup(ReleaseName, UpNameList, DownNameList) -> + systools_relup:mk_relup(ReleaseName, UpNameList, DownNameList, []). +make_relup(ReleaseName, UpNameList, DownNameList, Opts) -> + systools_relup:mk_relup(ReleaseName, UpNameList, DownNameList, Opts). + +%%----------------------------------------------------------------- +%% Interface for erl_compile to compile .rel files. +%%----------------------------------------------------------------- +compile_rel(Input, Output, Options) -> + systools_make:make_script(Input, Output, translate_options(Options)). + +translate_options(Opts) -> + [{path, Opts#options.includes}|Opts#options.specific]. diff --git a/lib/sasl/src/systools.hrl b/lib/sasl/src/systools.hrl new file mode 100644 index 0000000000..9a3e98221c --- /dev/null +++ b/lib/sasl/src/systools.hrl @@ -0,0 +1,71 @@ +%% +%% %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% +%% + +%% +%% systools.hrl +%% + +%% this is the structure of a release + +-record(release, + { + name, %% Name of the release, string(). + vsn, %% Version of the release, string(). + erts_vsn, %% Version of erts, string(). + applications, %% [{Name,Vsn,Type}] list of applications incorporated + %% in the release, Name = Type = atom(), + %% Vsn = string(). + incl_apps %% [{Name,[App]}] list of include specifications, + %% (appl Name includes appls [App]), + %% Name = App = atom(). + }). + +-record(application, + {name, %% Name of the application, atom(). + type = permanent, %% Application start type, atom(). + vsn = "", %% Version of the application, string(). + id = "", %% Id of the application, string(). + description = "", %% Description of application, string(). + modules = [], %% [Module | {Module,Vsn}] of modules + %% incorporated in the application, + %% Module = atom(), Vsn = string(). + uses = [], %% [Application] list of applications required + %% by the application, Application = atom(). + includes = [], %% [Application] list of applications included + %% by the application, Application = atom(). + regs = [], %% [RegNames] a list of registered process + %% names used by the application, RegNames = + %% atom(). + env = [], %% [{Key,Value}] environment variable of + %% application, Key = Value = term(). + maxT = infinity, %% Max time an application may exist, + %% integer() | infinity. + maxP = infinity, %% Max number of processes in an application, + %% integer() | infinity. + mod = [], %% [] | {Mod, StartArgs}, Mod= atom(), + %% StartArgs = list(). + start_phases = [], %% [] | {Phase, PhaseArgs}, Phase = atom(), + %% PhaseArgs = list(). + dir = "" %% The directory where the .app file was + %% found (internal use). + }). + + + + diff --git a/lib/sasl/src/systools_lib.erl b/lib/sasl/src/systools_lib.erl new file mode 100644 index 0000000000..b652c109fe --- /dev/null +++ b/lib/sasl/src/systools_lib.erl @@ -0,0 +1,219 @@ +%% +%% %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% +%% +-module(systools_lib). + +%% Purpose : Internal stuff called by systools.erl +%% : Some of this stuff is quite useful and should *eventually* +%% : find its way into the standard libraries +%% + +-export([file_term2binary/2, read_term/1, read_term_from_stream/2, + get_dirs/1, get_path/1]). + +-include_lib("kernel/include/file.hrl"). + +%% reads a single term form a file - convert it to binary and +%% dump it in a file + +file_term2binary(FileIn, FileOut) -> + case read_term(FileIn) of + {ok, Term} -> + file:write_file(FileOut, term_to_binary(Term)), + ok; + Other -> + Other + end. + +%%______________________________________________________________________ +%% read_term(File) -> {ok, Term} | Error + +read_term(File) -> + case file:open(File, [read]) of + {ok, Stream} -> + Res = read_term_from_stream(Stream, File), + file:close(Stream), + Res; + {error, Error} -> + {error, {open,File,Error}} + end. + +read_term_from_stream(Stream, File) -> + R = io:request(Stream, {get_until,'',erl_scan,tokens,[1]}), + case R of + {ok,Toks,_EndLine} -> + case erl_parse:parse_term(Toks) of + {ok, Term} -> + {ok, Term}; + {error, Error} -> + {error, {parse, File, Error}} + end; + {error,_E,_EndLine} -> + {error,{read,File}}; + {eof,_EndLine} -> + {error, {read,File}} + end. + +%%% ---------------------------------------------------- +%%% Expand a directory name given with wildcards (*) +%%% to a list of matching directory names. +%%% The only handled wildcard is '*' which is translated +%%% into the regular expression [^/]* . +%%% If '*' is given as only character between two '/' +%%% it is instead translated into the regular expression +%%% [^/]+ , i.e. where must be at least one character +%%% between two '/'. +%%% +%%% Returns: {ok, Dirs} | {error, What} +%%% ---------------------------------------------------- + +get_dirs(RegPath) when is_list(RegPath) -> + Names = filename:split(RegPath), + ExpNames = expand_names(Names), + catch get_dirs(ExpNames, [], true); +get_dirs(_) -> + {error, badarg}. + +get_path(RegPath) when is_list(RegPath) -> + F = fun(RegP) -> + case get_dirs(RegP) of + {ok, Dirs} -> {true, Dirs}; + _ -> false + end + end, + flat(lists:zf(F, RegPath), []); +get_path(_) -> + []. + +%% +%% expand_names([Name]) -> {true, Name'} | {false, Name} +%% +%% Expand "*" ==> "[^/]+" +%% "...*..." ==> "[^/]*" +%% +%% A single .../*/... is expanded to one or more whatever +%% except a '/' because it is a place holder for a directory. +%% +expand_names(Names) -> + lists:map(fun("*") -> + {true, "[^/]+"}; + (N) -> + case lists:member($*, N) of + true -> {true, expand(N, [])}; + _ -> {false, N} + end + end, Names). + +expand([$*|T], Ack) -> + expand(T, "*]/^[" ++ Ack); %% "[^/]*" +expand([H|T], Ack) -> + expand(T, [H|Ack]); +expand([], Ack) -> + lists:reverse(Ack). + +%% +%% get_dirs(ExpName, FoundSoFar, Root) -> +%% {ok, Dirs} | {error, Error} +%% +%% Use the regular expression RegName to match all +%% directories at a certain level. +%% + +get_dirs([{false,Name}|T], F, Root) -> + get_dirs(T, add_dir(Name, F, Root), false); +get_dirs([{true,RegName}|T], F, Root) -> + get_dirs(T, add_dirs(RegName, F, Root), false); +get_dirs([], F, _) -> + {ok, F}. + +add_dir(Name, [], true) -> %% root + case dir_p(Name) of + true -> [Name]; + _ -> [] + end; +add_dir(Name, Dirs, _Root) -> + lists:zf(fun(D0) -> + D = filename:join(D0, Name), + case dir_p(D) of + true -> {true, D}; + _ -> false + end + end, Dirs). + +add_dirs(RegName, _Dirs, true) -> + case regexp_match(RegName, ".", true) of + {true, AddDirs} -> AddDirs; + _ -> [] + end; +add_dirs(RegName, Dirs, Root) -> + Fun = fun(Dir) -> + regexp_match(RegName, Dir, Root) + end, + flat(lists:zf(Fun, Dirs), []). + +%% +%% Keep all directories (names) matching RegName and +%% create full directory names Dir ++ "/" ++ Name. +%% +%% Called from lists:zf. +%% Returns: {true, [Dir]} | false +%% +regexp_match(RegName, D0, Root) -> + case file:list_dir(D0) of + {ok, Files} when length(Files) > 0 -> + FR = fun(F) -> + case regexp:match(F, RegName) of + {match,1,N} when N == length(F) -> + DirF = join(D0, F, Root), + case dir_p(DirF) of + true -> + {true, DirF}; + _ -> + false + end; + _ -> + false + end + end, + {true,lists:zf(FR, Files)}; + _ -> + false + end. + +%% Only join if not root directory. +join(_, F, true) -> F; +join(Dir, F, _) -> filename:join(Dir, F). + +dir_p(DirF) -> + case file:read_file_info(DirF) of + {ok, Info} when Info#file_info.type==directory -> true; + _ -> false + end. + + +flat([H|T], Ack) when is_list(hd(H)) -> + flat(T, lists:reverse(H) ++ Ack); +flat([[]|T], Ack) -> + flat(T, Ack); +flat([H|T], Ack) -> + flat(T, [H|Ack]); +flat([], Ack) -> + lists:reverse(Ack). + + + diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl new file mode 100644 index 0000000000..20a142c763 --- /dev/null +++ b/lib/sasl/src/systools_make.erl @@ -0,0 +1,2155 @@ +%% +%% %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% +%% +-module(systools_make). + +%% Purpose : Create start script. RelName.rel --> RelName.{script,boot}. +%% and create a tar file of a release (RelName.tar.gz) + +-export([make_script/1, make_script/2, make_script/3, + make_tar/1, make_tar/2]). + +-export([format_error/1, format_warning/1]). + +-export([read_release/2, get_release/2, get_release/3, + get_release/4, pack_app/1]). + +-export([read_application/4]). + +-import(lists, [filter/2, keysort/2, keysearch/3, map/2, reverse/1, + append/1, foldl/3, member/2, foreach/2]). + +-include("systools.hrl"). + +-include_lib("kernel/include/file.hrl"). + +-define(XREF_SERVER, systools_make). + +-compile({inline,[{badarg,2}]}). + +%%----------------------------------------------------------------- +%% Create a boot script from a release file. +%% Options is a list of {path, Path} | silent | local where path sets +%% the search path, silent supresses error message printing on console, +%% local generates a script with references to the directories there +%% the applications are found. +%% +%% New options: {path,Path} can contain wildcards +%% no_module_tests +%% {variables,[{Name,AbsString}]} +%% {machine, jam | beam | vee} +%% exref | {exref, [AppName]} +%%----------------------------------------------------------------- + +make_script(RelName) when is_list(RelName) -> + make_script(RelName, []); +make_script(RelName) -> + badarg(RelName,[RelName]). + +make_script(RelName, Flags) when is_list(RelName), is_list(Flags) -> + case get_outdir(Flags) of + "" -> + make_script(RelName, RelName, Flags); + OutDir -> + %% To maintain backwards compatibility for make_script/3, + %% the boot script file name is constructed here, before + %% checking the validity of OutDir + %% (is done in check_args_script/1) + Output = filename:join(OutDir, filename:basename(RelName)), + make_script(RelName, Output, Flags) + end. + +make_script(RelName, Output, Flags) when is_list(RelName), + is_list(Output), + is_list(Flags) -> + case check_args_script(Flags) of + [] -> + Path0 = get_path(Flags), + Path1 = mk_path(Path0), % expand wildcards etc. + Path = make_set(Path1 ++ code:get_path()), + ModTestP = {not member(no_module_tests, Flags), + xref_p(Flags)}, + case get_release(RelName, Path, ModTestP, machine(Flags)) of + {ok, Release, Appls, Warnings} -> + case generate_script(Output,Release,Appls,Flags) of + ok -> + return(ok,Warnings,Flags); + Error -> + return(Error,Warnings,Flags) + end; + Error -> + return(Error,[],Flags) + end; + ErrorVars -> + badarg(ErrorVars, [RelName, Flags]) + end; + +make_script(RelName, _Output, Flags) when is_list(Flags) -> + badarg(RelName,[RelName, Flags]); +make_script(RelName, _Output, Flags) -> + badarg(Flags,[RelName, Flags]). + +%% Inlined. +badarg(BadArg, Args) -> + erlang:error({badarg,BadArg}, Args). + +machine(Flags) -> + case get_flag(machine,Flags) of + {machine, Machine} when is_atom(Machine) -> Machine; + _ -> false + end. + +get_path(Flags) -> + case get_flag(path,Flags) of + {path,Path} when is_list(Path) -> Path; + _ -> [] + end. + +get_outdir(Flags) -> + case get_flag(outdir,Flags) of + {outdir,OutDir} when is_list(OutDir) -> + OutDir; + _ -> % false | {outdir, Badarg} + "" + end. + +return(ok,Warnings,Flags) -> + case member(silent,Flags) of + true -> + {ok,?MODULE,Warnings}; + _ -> + io:format("~s",[format_warning(Warnings)]), + ok + end; +return({error,Mod,Error},_,Flags) -> + case member(silent,Flags) of + true -> + {error,Mod,Error}; + _ -> + io:format("~s",[Mod:format_error(Error)]), + error + end. + +%%----------------------------------------------------------------- +%% Create a release package from a release file. +%% Options is a list of {path, Path} | silent | +%% {dirs, [src,include,examples,..]} | {erts, ErtsDir} where path +%% sets the search path, silent supresses error message printing, +%% dirs includes the specified directories (per application) in the +%% release package and erts specifies that the erts-Vsn/bin directory +%% should be included in the release package and there it can be found. +%% +%% New options: {path,Path} can contain wildcards +%% no_module_tests +%% exref | {exref, [AppName]} +%% {variables,[{Name,AbsString}]} +%% {machine, jam | beam | vee} +%% {var_tar, include | ownfile | omit} +%% +%% The tar file contains: +%% lib/App-Vsn/ebin +%% /priv +%% [/src] +%% [/include] +%% [/doc] +%% [/examples] +%% [/...] +%% Variable1.tar.gz +%% ... +%% VariableN.tar.gz +%% releases/RelName.rel +%% RelVsn/start.boot +%% relup +%% sys.config +%% erts-EVsn[/bin] +%%----------------------------------------------------------------- + +make_tar(RelName) when is_list(RelName) -> + make_tar(RelName, []); +make_tar(RelName) -> + badarg(RelName,[RelName]). + +make_tar(RelName, Flags) when is_list(RelName), is_list(Flags) -> + case check_args_tar(Flags) of + [] -> + Path0 = get_path(Flags), + Path1 = mk_path(Path0), + Path = make_set(Path1 ++ code:get_path()), + ModTestP = {not member(no_module_tests, Flags), + xref_p(Flags)}, + case get_release(RelName, Path, ModTestP, machine(Flags)) of + {ok, Release, Appls, Warnings} -> + case catch mk_tar(RelName, Release, Appls, Flags, Path1) of + ok -> + return(ok,Warnings,Flags); + Error -> + return(Error,Warnings,Flags) + end; + Error -> + return(Error,[],Flags) + end; + ErrorVars -> + badarg(ErrorVars, [RelName, Flags]) + end; +make_tar(RelName, Flags) when is_list(Flags) -> + badarg(RelName,[RelName, Flags]); +make_tar(RelName, Flags) -> + badarg(Flags,[RelName, Flags]). + +%%______________________________________________________________________ +%% get_release(File, Path) -> +%% get_release(File, Path, ModTestP) -> +%% get_release(File, Path, ModTestP, Machine) -> +%% {ok, #release, [{{Name,Vsn},#application}], Warnings} | {error, What} + +get_release(File, Path) -> + get_release(File, Path, true, false). + +get_release(File, Path, ModTestP) -> + get_release(File, Path, ModTestP, false). + +get_release(File, Path, ModTestP, Machine) -> + case catch get_release1(File, Path, ModTestP, Machine) of + {error, Error} -> + {error, ?MODULE, Error}; + {'EXIT', Why} -> + {error, ?MODULE, {'EXIT',Why}}; + Answer -> + Answer + end. + +get_release1(File, Path, ModTestP, Machine) -> + {ok, Release} = read_release(File, Path), + {ok, Appls0} = collect_applications(Release, Path), + {ok, Appls1} = check_applications(Appls0), + {ok, Appls2} = sort_included_applications(Appls1, Release), % OTP-4121 + {ok, Warnings} = check_modules(Appls2, Path, ModTestP, Machine), + {ok, Appls} = sort_appls(Appls2), + {ok, Release, Appls, Warnings}. + +%%______________________________________________________________________ +%% read_release(File, Path) -> {ok, #release} | throw({error, What}) + +read_release(File, Path) -> + case read_file(File ++ ".rel", ["."|Path]) of + {ok, Release, _FullName} -> + check_rel(Release); + {error,Error} -> + throw({error,?MODULE,Error}) + end. + +check_rel(Release) -> + case catch check_rel1(Release) of + {ok, {Name,Vsn,Evsn,Appl,Incl}} -> + {ok, #release{name=Name, vsn=Vsn, + erts_vsn=Evsn, + applications=Appl, + incl_apps=Incl}}; + {error, Error} -> + throw({error,?MODULE,Error}); + Error -> + throw({error,?MODULE,Error}) + end. + +check_rel1({release,{Name,Vsn},{erts,EVsn},Appl}) when is_list(Appl) -> + check_name(Name), + check_vsn(Vsn), + check_evsn(EVsn), + {Appls,Incls} = check_appl(Appl), + {ok, {Name,Vsn,EVsn,Appls,Incls}}; +check_rel1(_) -> + {error, badly_formatted_release}. + +check_name(Name) -> + case string_p(Name) of + true -> + Name; + _ -> + throw({error,{illegal_name, Name}}) + end. + +check_vsn(Vsn) -> + case string_p(Vsn) of + true -> + Vsn; + _ -> + throw({error,{illegal_form, Vsn}}) + end. + +check_evsn(Vsn) -> + case string_p(Vsn) of + true -> + Vsn; + _ -> + throw({error,{illegal_form, {erts,Vsn}}}) + end. + +check_appl(Appl) -> + case filter(fun({App,Vsn}) when is_atom(App) -> + not string_p(Vsn); + ({App,Vsn,Incl}) when is_atom(App), is_list(Incl) -> + case {string_p(Vsn), a_list_p(Incl)} of + {true, true} -> false; + _ -> true + end; + ({App,Vsn,Type}) when is_atom(App), is_atom(Type) -> + case {string_p(Vsn), is_app_type(Type)} of + {true, true} -> false; + _ -> true + end; + ({App,Vsn,Type,Incl}) when is_atom(App), + is_atom(Type), + is_list(Incl) -> + case {string_p(Vsn),is_app_type(Type),a_list_p(Incl)} of + {true, true, true} -> false; + _ -> true + end; + (_) -> + true + end, + Appl) of + [] -> + mandatory_applications(Appl), + split_app_incl(Appl); + Illegal -> + throw({error, {illegal_applications,Illegal}}) + end. + +mandatory_applications(Appl) -> + AppNames = map(fun(AppT) -> element(1, AppT) end, + Appl), + Mand = mandatory_applications(), + case filter(fun(X) -> member(X, AppNames) end, Mand) of + Mand -> + ok; + _ -> + throw({error, {missing_mandatory_app, Mand}}) + end. + +mandatory_applications() -> + [kernel, stdlib]. + +split_app_incl(Appl) -> split_app_incl(Appl, [], []). + +split_app_incl([{App,Vsn}|Appls], Apps, Incls) -> + split_app_incl(Appls, [{App,Vsn,permanent}|Apps], Incls); +split_app_incl([{App,Vsn,Incl}|Appls], Apps,Incls) when is_list(Incl) -> + split_app_incl(Appls, [{App,Vsn,permanent}|Apps], [{App,Incl}|Incls]); +split_app_incl([{App,Vsn,Type}|Appls], Apps, Incls) -> + split_app_incl(Appls, [{App,Vsn,Type}|Apps], Incls); +split_app_incl([{App,Vsn,Type,Incl}|Appls], Apps, Incls) when is_list(Incl) -> + split_app_incl(Appls, [{App,Vsn,Type}|Apps], [{App,Incl}|Incls]); +split_app_incl([], Apps, Incls) -> + {reverse(Apps),reverse(Incls)}. + +%%______________________________________________________________________ +%% collect_applications(#release, Path) -> +%% {ok,[{{Name,Vsn},#application}]} | +%% throw({error, What}) +%% Read all the application files specified in the release descriptor + +collect_applications(Release, Path) -> + Appls = Release#release.applications, + Incls = Release#release.incl_apps, + X = foldl(fun({Name,Vsn,Type}, {Ok, Errs}) -> + case read_application(to_list(Name), Vsn, Path, Incls) of + {ok, A} -> + case {A#application.name,A#application.vsn} of + {Name,Vsn} -> + {[{{Name,Vsn}, A#application{type=Type}} | Ok], + Errs}; + E -> + {Ok, [{bad_application_name, {Name, E}} | Errs]} + end; + {error, What} -> + {Ok, [{error_reading, {Name, What}} | Errs]} + end + end, {[],[]}, Appls), + case X of + {A, []} -> + {ok, reverse(A)}; + {_, Errs} -> + throw({error, Errs}) + end. + + +%%______________________________________________________________________ +%% read_application(Name, Vsn, Path, Incls) -> {ok, #release} | {error, What} + +read_application(Name, Vsn, Path, Incls) -> + read_application(Name, Vsn, Path, Incls, false, no_fault). + +read_application(Name, Vsn, [Dir|Path], Incls, Found, FirstError) -> + case read_file(Name ++ ".app", [Dir]) of + {ok, Term, FullName} -> + case parse_application(Term, FullName, Vsn, Incls) of + {error, {no_valid_version, {Vsn, OtherVsn}}} when FirstError == no_fault -> + NFE = {no_valid_version, {{"should be", Vsn}, + {"found file", filename:join(Dir, Name++".app"), + OtherVsn}}}, + read_application(Name, Vsn, Path, Incls, true, NFE); + {error, {no_valid_version, {Vsn, _OtherVsn}}} -> + read_application(Name, Vsn, Path, Incls, true, FirstError); + Res -> + Res + end; + {error, {parse, _File, {Line, _Mod, Err}}} when FirstError == no_fault -> + read_application(Name, Vsn, Path, Incls, Found, + {parse_error, {filename:join(Dir, Name++".app"), Line, Err}}); + {error, {parse, _File, _Err}} -> + read_application(Name, Vsn, Path, Incls, Found, FirstError); + {error, _Err} -> %% Not found + read_application(Name, Vsn, Path, Incls, Found, FirstError) + end; +read_application(Name, Vsn, [], _, true, no_fault) -> + {error, {application_vsn, {Name,Vsn}}}; +read_application(_Name, _Vsn, [], _, true, FirstError) -> + {error, FirstError}; +read_application(Name, _, [], _, _, no_fault) -> + {error, {not_found, Name ++ ".app"}}; +read_application(_Name, _, [], _, _, FirstError) -> + {error, FirstError}. + +parse_application({application, Name, Dict}, File, Vsn, Incls) + when is_atom(Name), + is_list(Dict) -> + Items = [vsn,id,description,modules,registered, + applications,included_applications,mod,start_phases,env,maxT,maxP], + case catch get_items(Items, Dict) of + [Vsn,Id,Desc,Mods,Regs,Apps,Incs0,Mod,Phases,Env,MaxT,MaxP] -> + case override_include(Name, Incs0, Incls) of + {ok, Incs} -> + {ok, #application{name=Name, + vsn=Vsn, + id=Id, + description=Desc, + modules=Mods, + uses=Apps, + includes=Incs, + regs=Regs, + mod=Mod, + start_phases=Phases, + env=Env, + maxT=MaxT, + maxP=MaxP, + dir=filename:dirname(File)}}; + {error, IncApps} -> + {error, {override_include, IncApps}} + end; + [OtherVsn,_,_,_,_,_,_,_,_,_,_,_] -> + {error, {no_valid_version, {Vsn, OtherVsn}}}; + Err -> + {error, {Err, {application, Name, Dict}}} + end; +parse_application(Other, _, _, _) -> + {error, {badly_formatted_application, Other}}. + +%% Test if all included applications specifed in the .rel file +%% exists in the {included_applications,Incs} specified in the +%% .app file. +override_include(Name, Incs, Incls) -> + case keysearch(Name, 1, Incls) of + {value, {Name, I}} -> + case specified(I, Incs) of + [] -> + {ok, I}; + NotSpec -> + {error, NotSpec} + end; + _ -> + {ok, Incs} + end. + +specified([App|Incls], Spec) -> + case member(App, Spec) of + true -> + specified(Incls, Spec); + _ -> + [App|specified(Incls, Spec)] + end; +specified([], _) -> + []. + +get_items([H|T], Dict) -> + Item = check_item(keysearch(H, 1, Dict),H), + [Item|get_items(T, Dict)]; +get_items([], _Dict) -> + []. + +check_item({_,{mod,{M,A}}},_) when is_atom(M) -> + {M,A}; +check_item({_,{vsn,Vsn}},I) -> + case string_p(Vsn) of + true -> Vsn; + _ -> throw({bad_param, I}) + end; +check_item({_,{id,Id}},I) -> + case string_p(Id) of + true -> Id; + _ -> throw({bad_param, I}) + end; +check_item({_,{description,Desc}},I) -> + case string_p(Desc) of + true -> Desc; + _ -> throw({bad_param, I}) + end; +check_item({_,{applications,Apps}},I) -> + case a_list_p(Apps) of + true -> Apps; + _ -> throw({bad_param, I}) + end; +check_item({_,{included_applications,Apps}},I) -> + case a_list_p(Apps) of + true -> Apps; + _ -> throw({bad_param, I}) + end; +check_item({_,{registered,Regs}},I) -> + case a_list_p(Regs) of + true -> Regs; + _ -> throw({bad_param, I}) + end; +check_item({_,{modules,Mods}},I) -> + case mod_list_p(Mods) of + true -> Mods; + _ -> throw({bad_param, I}) + end; +check_item({_,{start_phases,Phase}},I) -> + case t_list_p(Phase) of + true -> Phase; + _ -> throw({bad_param, I}) + end; +check_item({_,{env,Env}},I) -> + case t_list_p(Env) of + true -> Env; + _ -> throw({bad_param, I}) + end; +check_item({_,{maxT,MaxT}},I) -> + case MaxT of + MaxT when is_integer(MaxT), MaxT > 0 -> MaxT; + infinity -> infinity; + _ -> throw({bad_param, I}) + end; +check_item({_,{maxP,MaxP}},I) -> + case MaxP of + MaxP when is_integer(MaxP), MaxP > 0 -> MaxP; + infinity -> infinity; + _ -> throw({bad_param, I}) + end; +check_item(false, included_applications) -> % optional ! + []; +check_item(false, mod) -> % mod is optional ! + []; +check_item(false, env) -> % env is optional ! + []; +check_item(false, id) -> % id is optional ! + []; +check_item(false, start_phases) -> % start_phases is optional ! + undefined; +check_item(false, maxT) -> % maxT is optional ! + infinity; +check_item(false, maxP) -> % maxP is optional ! + infinity; +check_item(_, Item) -> + throw({missing_param, Item}). + +%%______________________________________________________________________ +%% check_applications([{{Name,Vsn},#application}]) -> +%% ok | throw({error, Error}) +%% check that all referenced applications exists and that no +%% application register processes with the same name. +%% Check that included_applications are not specified as used +%% in another application. + +check_applications(Appls) -> + undef_appls(Appls), + dupl_regs(Appls), + %% Make a list Incs = [{Name,App,AppVsn,Dir}] + Incs = [{IncApp,App,Appv,A#application.dir} || + {{App,Appv},A} <- Appls, + IncApp <- A#application.includes], + dupl_incls(Incs), + Res = add_top_apps_to_uses(Incs, Appls, []), + {ok, Res}. + + + +undef_appls(Appls) -> + case undefined_applications(Appls) of + [] -> + ok; + L -> + throw({error, {undefined_applications, make_set(L)}}) + end. + +dupl_regs(Appls) -> + %% Make a list Regs = [{Name,App,AppVsn,Dir}] + Regs = [{Name,App,Appv,A#application.dir} || + {{App,Appv},A} <- Appls, + Name <- A#application.regs], + case duplicates(Regs) of + [] -> + ok; + Dups -> + throw({error, {duplicate_register, Dups}}) + end. + + +dupl_incls(Incs) -> + case duplicates(Incs) of + [] -> + ok; + Dups -> + throw({error, {duplicate_include, Dups}}) + end. + + + +%% If an application uses another application which is included in yet +%% another application, e.g. X uses A, A is included in T; then the A +%% application in the X applications uses-variable is changed to the T +%% application's top application to ensure the start order. +%% Exception: if both X and A have the same top, then it is not +%% added to avoid circular dependencies. +%% +%% add_top_apps_to_uses( list of all included applications in +%% the system, +%% list of all applications in the system, +%% temporary result) +%% -> new list of all applications +add_top_apps_to_uses(_InclApps, [], Res) -> + %% InclApps = [{IncApp, App, AppVsn, Dir}] + Res; +add_top_apps_to_uses(InclApps, [{Name,Appl} | Appls], Res) -> + MyTop = find_top_app(Appl#application.name, InclApps), + F = fun(UsedApp, AccIn) when UsedApp == MyTop -> + %% UW980513 This is a special case: The included app + %% uses its own top app. We'll allow it, but must + %% remove the top app from the uses list. + AccIn -- [MyTop]; + (UsedApp, AccIn) -> + case lists:keysearch(UsedApp, 1, InclApps) of + false -> + AccIn; + {value, {_,DependApp,_,_}} -> + UsedAppTop = find_top_app(DependApp, InclApps), + case {lists:member(UsedAppTop, AccIn), MyTop} of + {true, _} -> + %% the top app is already in the uses + %% list, remove UsedApp + AccIn -- [UsedApp]; + {_, UsedAppTop} -> + %% both are included in the same app + AccIn; + _ -> + %% change the used app to the used app's + %% top application + AccIn1 = AccIn -- [UsedApp], + AccIn1 ++ [UsedAppTop] + end + end + end, + + NewUses = foldl(F, Appl#application.uses, Appl#application.uses), + add_top_apps_to_uses(InclApps, Appls, + Res++[{Name, Appl#application{uses = NewUses}}]). + + + +find_top_app(App, InclApps) -> + case lists:keysearch(App, 1, InclApps) of + false -> + App; + {value, {_,TopApp,_,_}} -> + find_top_app(TopApp, InclApps) + end. + + + +%%______________________________________________________________________ +%% undefined_applications([{{Name,Vsn},#application}]) -> +%% [Name] list of applications that were declared in +%% use declarations but are not contained in the release descriptor + +undefined_applications(Appls) -> + Uses = append(map(fun({_,A}) -> + A#application.uses ++ A#application.includes + end, Appls)), + Defined = map(fun({{X,_},_}) -> X end, Appls), + filter(fun(X) -> not member(X, Defined) end, Uses). + +%%______________________________________________________________________ +%% sort_included_applications(Applications, Release) -> Applications +%% Applications = [{{Name,Vsn},#application}] +%% Release = #release{} +%% +%% Check that included applications are given in the same order as in +%% the release resource file (.rel). Otherwise load instructions in +%% the boot script, and consequently release upgrade instructions in +%% relup, may end up in the wrong order. + +sort_included_applications(Applications, Release) when is_tuple(Release) -> + {ok, + sort_included_applications(Applications, Release#release.applications)}; + +sort_included_applications([{Tuple,Appl}|Appls], OrderedAppls) -> + case Appl#application.includes of + Incls when length(Incls)>1 -> + IndexedIncls = find_pos(Incls, OrderedAppls), + SortedIndexedIncls = lists:keysort(1, IndexedIncls), + Incls2 = lists:map(fun({_Index,Name}) -> Name end, + SortedIndexedIncls), + Appl2 = Appl#application{includes=Incls2}, + [{Tuple,Appl2}|sort_included_applications(Appls, OrderedAppls)]; + _Incls -> + [{Tuple,Appl}|sort_included_applications(Appls, OrderedAppls)] + end; +sort_included_applications([], _OrderedAppls) -> + []. + +find_pos([Name|Incs], OrderedAppls) -> + [find_pos(1, Name, OrderedAppls)|find_pos(Incs, OrderedAppls)]; +find_pos([], _OrderedAppls) -> + []. + +find_pos(N, Name, [{Name,_Vsn,_Type}|_OrderedAppls]) -> + {N, Name}; +find_pos(N, Name, [_OtherAppl|OrderedAppls]) -> + find_pos(N+1, Name, OrderedAppls). + +%%______________________________________________________________________ +%% check_modules(Appls, Path, TestP, Machine) -> +%% {ok, Warnings} | throw({error, What}) +%% where Appls = [{App,Vsn}, #application}] +%% performs logical checking that we can find all the modules +%% etc. + +check_modules(Appls, Path, TestP, Machine) -> + %% first check that all the module names are unique + %% Make a list M1 = [{Mod,Vsn,App,AppVsn,Dir}] + %% where Vsn = '$$ignore$$' | Specified + M1 = [{Mod,Vsn,App,Appv,A#application.dir} || + {{App,Appv},A} <- Appls, + {Mod,Vsn} <- get_mod_vsn(A#application.modules)], + case duplicates(M1) of + [] -> + case check_mods(M1, Appls, Path, TestP, Machine) of + {error, Errors} -> + throw({error, {modules, Errors}}); + Return -> + Return + end; + Dups -> +% io:format("** ERROR Duplicate modules: ~p\n", [Dups]), + throw({error, {duplicate_modules, Dups}}) + end. + +get_mod_vsn([{Mod,Vsn}|Mods]) -> + [{Mod,Vsn}|get_mod_vsn(Mods)]; +get_mod_vsn([Mod|Mods]) -> + [{Mod,'$$ignore$$'}|get_mod_vsn(Mods)]; +get_mod_vsn([]) -> + []. + +%%______________________________________________________________________ +%% Check that all modules exists and that the specified version +%% corresponds to the version in the module's source code. +%% Use the module extension of the running machine as extension for +%% the checked modules. + +check_mods(Modules, Appls, Path, {true, XrefP}, Machine) -> + Ext = objfile_extension(Machine), + IncPath = create_include_path(Appls, Path), + Res = append(map(fun(ModT) -> + {Mod,_Vsn,App,_,Dir} = ModT, + case check_mod(Mod,App,Dir,Ext,IncPath) of + ok -> + []; + {error, Error} -> + [{error,{Error, ModT}}]; + {warning, Warn} -> + [{warning,{Warn,ModT}}] + end + end, + Modules)), + Res2 = Res ++ check_xref(Appls, Path, XrefP), + case filter(fun({error, _}) -> true; + (_) -> false + end, + Res2) of + [] -> + {ok, filter(fun({warning, _}) -> true; + (_) -> false + end, + Res2)}; + Errors -> + {error, Errors} + end; +check_mods(_, _, _, _, _) -> + {ok, []}. + +check_xref(_Appls, _Path, false) -> + []; +check_xref(Appls, Path, XrefP) -> + AppDirsL = [{App,A#application.dir} || {{App,_Appv},A} <- Appls], + AppDirs0 = sofs:relation(AppDirsL), + AppDirs = case XrefP of + true -> + AppDirs0; + {true, Apps} -> + sofs:restriction(AppDirs0, sofs:set(Apps)) + end, + XrefArgs = [{xref_mode, modules}], + case catch xref:start(?XREF_SERVER, XrefArgs) of + {ok, _Pid} -> + ok; + {error, {already_started, _Pid}} -> + xref:stop(?XREF_SERVER), %% Clear out any previous data + xref:start(?XREF_SERVER, XrefArgs) + end, + {ok, _} = xref:set_default(?XREF_SERVER, verbose, false), + LibPath = case Path == code:get_path() of + true -> code_path; % often faster + false -> Path + end, + ok = xref:set_library_path(?XREF_SERVER, LibPath), + check_xref(sofs:to_external(AppDirs)). + +check_xref([{App,AppDir} | Appls]) -> + case xref:add_application(?XREF_SERVER, AppDir, {name,App}) of + {ok, _App} -> + check_xref(Appls); + Error -> + xref:stop(?XREF_SERVER), + [{error, Error}] + end; +check_xref([]) -> + R = case xref:analyze(?XREF_SERVER, undefined_functions) of + {ok, []} -> + []; + {ok, Undefined} -> + %% This clause is a (temporary?) fix for hipe. + adjust_for_hipe(Undefined); + Error -> + [{error, Error}] + end, + xref:stop(?XREF_SERVER), + R. + +adjust_for_hipe(Undef) -> + case erlang:system_info(hipe_architecture) of + undefined -> + U = lists:filter(fun ({hipe_bifs,_,_}) -> false; + ({hipe,_,_}) -> false; + (_) -> true + end, Undef), + if + [] == U -> + []; + true -> + [{warning, {exref_undef, U}}] + end; + _Arch -> + %% Some BIFs are not always available on all versions of HiPE. + U = lists:filter(fun ({hipe_bifs,write_u64,2}) -> false; + (_) -> true + end, Undef), + [{warning, {exref_undef, U}}] + end. + +%% Perform cross reference checks between all modules specified +%% in .app files. +%% +xref_p(Flags) -> + case member(exref, Flags) of + true -> + exists_xref(true); + _ -> + case get_flag(exref, Flags) of + {exref, Appls} when is_list(Appls) -> + case a_list_p(Appls) of + true -> exists_xref({true, Appls}); + _ -> false + end; + _ -> + false + end + end. + +exists_xref(Flag) -> + case code:ensure_loaded(xref) of + {error, _} -> false; + _ -> Flag + end. + +objfile_extension(false) -> + code:objfile_extension(); +objfile_extension(Machine) -> + "." ++ atom_to_list(Machine). + +check_mod(Mod,App,Dir,Ext,IncPath) -> + ObjFile = mod_to_filename(Dir, Mod, Ext), + case file:read_file_info(ObjFile) of + {ok,FileInfo} -> + LastModTime = FileInfo#file_info.mtime, + check_module(Mod, Dir, LastModTime, IncPath); + _ -> + {error, {module_not_found, App, Mod}} + end. + +mod_to_filename(Dir, Mod, Ext) -> + Parts = packages:split(Mod), + filename:join([Dir | Parts]) ++ Ext. + +check_module(Mod, Dir, ObjModTime, IncPath) -> + {SrcDirs,_IncDirs}= smart_guess(Mod, Dir,IncPath), + case locate_src(Mod,SrcDirs) of + {ok,_FDir,_File,LastModTime} -> + if + LastModTime > ObjModTime -> + {warning, obj_out_of_date}; + true -> + ok + end; + _ -> + {warning, source_not_found} + end. + +locate_src(Mod,[Dir|Dirs]) -> + File = filename:join(Dir, mod_to_fname(Mod) ++ ".erl"), + case file:read_file_info(File) of + {ok,FileInfo} -> + LastModTime = FileInfo#file_info.mtime, + {ok,Dir,File,LastModTime}; + _ -> + locate_src(Mod,Dirs) + end; +locate_src(_,[]) -> + false. + +mod_to_fname(Mod) -> + hd(lists:reverse(packages:split(Mod))). + + +%%______________________________________________________________________ +%% smart_guess(Mod, Dir,IncludePath) -> {[Dirs],[IncDirs]} +%% Guess the src code and include directory. If dir contains .../ebin +%% src-dir should be one of .../src or .../src/e_src +%% If dir does not contain .../ebin set dir to the same directory. + +smart_guess(Mod, Dir,IncPath) -> + case reverse(filename:split(Dir)) of + ["ebin"|D] -> + Subdirs = case packages:split(Mod) of + [_] -> []; + [_|_] = Parts -> + lists:reverse(tl(lists:reverse(Parts))) + end, + D1 = reverse(D), + Dirs = [filename:join(D1 ++ ["src" | Subdirs]), + filename:join(D1 ++ ["src", "e_src" | Subdirs])], + {Dirs,Dirs ++ IncPath}; + _ -> + {[Dir],[Dir] ++ IncPath} + end. + +%%______________________________________________________________________ +%% generate_script(#release, +%% [{{Name,Vsn},#application}], Flags) -> +%% ok | {error, Error} +%% Writes a script (a la magnus) to the file File.script +%% and a bootfile to File.boot. + +generate_script(Output, Release, Appls, Flags) -> + PathFlag = path_flag(Flags), + Variables = get_variables(Flags), + Preloaded = preloaded(), + Mandatory = mandatory_modules(), + Script = {script, {Release#release.name,Release#release.vsn}, + [{preLoaded, Preloaded}, + {progress, preloaded}, + {path, create_mandatory_path(Appls, PathFlag, Variables)}, + {primLoad, Mandatory}, + {kernel_load_completed}, + {progress, kernel_load_completed}] ++ + load_appl_mods(Appls, Mandatory ++ Preloaded, + PathFlag, Variables) ++ + [{path, create_path(Appls, PathFlag, Variables)}] ++ + create_kernel_procs(Appls) ++ + create_load_appls(Appls) ++ + create_start_appls(Appls) ++ + script_end() + }, + + ScriptFile = Output ++ ".script", + case file:open(ScriptFile, [write]) of + {ok, Fd} -> + io:format(Fd, "%% script generated at ~w ~w\n~p.\n", + [date(), time(), Script]), + file:close(Fd), + + BootFile = Output ++ ".boot", + case file:write_file(BootFile, term_to_binary(Script)) of + ok -> + ok; + {error, Reason} -> + {error, ?MODULE, {open,BootFile,Reason}} + end; + {error, Reason} -> + {error, ?MODULE, {open,ScriptFile,Reason}} + end. + +path_flag(Flags) -> + case {member(local,Flags), member(otp_build, Flags)} of + {true, _} -> local; + {_, true} -> otp_build; + {_, _} -> true + end. + +get_variables(Flags) -> + case get_flag(variables, Flags) of + {variables, Variables} when is_list(Variables) -> + valid_variables(Variables); + _ -> + [] + end. + +valid_variables([{Var,Path}|Variables]) when is_list(Var), is_list(Path) -> + [{Var,rm_tlsl(Path)}|valid_variables(Variables)]; +valid_variables([{Var,Path}|Variables]) when is_atom(Var), is_list(Path) -> + [{to_list(Var),rm_tlsl(Path)}|valid_variables(Variables)]; +valid_variables([_|Variables]) -> + valid_variables(Variables); +valid_variables(_) -> + []. + +rm_tlsl(P) -> rm_tlsl1(reverse(P)). +rm_tlsl1([$/|P]) -> rm_tlsl1(P); +rm_tlsl1(P) -> reverse(P). + +%%______________________________________________________________________ +%% Start all applications. +%% Do not start applications that are included applications ! + +create_start_appls(Appls) -> + Included = append(map(fun({_,A}) -> + A#application.includes + end, Appls)), + create_start_appls(Appls, Included). + +create_start_appls([{_,A}|T], Incl) -> + App = A#application.name, + case lists:member(App, Incl) of + false when A#application.type == none -> + create_start_appls(T, Incl); + false when A#application.type == load -> + create_start_appls(T, Incl); + false -> + [{apply, {application, start_boot, [App,A#application.type]}} | + create_start_appls(T, Incl)]; + _ -> + create_start_appls(T, Incl) + end; +create_start_appls([], _) -> + []. + +%%______________________________________________________________________ +%% Load all applications. + +create_load_appls([{{kernel,_},_}|T]) -> %Already added !! + create_load_appls(T); +create_load_appls([{_,A}|T]) when A#application.type == none -> + create_load_appls(T); +create_load_appls([{_,A}|T]) -> + [{apply, {application, load, [pack_app(A)]}} | + create_load_appls(T)]; +create_load_appls([]) -> + [{progress, applications_loaded}]. + +%%______________________________________________________________________ +%% The final part of the script. + +script_end() -> + [{apply, {c, erlangrc, []}}, + {progress, started}]. + +%%----------------------------------------------------------------- +%% Function: sort_appls(Appls) -> {ok, Appls'} | throw({error, Error}) +%% Types: Appls = {{Name, Vsn}, #application}] +%% Purpose: Sort applications according to dependencies among +%% applications. If order doesn't matter, use the same +%% order as in the original list. +%% Alg. written by Ulf Wiger 970917 ([email protected]) +%% Mod. by mbj +%%----------------------------------------------------------------- +sort_appls(Appls) -> {ok, sort_appls(Appls, [], [], [])}. + +sort_appls([{N, A}|T], Missing, Circular, Visited) -> + {Name,_Vsn} = N, + {Uses, T1, NotFnd1} = find_all(Name, A#application.uses, T, Visited, [], []), + {Incs, T2, NotFnd2} = find_all(Name, lists:reverse(A#application.includes), + T1, Visited, [], []), + Missing1 = NotFnd1 ++ NotFnd2 ++ Missing, + case Uses ++ Incs of + [] -> + %% No more app that must be started before this one is + %% found; they are all already taken care of (and present + %% in Visited list) + [{N, A}|sort_appls(T, Missing1, Circular, [N|Visited])]; + L -> + %% The apps in L must be started before the app. + %% Check if we have already taken care of some app in L, + %% in that case we have a circular dependency. + NewCircular = [N1 || {N1, _} <- L, N2 <- Visited, N1 == N2], + Circular1 = case NewCircular of + [] -> Circular; + _ -> [N | NewCircular] ++ Circular + end, + %% L must be started before N, try again, with all apps + %% in L added before N. + Apps = del_apps(NewCircular, L ++ [{N, A}|T2]), + sort_appls(Apps, Missing1, Circular1, [N|Visited]) + end; +sort_appls([], [], [], _) -> + []; +sort_appls([], Missing, [], _) -> + %% this has already been checked before, but as we have the info... + throw({error, {undefined_applications, make_set(Missing)}}); +sort_appls([], [], Circular, _) -> + throw({error, {circular_dependencies, make_set(Circular)}}); +sort_appls([], Missing, Circular, _) -> + throw({error, {apps, [{circular_dependencies, make_set(Circular)}, + {undefined_applications, make_set(Missing)}]}}). + +find_all(CheckingApp, [Name|T], L, Visited, Found, NotFound) -> + case find_app(Name, L) of + {value, App} -> + {_A,R} = App, + %% It is OK to have a dependecy like + %% X includes Y, Y uses X. + case lists:member(CheckingApp, R#application.includes) of + true -> + case lists:keymember(Name, 1, Visited) of + true -> + find_all(CheckingApp, T, L, Visited, Found, NotFound); + false -> + find_all(CheckingApp, T, L, Visited, Found, [Name|NotFound]) + end; + false -> + find_all(CheckingApp, T, L -- [App], Visited, [App|Found], NotFound) + end; + false -> + case lists:keymember(Name, 1, Visited) of + true -> + find_all(CheckingApp, T, L, Visited, Found, NotFound); + false -> + find_all(CheckingApp, T, L, Visited, Found, [Name|NotFound]) + end + end; +find_all(_CheckingApp, [], L, _Visited, Found, NotFound) -> + {Found, L, NotFound}. + +find_app(Name, [{{Name,Vsn}, Application}|_]) -> + {value, {{Name,Vsn},Application}}; +find_app(Name, [_|T]) -> + find_app(Name, T); +find_app(_Name, []) -> + false. + +del_apps([Name|T], L) -> + del_apps(T, lists:keydelete(Name, 1, L)); +del_apps([], L) -> + L. + + +%%______________________________________________________________________ +%% Create the load path used in the generated script. +%% If PathFlag is true a script intended to be used as a complete +%% system (e.g. in an embbeded system), i.e. all applications are +%% located under $ROOT/lib. +%% Otherwise all paths are set according to dir per application. + +%% Create the complete path. +create_path(Appls, PathFlag, Variables) -> + make_set(map(fun({{Name,Vsn},App}) -> + cr_path(Name, Vsn, App, PathFlag, Variables) + end, + Appls)). + +%% Create the path to a specific application. +%% (The otp_build flag is only used for OTP internal system make) +cr_path(Name, Vsn, _, true, []) -> + filename:join(["$ROOT", "lib", to_list(Name) ++ "-" ++ Vsn, "ebin"]); +cr_path(Name, Vsn, App, true, Variables) -> + Dir = App#application.dir, + N = to_list(Name), + Tail = [N ++ "-" ++ Vsn, "ebin"], + case variable_dir(Dir, N, Vsn, Variables) of + {ok, VarDir} -> + filename:join([VarDir] ++ Tail); + _ -> + filename:join(["$ROOT", "lib"] ++ Tail) + end; +cr_path(Name, _, _, otp_build, _) -> + filename:join(["$ROOT", "lib", to_list(Name), "ebin"]); +cr_path(_, _, App, _, _) -> + filename:absname(App#application.dir). + +variable_dir(Dir, Name, Vsn, [{Var,Path}|Variables]) -> + case lists:prefix(Path,Dir) of + true -> + D0 = strip_prefix(Path, Dir), + case strip_name_ebin(D0, Name, Vsn) of + {ok, D} -> + {ok, filename:join(["\$" ++ Var] ++ D)}; + _ -> + %% We know at least that we are located + %% under the variable dir. + {ok, filename:join(["\$" ++ Var] ++ D0)} + end; + _ -> + variable_dir(Dir, Name, Vsn, Variables) + end; +variable_dir(_Dir, _, _, []) -> + false. + +strip_prefix(Path, Dir) -> + L = length(filename:split(Path)), + lists:nthtail(L, filename:split(Dir)). + +strip_name_ebin(Dir, Name, Vsn) -> + FullName = Name ++ "-" ++ Vsn, + case reverse(Dir) of + ["ebin",Name|D] -> {ok, reverse(D)}; + ["ebin",FullName|D] -> {ok, reverse(D)}; + _ -> false + end. + +%% Create the path to the kernel and stdlib applications. +create_mandatory_path(Appls, PathFlag, Variables) -> + Dirs = [kernel, stdlib], + make_set(map(fun({{Name,Vsn}, A}) -> + case lists:member(Name, Dirs) of + true -> + cr_path(Name, Vsn, A, PathFlag, Variables); + _ -> + "" + end + end, + Appls)). + +%%______________________________________________________________________ +%% Load all modules, except those in Mandatory_modules. + +load_appl_mods([{{Name,Vsn},A}|Appls], Mand, PathFlag, Variables) -> + Mods = map(fun({Mod,_}) -> Mod; + (Mod) -> Mod + end, + A#application.modules), + load_commands(filter(fun(Mod) -> not member(Mod, Mand) end, Mods), + cr_path(Name, Vsn, A, PathFlag, Variables)) ++ + load_appl_mods(Appls, Mand, PathFlag, Variables); +% [{path, [cr_path(Name, Vsn, A, PathFlag, Variables)]}, +% {primLoad, filter(fun(Mod) -> not member(Mod, Mand) end, Mods)} | +% load_appl_mods(Appls, Mand, PathFlag, Variables)]; +load_appl_mods([], _, _, _) -> + [{progress, modules_loaded}]. + +load_commands(Mods, Path) -> + SplitMods = lists:foldl( + fun({Parts,M}, [{Last, Acc}|Rest]) -> + [_|Tail] = lists:reverse(Parts), + case lists:reverse(Tail) of + Subs when Subs == Last -> + [{Last,[M|Acc]}|Rest]; + Subs -> + [{Subs, [M]}|[{Last,Acc}|Rest]] + end + end, [{[],[]}], + lists:sort([{packages:split(M),M} || M <- Mods])), + lists:foldl( + fun({Subs,Ms}, Cmds) -> + [{path, [filename:join([Path | Subs])]}, + {primLoad,lists:sort(Ms)} | Cmds] + end, [], SplitMods). + + +%%______________________________________________________________________ +%% Pack an application to an application term. + +pack_app(#application{name=Name,vsn=V,id=Id,description=D,modules=M, + uses=App,includes=Incs,regs=Regs,mod=Mod,start_phases=SF, + env=Env,maxT=MaxT,maxP=MaxP}) -> + {application, Name, + [{description,D}, + {vsn,V}, + {id,Id}, + {modules, M}, + {registered, Regs}, + {applications, App}, + {included_applications, Incs}, + {env, Env}, + {start_phases, SF}, + {maxT, MaxT}, + {maxP, MaxP} | + behave(Mod)]}. + +behave([]) -> + []; +behave(Mod) -> + [{mod, Mod}]. + +%%______________________________________________________________________ +%% mandatory modules; this modules must be loaded before processes +%% can be started. These are a collection of modules from the kernel +%% and stdlib applications. +%% Nowadays, error_handler dynamically loads almost every module. +%% The error_handler self must still be there though. + +mandatory_modules() -> + %% Sorted + [error_handler]. + +%%______________________________________________________________________ +%% This is the modules that are preloaded into the Erlang system. + +preloaded() -> + %% Sorted + [erl_prim_loader,erlang,init,otp_ring0,prim_file,prim_inet, prim_zip,zlib]. + +%%______________________________________________________________________ +%% Kernel processes; processes that are specially treated by the init +%% process. If a kernel process terminates the whole system terminates. +%% kernel_processes() -> [{Name, Mod, Func, Args}] +%% where Args is a term or a fun taking the list of applications as arg. + +kernel_processes() -> + [{heart, heart, start, []}, + {error_logger, error_logger, start_link, []}, + {application_controller, application_controller, start, + fun(Appls) -> + [{_,App}] = filter(fun({{kernel,_},_App}) -> true; + (_) -> false + end, + Appls), + [pack_app(App)] + end} + ]. + +%%______________________________________________________________________ +%% Create the kernel processes. + +create_kernel_procs(Appls) -> + map(fun({Name,Mod,Func,Args}) when is_function(Args) -> + {kernelProcess, Name, {Mod, Func, Args(Appls)}}; + ({Name,Mod,Func,Args}) -> + {kernelProcess, Name, {Mod, Func, Args}} + end, + kernel_processes()) ++ + [{progress, init_kernel_started}]. + +%%______________________________________________________________________ +%% Make a tar file of the release. +%% The tar file contains: +%% lib/App-Vsn/ebin +%% /priv +%% [/src] +%% [/include] +%% [/doc] +%% [/examples] +%% [/...] +%% Variable1.tar.gz +%% ... +%% VariableN.tar.gz +%% releases/RelName.rel +%% RelVsn/start.boot +%% relup +%% sys.config +%% erts-EVsn[/bin] +%% +%% The VariableN.tar.gz files can also be stored as own files not +%% included in the main tar file or they can be omitted using +%% the var_tar option. + +mk_tar(RelName, Release, Appls, Flags, Path1) -> + TarName = case get_outdir(Flags) of + "" -> + RelName ++ ".tar.gz"; + OutDir -> + filename:join(OutDir, filename:basename(RelName)) + ++ ".tar.gz" + end, + Tar = open_main_tar(TarName), + case catch mk_tar(Tar, RelName, Release, Appls, Flags, Path1) of + {error,Error} -> + del_tar(Tar, TarName), + {error,?MODULE,Error}; + {'EXIT',Reason} -> + del_tar(Tar, TarName), + {error,?MODULE,Reason}; + _ -> + close_tar(Tar), + ok + end. + +open_main_tar(TarName) -> + case catch open_tar(TarName) of + {error, Error} -> + throw({error,?MODULE,Error}); + Tar -> + Tar + end. + +mk_tar(Tar, RelName, Release, Appls, Flags, Path1) -> + Variables = get_variables(Flags), + add_applications(Appls, Tar, Variables, Flags, false), + add_variable_tars(Variables, Appls, Tar, Flags), + add_system_files(Tar, RelName, Release, Path1), + add_erts_bin(Tar, Release, Flags). + +add_applications(Appls, Tar, Variables, Flags, Var) -> + Res = foldl(fun({{Name,Vsn},App}, Errs) -> + case catch add_appl(to_list(Name), Vsn, App, + Tar, Variables, Flags, Var) of + ok -> + Errs; + {error, What} -> + [{error_add_appl, {Name,What}}|Errs] + end + end, [], Appls), + case Res of + [] -> + ok; + Errors -> + throw({error, Errors}) + end. + +%%______________________________________________________________________ +%% Create a tar file for each Variable directory. +%% Deletes the temporary tar file. + +add_variable_tars([Variable|Variables], Appls, Tar, Flags) -> + add_variable_tar(Variable, Appls, Tar, Flags), + add_variable_tars(Variables, Appls, Tar, Flags); +add_variable_tars([], _, _, _) -> + ok. + +add_variable_tar({Variable,P}, Appls, Tar, Flags) -> + case var_tar_flag(Flags) of + omit -> + ok; + Flag -> + TarName = Variable ++ ".tar.gz", + VarTar = open_tar(TarName), + case catch add_applications(Appls, VarTar, [{Variable,P}], + Flags, Variable) of + ok when Flag == include -> + close_tar(VarTar), + add_to_tar(Tar, TarName, TarName), + del_file(TarName); + ok when Flag == ownfile -> + close_tar(VarTar), + ok; + Error -> + del_tar(VarTar, TarName), + throw(Error) + end + end. + +var_tar_flag(Flags) -> + case get_flag(var_tar, Flags) of + {var_tar, Flag} -> + case member(Flag, [include, ownfile, omit]) of + true -> Flag; + _ -> include + end; + _ -> + include + end. + +%%______________________________________________________________________ +%% Add all "other" files to Dir/releases/Svsn +%% add_system_files(Tar,Name,release#,Flags) -> +%% ok | throw({error,Error}) + +add_system_files(Tar, RelName, Release, Path1) -> + SVsn = Release#release.vsn, + RelName0 = filename:basename(RelName), + + add_to_tar(Tar, RelName ++ ".rel", + filename:join("releases", RelName0 ++ ".rel")), + + %% OTP-6226 Look for the system files not only in cwd + %% -- + %% (well, actually the boot file was looked for in the same + %% directory as RelName, which is not necessarily the same as cwd) + %% -- + %% but also in the path specfied as an option to systools:make_tar + %% (but make sure to search the RelName directory and cwd first) + Path = case filename:dirname(RelName) of + "." -> + ["."|Path1]; + RelDir -> + [RelDir, "."|Path1] + end, + + ToDir = filename:join("releases", SVsn), + case lookup_file(RelName0 ++ ".boot", Path) of + false -> + throw({error, {tar_error,{add, RelName0++".boot",enoent}}}); + Boot -> + add_to_tar(Tar, Boot, filename:join(ToDir, "start.boot")) + end, + + case lookup_file("relup", Path) of + false -> + ignore; + Relup -> + add_to_tar(Tar, Relup, filename:join(ToDir, "relup")) + end, + + case lookup_file("sys.config", Path) of + false -> + ignore; + Sys -> + add_to_tar(Tar, Sys, filename:join(ToDir, "sys.config")) + end, + + ok. + +lookup_file(Name, [Dir|Path]) -> + File = filename:join(Dir, Name), + case filelib:is_file(File) of + true -> + File; + false -> + lookup_file(Name, Path) + end; +lookup_file(_Name, []) -> + false. + +%%______________________________________________________________________ +%% Add either a application located under a variable dir or all other +%% applications to a tar file. +%% add_appl(Name,Vsn,application#,Tar,Variables,Flags,Var) -> +%% ok | {error,Error} + +add_appl(Name, Vsn, App, Tar, Variables, Flags, Var) -> + AppDir = App#application.dir, + case add_to(AppDir,Name,Vsn,Variables,Var) of + false -> + ok; + {ok, ToDir} -> + ADir = appDir(AppDir), + add_priv(ADir, ToDir, Tar), + case get_flag(dirs,Flags) of + {dirs,Dirs} -> + add_dirs(ADir, Dirs, ToDir, Tar); + _ -> + ok + end, + BinDir = filename:join(ToDir, "ebin"), + add_to_tar(Tar, + filename:join(AppDir, Name ++ ".app"), + filename:join(BinDir, Name ++ ".app")), + add_modules(map(fun({Mod,_}) -> to_list(Mod); + (Mod) -> to_list(Mod) + end, + App#application.modules), + Tar, + AppDir, + BinDir, + objfile_extension(machine(Flags))) + end. + +%%______________________________________________________________________ +%% If an application directory contains a Variable (in AppDir) the +%% application will be placed in the tar file (if it is this Variable +%% we corrently is actually storing). + +add_to(AppDir,Name,Vsn,Variables,Variable) -> + case var_dir(AppDir,Name,Vsn,Variables) of + {ok, Variable, RestPath} -> + {ok, filename:join(RestPath ++ [Name ++ "-" ++ Vsn])}; + {ok, _, _} -> + false; + _ when Variable == false -> + {ok, filename:join("lib", Name ++ "-" ++ Vsn)}; + _ -> + false + end. + +var_dir(Dir, Name, Vsn, [{Var,Path}|Variables]) -> + case lists:prefix(Path,Dir) of + true -> + D0 = strip_prefix(Path, Dir), + case strip_name_ebin(D0, Name, Vsn) of + {ok, D} -> + {ok, Var, D}; + _ -> + false + end; + _ -> + var_dir(Dir, Name, Vsn, Variables) + end; +var_dir(_Dir, _, _, []) -> + false. + +appDir(AppDir) -> + case reverse(filename:split(AppDir)) of + ["ebin"|Dir] -> filename:join(reverse(Dir)); + _ -> AppDir + end. + +add_modules(Modules, Tar, AppDir, ToDir, Ext) -> + foreach(fun(Mod) -> + add_to_tar(Tar, + filename:join(AppDir, Mod ++ Ext), + filename:join(ToDir, Mod ++ Ext)) + end, Modules). + +%% +%% Add own specified directories to include in the release. +%% If not found, skip it. +%% +add_dirs(AppDir, Dirs, ToDir, Tar) -> + foreach(fun(Dir) -> catch add_dir(AppDir, to_list(Dir), ToDir, Tar) end, + Dirs). + +add_dir(TopDir, Dir, ToDir, Tar) -> + FromD = filename:join(TopDir, Dir), + case dirp(FromD) of + true -> + add_to_tar(Tar, FromD, filename:join(ToDir, Dir)); + _ -> + ok + end. + +%% +%% Add the priv dir if it exists. + +add_priv(ADir, ToDir, Tar) -> + Priv = filename:join(ADir, "priv"), + case dirp(Priv) of + true -> + add_to_tar(Tar, Priv, filename:join(ToDir, "priv")); + _ -> + ok + end. + +add_erts_bin(Tar, Release, Flags) -> + case get_flag(erts,Flags) of + {erts,ErtsDir} -> + EVsn = Release#release.erts_vsn, + FromDir = filename:join([to_list(ErtsDir), + "erts-" ++ EVsn, "bin"]), + dirp(FromDir), + ToDir = filename:join("erts-" ++ EVsn, "bin"), + add_to_tar(Tar, FromDir, ToDir); + _ -> + ok + end. + +%%______________________________________________________________________ +%% Tar functions. + +open_tar(TarName) -> + case erl_tar:open(TarName, [write, compressed]) of + {ok, Tar} -> + Tar; + {error, Error} -> + throw({error,{tar_error, {open, TarName, Error}}}) + end. + +close_tar(Tar) -> + erl_tar:close(Tar). + +del_tar(Tar, TarName) -> + close_tar(Tar), + del_file(TarName). + +add_to_tar(Tar, FromFile, ToFile) -> + case erl_tar:add(Tar, FromFile, ToFile, [compressed, dereference]) of + ok -> ok; + {error, Error} -> + throw({error, {tar_error, {add, FromFile, Error}}}) + end. + +%%______________________________________________________________________ +%%______________________________________________________________________ +%% utilities! + +make_set([]) -> []; +make_set([""|T]) -> % Ignore empty items. + make_set(T); +make_set([H|T]) -> + [H | [ Y || Y<- make_set(T), + Y =/= H]]. + +to_list(A) when is_atom(A) -> atom_to_list(A); +to_list(L) -> L. + +mk_path(Path0) -> + Path1 = map(fun(Dir) when is_atom(Dir) -> atom_to_list(Dir); + (Dir) -> Dir + end, Path0), + systools_lib:get_path(Path1). + +%% duplicates([Tuple]) -> List of pairs where +%% element(1, T1) == element(1, T2) and where T1 and T2 are +%% taken from [Tuple] + +duplicates(X) -> duplicates(keysort(1,X), []). + +duplicates([H1,H2|T], L) -> + case {element(1,H1),element(1,H2)} of + {X,X} -> duplicates([H2|T],[{H1,H2}|L]); + _ -> duplicates([H2|T],L) + end; +duplicates(_, L) -> L. + +%% read_file(File, Path) -> {ok, Term, FullName} | {error, Error} +%% read a file and check the syntax, i.e. that it contains a correct +%% Erlang term. + +read_file(File, Path) -> + case file:path_open(Path, File, [read]) of + {ok, Stream, FullName} -> + Return = case systools_lib:read_term_from_stream(Stream, File) of + {ok, Term} -> + {ok, Term, FullName}; + Other -> + Other + end, + file:close(Stream), + Return; + _Other -> + {error, {not_found, File}} + end. + +del_file(File) -> file:delete(File). + +dirp(Dir) -> + case file:read_file_info(Dir) of + {ok, FileInfo} -> FileInfo#file_info.type == directory; + _ -> false + end. + +%% Create the include path. Assumptions about the code path is done +%% and an include directory is added. +%% Add the official include dir for each found application first in +%% path !! +%% If .../ebin exists in a path an .../include directory is assumed to +%% exist at the same level. If .../ebin is not existing the .../include +%% directory is assumed anyhow. +%% Local includes are added for each application later on. + +create_include_path(Appls, Path) -> + FoundAppDirs = map(fun({_,A}) -> A#application.dir end, Appls), + map(fun(Dir) -> + case reverse(filename:split(Dir)) of + ["ebin"|D] -> + filename:join(reverse(D) ++ ["include"]); + _ -> + filename:join(Dir, "include") + end + end, + FoundAppDirs ++ no_dupl(Path, FoundAppDirs)). + +no_dupl([Dir|Path], FoundAppDirs) -> + case member(Dir, FoundAppDirs) of + true -> + no_dupl(Path, FoundAppDirs); + _ -> + [Dir|no_dupl(Path, FoundAppDirs)] + end; +no_dupl([], _) -> + []. + +is_app_type(permanent) -> true; +is_app_type(transient) -> true; +is_app_type(temporary) -> true; +is_app_type(none) -> true; +is_app_type(load) -> true; +is_app_type(_) -> false. + +% check if a term is a string. + +string_p([H|T]) when is_integer(H), H >= $ , H < 255 -> + string_p(T); +string_p([$\n|T]) -> string_p(T); +string_p([$\r|T]) -> string_p(T); +string_p([$\t|T]) -> string_p(T); +string_p([$\v|T]) -> string_p(T); +string_p([$\b|T]) -> string_p(T); +string_p([$\f|T]) -> string_p(T); +string_p([$\e|T]) -> string_p(T); +string_p([]) -> true; +string_p(_) -> false. + +% check if a term is a list of two tuples with the first +% element as an atom. + +t_list_p([{A,_}|T]) when is_atom(A) -> t_list_p(T); +t_list_p([]) -> true; +t_list_p(_) -> false. + +% check if a term is a list of atoms or two-tuples with the first +% element as an atom. + +mod_list_p([{A,_}|T]) when is_atom(A) -> mod_list_p(T); +mod_list_p([A|T]) when is_atom(A) -> mod_list_p(T); +mod_list_p([]) -> true; +mod_list_p(_) -> false. + +% check if a term is a list of atoms. + +a_list_p([A|T]) when is_atom(A) -> a_list_p(T); +a_list_p([]) -> true; +a_list_p(_) -> false. + +%% Get a key-value tuple flag from a list. + +get_flag(F,[{F,D}|_]) -> {F,D}; +get_flag(F,[_|Fs]) -> get_flag(F,Fs); +get_flag(_,_) -> false. + +%% Check Options for make_script +check_args_script(Args) -> + cas(Args, + {undef, undef, undef, undef, undef, undef, undef, undef, []}). + +cas([], {_Path,_Sil,_Loc,_Test,_Var,_Mach,_Xref,_XrefApps, X}) -> + X; +%%% path --------------------------------------------------------------- +cas([{path, P} | Args], {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) when is_list(P) -> + case check_path(P) of + ok -> + cas(Args, {P, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X}); + error -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + X++[{path,P}]}) + end; +%%% silent ------------------------------------------------------------- +cas([silent | Args], {Path, _Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) -> + cas(Args, {Path, silent, Loc, Test, Var, Mach, Xref, XrefApps, X}); +%%% local -------------------------------------------------------------- +cas([local | Args], {Path, Sil, _Loc, Test, Var, Mach, + Xref, XrefApps, X}) -> + cas(Args, {Path, Sil, local, Test, Var, Mach, Xref, XrefApps, X}); +%%% no_module_tests ---------------------------------------------------- +cas([no_module_tests | Args], {Path, Sil, Loc, _Test, Var, Mach, + Xref, XrefApps, X}) -> + cas(Args, + {Path, Sil, Loc, no_module_tests, Var, Mach, Xref, XrefApps,X}); +%%% variables ---------------------------------------------------------- +cas([{variables, V} | Args], {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) when is_list(V) -> + case check_vars(V) of + ok -> + cas(Args, + {Path, Sil, Loc, Test, V, Mach, Xref, XrefApps, X}); + error -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, + X++[{variables, V}]}) + end; +%%% machine ------------------------------------------------------------ +cas([{machine, M} | Args], {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) when is_atom(M) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +%%% exref -------------------------------------------------------------- +cas([exref | Args], {Path, Sil, Loc, Test, Var, Mach, + _Xref, XrefApps, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, exref, XrefApps, X}); +%%% exref Apps --------------------------------------------------------- +cas([{exref, Apps} | Args], {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) when is_list(Apps) -> + case check_apps(Apps) of + ok -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, + Xref, Apps, X}); + error -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X++[{exref, Apps}]}) + end; +%%% outdir Dir --------------------------------------------------------- +cas([{outdir, Dir} | Args], {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) when is_list(Dir) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +%%% otp_build (secret, not documented) --------------------------------- +cas([otp_build | Args], {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +%%% ERROR -------------------------------------------------------------- +cas([Y | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X++[Y]}). + + + +%% Check Options for make_tar +check_args_tar(Args) -> + cat(Args, {undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, []}). + +cat([], {_Path,_Sil,_Dirs,_Erts,_Test,_Var,_VarTar,_Mach,_Xref,_XrefApps, X}) -> + X; +%%% path --------------------------------------------------------------- +cat([{path, P} | Args], {Path, Sil, Dirs, Erts, Test, + Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(P) -> + case check_path(P) of + ok -> + cat(Args, {P, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); + error -> + cat(Args, {Path, Sil, Dirs, Erts, Test, + Var, VarTar, Mach, Xref, XrefApps, X++[{path,P}]}) + end; +%%% silent ------------------------------------------------------------- +cat([silent | Args], {Path, _Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> + cat(Args, {Path, silent, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +%%% dirs --------------------------------------------------------------- +cat([{dirs, D} | Args], {Path, Sil, Dirs, Erts, Test, + Var, VarTar, Mach, Xref, XrefApps, X}) -> + case check_dirs(D) of + ok -> + cat(Args, {Path, Sil, D, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); + error -> + cat(Args, {Path, Sil, Dirs, Erts, Test, + Var, VarTar, Mach, Xref, XrefApps, X++[{dirs, D}]}) + end; +%%% erts --------------------------------------------------------------- +cat([{erts, E} | Args], {Path, Sil, Dirs, _Erts, Test, + Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(E)-> + cat(Args, {Path, Sil, Dirs, E, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +%%% no_module_tests ---------------------------------------------------- +cat([no_module_tests | Args], {Path, Sil, Dirs, Erts, _Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> + cat(Args, {Path, Sil, Dirs, Erts, no_module_tests, Var, VarTar, Mach, + Xref, XrefApps, X}); +%%% variables ---------------------------------------------------------- +cat([{variables, V} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(V) -> + case check_vars(V) of + ok -> + cat(Args, {Path, Sil, Dirs, Erts, Test, V, VarTar, Mach, Xref, XrefApps, X}); + error -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, + Xref, XrefApps, X++[{variables, V}]}) + end; +%%% var_tar ------------------------------------------------------------ +cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, + Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == include -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, include, Mach, Xref, XrefApps, X}); +cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, + Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == ownfile -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, ownfile, Mach, Xref, XrefApps, X}); +cat([{var_tar, VT} | Args], {Path, Sil, Dirs, Erts, Test, + Var, _VarTar, Mach, Xref, XrefApps, X}) when VT == omit -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, omit, Mach, Xref, XrefApps, X}); +%%% machine ------------------------------------------------------------ +cat([{machine, M} | Args], {Path, Sil, Dirs, Erts, Test, + Var, VarTar, Mach, Xref, XrefApps, X}) when is_atom(M) -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +%%% exref -------------------------------------------------------------- +cat([exref | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, _Xref, XrefApps, X}) -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, exref, XrefApps, X}); +%%% exref Apps --------------------------------------------------------- +cat([{exref, Apps} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Apps) -> + case check_apps(Apps) of + ok -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, + Xref, Apps, X}); + error -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, + Xref, XrefApps, X++[{exref, Apps}]}) + end; +%%% outdir Dir --------------------------------------------------------- +cat([{outdir, Dir} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(Dir) -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, + Xref, XrefApps, X}); +%%% otp_build (secret, not documented) --------------------------------- +cat([otp_build | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +%%% ERROR -------------------------------------------------------------- +cat([Y | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X++[Y]}). + +check_path([]) -> + ok; +check_path([H|T]) when is_list(H) -> + check_path(T); +check_path([_H|_T]) -> + error. + +check_dirs([]) -> + ok; +check_dirs([H|T]) when is_atom(H) -> + check_dirs(T); +check_dirs([_H|_T]) -> + error. + +check_vars([]) -> + ok; +check_vars([{Name, Dir} | T]) -> + if + is_atom(Name), is_list(Dir) -> + check_vars(T); + is_list(Name), is_list(Dir) -> + check_vars(T); + true -> + error + end; +check_vars(_) -> + error. + +check_apps([]) -> + ok; +check_apps([H|T]) when is_atom(H) -> + check_apps(T); +check_apps(_) -> + error. + + +%% Format error + +format_error(badly_formatted_release) -> + io_lib:format("Syntax error in the release file~n",[]); +format_error({illegal_name, Name}) -> + io_lib:format("Illegal name (~p) in the release file~n",[Name]); +format_error({illegal_form, Form}) -> + io_lib:format("Illegal tag in the release file: ~p~n",[Form]); +format_error({missing_parameter,Par}) -> + io_lib:format("Missing parameter (~p) in the release file~n",[Par]); +format_error({illegal_applications,Names}) -> + io_lib:format("Illegal applications in the release file: ~p~n", + [Names]); +format_error({missing_mandatory_app,Names}) -> + io_lib:format("Mandatory applications (~p) must be specified in the release file~n", + [Names]); +format_error({duplicate_register,Dups}) -> + io_lib:format("Duplicated register names: ~n~s", + [map(fun({{Reg,App1,_,_},{Reg,App2,_,_}}) -> + io_lib:format("\t~p registered in ~p and ~p~n", + [Reg,App1,App2]) + end, Dups)]); +format_error({undefined_applications,Apps}) -> + io_lib:format("Undefined applications: ~p~n",[Apps]); +format_error({duplicate_modules,Dups}) -> + io_lib:format("Duplicated modules: ~n~s", + [map(fun({{Mod,_,App1,_,_},{Mod,_,App2,_,_}}) -> + io_lib:format("\t~p specified in ~p and ~p~n", + [Mod,App1,App2]) + end, Dups)]); +format_error({included_and_used, Dups}) -> + io_lib:format("Applications both used and included: ~p~n",[Dups]); +format_error({duplicate_include, Dups}) -> + io_lib:format("Duplicated application included: ~n~s", + [map(fun({{Name,App1,_,_},{Name,App2,_,_}}) -> + io_lib:format("\t~p included in ~p and ~p~n", + [Name,App1,App2]) + end, Dups)]); +format_error({modules,ModErrs}) -> + format_errors(ModErrs); +format_error({circular_dependencies,Apps}) -> + io_lib:format("Circular dependencies among applications: ~p~n",[Apps]); +format_error({not_found,File}) -> + io_lib:format("File not found: ~p~n",[File]); +format_error({parse,File,{Line,Mod,What}}) -> + Str = Mod:format_error(What), + io_lib:format("~s:~p: ~s\n",[File, Line, Str]); +format_error({read,File}) -> + io_lib:format("Cannot read ~p~n",[File]); +format_error({open,File,Error}) -> + io_lib:format("Cannot open ~p - ~s~n", + [File,file:format_error(Error)]); +format_error({tar_error,What}) -> + form_tar_err(What); +format_error(ListOfErrors) when is_list(ListOfErrors) -> + format_errors(ListOfErrors); +format_error(E) -> io_lib:format("~p~n",[E]). + +format_errors(ListOfErrors) -> + map(fun({error,E}) -> form_err(E); + (E) -> form_err(E) + end, ListOfErrors). + +form_err({bad_application_name,{Name,Found}}) -> + io_lib:format("~p: Mismatched application id: ~p~n",[Name,Found]); +form_err({error_reading, {Name, What}}) -> + io_lib:format("~p: ~s~n",[Name,form_reading(What)]); +form_err({module_not_found,App,Mod}) -> + io_lib:format("~p: Module (~p) not found~n",[App,Mod]); +form_err({{vsn_diff,File},{Mod,Vsn,App,_,_}}) -> + io_lib:format("~p: Module (~p) version (~p) differs in file ~p~n", + [App,Mod,Vsn,File]); +form_err({error_add_appl, {Name, {tar_error, What}}}) -> + io_lib:format("~p: ~s~n",[Name,form_tar_err(What)]); +form_err(E) -> + io_lib:format("~p~n",[E]). + +form_reading({not_found,File}) -> + io_lib:format("File not found: ~p~n",[File]); +form_reading({application_vsn, {Name,Vsn}}) -> + io_lib:format("Application ~s with version ~p not found~n",[Name, Vsn]); +form_reading({parse,File,{Line,Mod,What}}) -> + Str = Mod:format_error(What), + io_lib:format("~s:~p: ~s\n",[File, Line, Str]); +form_reading({read,File}) -> + io_lib:format("Cannot read ~p~n",[File]); +form_reading({{bad_param, P},_}) -> + io_lib:format("Bad parameter in .app file: ~p~n",[P]); +form_reading({{missing_param,P},_}) -> + io_lib:format("Missing parameter in .app file: ~p~n",[P]); +form_reading({badly_formatted_application,_}) -> + io_lib:format("Syntax error in .app file~n",[]); +form_reading({override_include,Apps}) -> + io_lib:format("Tried to include not (in .app file) specified applications: ~p~n", + [Apps]); +form_reading({no_valid_version, {{_, SVsn}, {_, File, FVsn}}}) -> + io_lib:format("No valid version (~p) of .app file found. Found file ~p with version ~p~n", + [SVsn, File, FVsn]); +form_reading({parse_error, {File, Line, Error}}) -> + io_lib:format("Parse error in file: ~p. Line: ~p Error: ~p; ~n", [File, Line, Error]); +form_reading(W) -> + io_lib:format("~p~n",[W]). + +form_tar_err({open, File, Error}) -> + io_lib:format("Cannot open tar file ~s - ~p~n", + [File, erl_tar:format_error(Error)]); +form_tar_err({add, File, Error}) -> + io_lib:format("Cannot add file ~s to tar file - ~s~n", + [File, erl_tar:format_error(Error)]). + +%% Format warning + +format_warning(Warnings) -> + map(fun({warning,W}) -> form_warn(W) end, Warnings). + +form_warn({source_not_found,{Mod,_,App,_,_}}) -> + io_lib:format("*WARNING* ~p: Source code not found: ~p.erl~n", + [App,Mod]); +form_warn({{parse_error, File},{_,_,App,_,_}}) -> + io_lib:format("*WARNING* ~p: Parse error: ~p~n", + [App,File]); +form_warn({obj_out_of_date,{Mod,_,App,_,_}}) -> + io_lib:format("*WARNING* ~p: Object code (~p) out of date~n",[App,Mod]); +form_warn({exref_undef, Undef}) -> + F = fun({M,F,A}) -> + io_lib:format("*WARNING* Undefined function ~p:~p/~p~n", + [M,F,A]) + end, + map(F, Undef); +form_warn(What) -> + io_lib:format("*WARNING* ~p~n", [What]). diff --git a/lib/sasl/src/systools_rc.erl b/lib/sasl/src/systools_rc.erl new file mode 100644 index 0000000000..23d1a52b66 --- /dev/null +++ b/lib/sasl/src/systools_rc.erl @@ -0,0 +1,1044 @@ +%% +%% %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% +%% +-module(systools_rc). +-export([translate_scripts/3, translate_scripts/4, format_error/1]). + +-include("systools.hrl"). + +%%----------------------------------------------------------------- +%% High-level +%% ========== +%% mnesia_backup (not yet implemented) +%% {update, Mod, Change, PrePurge, PostPurge, [Mod]} +%% {update, Mod, Timeout, Change, PrePurge, PostPurge, [Mod]} +%% {update, Mod, ModType, , Change, PrePurge, PostPurge, [Mod]} +%% {update, Mod, ModType, Timeout, Change, PrePurge, PostPurge, [Mod]} +%% {load_module, Mod, PrePurge, PostPurge, [Mod]} +%% {add_module, Mod} +%% {add_module, Mod, [Mod]} +%% {remove_module, Mod, PrePurge, PostPurge, [Mod]} +%% {restart_application, Appl} +%% {add_application, Appl} +%% {remove_application, Appl} +%% +%% Low-level +%% ========= +%% {load_object_code, {Lib, LibVsn, Mods}} +%% point_of_no_return +%% {load, {Mod, PrePurge, PostPurge}} +%% {remove, {Mod, PrePurge, PostPurge}} +%% {purge, Mods} +%% {suspend, Mods} +%% {resume, Mods} +%% {code_change, [{Mod, Extra}]} +%% {code_change, Mode, [{Mod, Extra}]} +%% {stop, Mods} +%% {start, Mods} +%% {sync_nodes, Id, {M, F, A}} +%% {sync_nodes, Id, Nodes} +%% {apply, {M, F, A}} +%% restart_new_emulator +%%----------------------------------------------------------------- + +%% High-level instructions that contain dependencies +%% +-define(DEP_INSTRS, [update, load_module, add_module, remove_module]). + +%%----------------------------------------------------------------- +%% translate_scripts(Scripts, Appls, PreAppls) -> Res +%% Mode = up | dn +%% Scripts = [AppupScript] +%% Appls = PreAppls = [#application] +%% Res = {ok, LowLevelScript} | {error, ?MODULE, Reason} +%%----------------------------------------------------------------- +translate_scripts(Scripts, Appls, PreAppls) -> + translate_scripts(up, Scripts, Appls, PreAppls). + +translate_scripts(Mode, Scripts, Appls, PreAppls) -> + Scripts2 = expand_scripts(Scripts), + case catch do_translate_scripts(Mode, Scripts2, Appls, PreAppls) of + {ok, NewScript} -> {ok, NewScript}; + {error, Reason} -> {error, ?MODULE, Reason}; + {'EXIT', Reason} -> {error, ?MODULE, Reason} + end. + +expand_scripts([Script|Scripts]) -> + [expand_script(Script)|expand_scripts(Scripts)]; +expand_scripts([]) -> + []. + +expand_script([I|Script]) -> + I2 = case I of + {load_module, Mod} -> + {load_module, Mod, brutal_purge, brutal_purge, []}; + {load_module, Mod, Mods} when is_list(Mods) -> + {load_module, Mod, brutal_purge, brutal_purge, Mods}; + {update, Mod} -> + {update, Mod, soft, brutal_purge, brutal_purge, []}; + {update, Mod, supervisor} -> + {update, Mod, static, default, {advanced,[]}, + brutal_purge, brutal_purge, []}; + {update, Mod, Change} when is_tuple(Change) -> + {update, Mod, Change, brutal_purge, brutal_purge, []}; + {update, Mod, Change} when Change==soft -> + {update, Mod, Change, brutal_purge, brutal_purge, []}; + {update, Mod, Mods} when is_list(Mods) -> + {update, Mod, soft, brutal_purge, brutal_purge, Mods}; + {update, Mod, Change, Mods} when is_tuple(Change), + is_list(Mods) -> + {update, Mod, Change, brutal_purge,brutal_purge, Mods}; + {update, Mod, Change, Mods} when Change==soft, + is_list(Mods) -> + {update, Mod, Change, brutal_purge,brutal_purge, Mods}; + {delete_module, Mod} -> + [{remove, {Mod, brutal_purge, brutal_purge}}, + {purge, [Mod]}]; + _ -> + I + end, + if + is_list(I2) -> + I2 ++ expand_script(Script); + true -> + [I2|expand_script(Script)] + end; +expand_script([]) -> + []. + +do_translate_scripts(Mode, Scripts, Appls, PreAppls) -> + MergedScript = merge_scripts(Scripts), + translate_merged_script(Mode, MergedScript, Appls, PreAppls). + +%%----------------------------------------------------------------- +%% All check_ functions performs checks, and throws {error, Reason} +%% (or fails) in case of error. Called functions may throw error or +%% fail. The script is split into instructions before and after +%% point_of_no_return. In Before, only load_object_code and apply are +%% allowed. +%% %%----------------------------------------------------------------- +translate_merged_script(Mode, Script, Appls, PreAppls) -> + check_syntax(Script), + Script1 = normalize_instrs(Script), + {Before, After} = split_script(Script1), + check_script(Before, After), + + {Before1, After1} = translate_independent_instrs(Before, After, Appls, PreAppls), + {Before2, After2} = translate_dependent_instrs(Mode, Before1, After1, + Appls), + Before3 = merge_load_object_code(Before2), + NewScript = Before3 ++ [point_of_no_return | After2], + check_syntax(NewScript), + {ok, NewScript}. + +%%----------------------------------------------------------------- +%% SPLIT AND MERGE +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% merge_scripts(Scripts) -> Script +%% +%% Splits each script into before and after, and merges the before and +%% after parts. +%%----------------------------------------------------------------- +merge_scripts(Scripts) -> + {Before, After} = + lists:foldl( + fun(Script, {B1, A1}) -> + {B2, A2} = split_script(Script), + {B1 ++ B2, A1 ++ A2} + end, {[], []},Scripts), + Before ++ [point_of_no_return | After]. + +%%----------------------------------------------------------------- +%% split_script(Script) -> {Before, After} +%% +%% Splits the script into instructions before and after +%% point_of_no_return. Puts all load_object_code instructions in +%% Before. Checks that there is at most one point_of_no_return. +%% Makes sure that if there was a point_of_no_return, only apply and +%% load_object_code are before the point_of_no_return. +%%----------------------------------------------------------------- +split_script(Script) -> + {Before, After} = split_instrs(Script), + lists:foreach( + fun({load_object_code, _}) -> ok; + ({apply, _}) -> ok; + (Instruction) -> + throw({error, {bad_op_before_point_of_no_return, + Instruction}}) + end, Before), + {Found, Rest} = split(fun({load_object_code, _}) -> true; + (_) -> false + end, After), + {Before ++ Found, Rest}. + +%% split_instrs(Script) -> {Before, After} Split the +%% instructions into the set of those that appear before +%% point_of_no_return, and the set of those that appear after. If +%% there is no point_of_no_return instruction {[], Script} is +%% returned. +split_instrs(Script) -> + split_instrs(Script, []). +split_instrs([point_of_no_return | T], Before) -> + case lists:member(point_of_no_return, T) of + true -> throw({error, too_many_point_of_no_return}); + false -> {lists:reverse(Before), T} + end; +split_instrs([H | T], Before) -> + split_instrs(T, [H | Before]); +split_instrs([], Before) -> + {[], lists:reverse(Before)}. + +%%----------------------------------------------------------------- +%% CHECKS +%%----------------------------------------------------------------- + +check_script(Before, After) -> + check_load(Before, After), + check_suspend_resume(After), + check_start_stop(After). + +%%----------------------------------------------------------------- +%% Checks that each load has a corresponding load_object_code. +%%----------------------------------------------------------------- +check_load(Before, After) -> + lists:foreach( + fun({load, {Mod, _, _}}) -> + case find_object_code(Mod, Before) of + true -> ok; + false -> throw({error, {no_object_code, Mod}}) + end; + (_) -> ok + end, After). + +find_object_code(Mod, [{load_object_code, {_, _, Mods}} | T]) -> + case lists:member(Mod, Mods) of + true -> true; + false -> find_object_code(Mod, T) + end; +find_object_code(Mod, [_|T]) -> + find_object_code(Mod, T); +find_object_code(_Mod, []) -> + false. + +%%----------------------------------------------------------------- +%% Checks that all suspended Mods are resumed, and that none are +%% resumed/code_changed but not suspended. +%%----------------------------------------------------------------- +check_suspend_resume(Script) -> + Suspended = lists:map(fun({Mod, _Timeout}) -> Mod; + (Mod) -> Mod + end, + lists:flatten([X || {suspend, X} <- Script])), + Resumed = lists:flatten([X || {resume, X} <- Script]), + CodeChanged = lists:flatten([X || {code_change, _, {X, _}} <- Script]), + case difference(Suspended, Resumed) of + [] -> ok; + S2 -> throw({error, {suspended_not_resumed, S2}}) + end, + case difference(Resumed, Suspended) of + [] -> ok; + R2 -> throw({error, {resumed_not_suspended, R2}}) + end, + case difference(CodeChanged, Suspended) of + [] -> ok; + C2 -> throw({error, {code_change_not_suspended, C2}}) + end. + +%%----------------------------------------------------------------- +%% Checks that all stops are started, and that all starts are +%% stopped. +%%----------------------------------------------------------------- +check_start_stop(Script) -> + Start = lists:flatten([X || {start, X} <- Script]), + Stop = lists:flatten([X || {stop, X} <- Script]), + case difference(Start, Stop) of + [] -> ok; + S2 -> throw({error, {start_not_stop, S2}}) + end, + case difference(Stop, Start) of + [] -> ok; + S3 -> throw({error, {stop_not_start, S3}}) + end. + + +%%----------------------------------------------------------------- +%% NORMALISATION +%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% Normalize those instructions that have variants (update and +%% add_module). +%%----------------------------------------------------------------- +normalize_instrs(Script) -> + lists:map(fun({update, Mod, Change, PrePurge, PostPurge, Mods}) -> + {update, Mod, dynamic, default, Change, PrePurge, + PostPurge, Mods}; + ({update, Mod, Timeout, Change, PrePurge, PostPurge, + Mods}) -> + {update, Mod, dynamic, Timeout, Change, PrePurge, + PostPurge, Mods}; + ({add_module, Mod}) -> + {add_module, Mod, []}; + (I) -> + I + end, Script). + +%%----------------------------------------------------------------- +%% TRANSLATION OF INDEPENDENT INSTRUCTIONS +%%----------------------------------------------------------------- + +%% translate_independent_instrs(Before, After, Appls, PreAppls) -> +%% {NBefore, NAfter} +%% +translate_independent_instrs(Before, After, Appls, PreAppls) -> + After1 = translate_application_instrs(After, Appls, PreAppls), + translate_add_module_instrs(Before, After1). + +%%----------------------------------------------------------------- +%% Translates add_application, remove_application and restart_application +%% into add_module, remove, purge and apply. +%%----------------------------------------------------------------- +translate_application_instrs(Script, Appls, PreAppls) -> + %% io:format("Appls ~n~p~n",[Appls]), + L = lists:map( + fun({add_application, Appl}) -> + case lists:keysearch(Appl, #application.name, Appls) of + {value, Application} -> + Mods = + remove_vsn(Application#application.modules), + [{add_module, M, []} || M <- Mods] ++ + [{apply, {application, start, + [Appl, permanent]}}]; + false -> + throw({error, {no_such_application, Appl}}) + end; + + ({remove_application, Appl}) -> + case lists:keysearch(Appl, #application.name, Appls) of + {value, _Application} -> + throw({error, {removed_application_present, + Appl}}); + false -> + ignore + end, + case lists:keysearch(Appl, #application.name, PreAppls) of + {value, RemApplication} -> + Mods = remove_vsn(RemApplication#application.modules), + [{apply, {application, stop, [Appl]}}] ++ + [{remove, {M, brutal_purge, brutal_purge}} || M <- Mods] ++ + [{purge, Mods}, + {apply, {application, unload, [Appl]}}]; + false -> + throw({error, {no_such_application, Appl}}) + end; + ({restart_application, Appl}) -> + case lists:keysearch(Appl, #application.name, PreAppls) of + {value, PreApplication} -> + PreMods = + remove_vsn(PreApplication#application.modules), + + case lists:keysearch(Appl, #application.name, Appls) of + {value, PostApplication} -> + PostMods = + remove_vsn(PostApplication#application.modules), + + [{apply, {application, stop, [Appl]}}] ++ + [{remove, {M, brutal_purge, brutal_purge}} || M <- PreMods] ++ + [{purge, PreMods}] ++ + [{add_module, M, []} || M <- PostMods] ++ + [{apply, {application, start, + [Appl, permanent]}}]; + false -> + throw({error, {no_such_application, Appl}}) + end; + + false -> + throw({error, {no_such_application, Appl}}) + end; + (X) -> X + end, Script), + lists:flatten(L). + +remove_vsn(Mods) -> + lists:map(fun({Mod, _Vsn}) -> Mod; + (Mod) -> Mod + end, Mods). + +%%----------------------------------------------------------------- +%% Translates add_module into load_module (high-level transformation) +%%----------------------------------------------------------------- +translate_add_module_instrs(Before, After) -> + NAfter = lists:map( + fun({add_module, Mod, Mods}) -> + %% Purge method really doesn't matter. Module + %% is new. + {load_module, Mod, brutal_purge, brutal_purge, Mods}; + (I) -> + I + end, After), + {Before, NAfter}. + + +%%----------------------------------------------------------------- +%% TRANSLATION OF INSTRUCTIONS WITH DEPENDENCIES +%%----------------------------------------------------------------- + +%%----------------------------------------------------------------- +%% Translates update, load_module and remove_module, and reorder the +%% instructions according to dependencies. Leaves other instructions +%% unchanged. +%%----------------------------------------------------------------- +translate_dependent_instrs(Mode, Before, After, Appls) -> + %% G is the total dependency graph, WCs is the decomposition of + %% the vertices (lists of vertices) of G. + G = make_dependency_graph(After), + WCs = digraph_utils:components(G), + {NBefore, NAfter} = translate_dep_loop(G, WCs, After, Appls, + [], [], Mode), + digraph:delete(G), + {Before ++ NBefore, NAfter}. + +translate_dep_loop(G, WCs, [I| Is], Appls, Before, After, Mode) + when is_tuple(I), size(I) > 1 -> + IName = element(1, I), + case lists:member(IName, ?DEP_INSTRS) of + true -> + Mod = element(2, I), + DepIs = get_dependent_instructions(G, WCs, Mod), + {B2, A2} = translate_dep_to_low(Mode, DepIs, Appls), + RemIs = difference([I| Is], DepIs), + translate_dep_loop(G, WCs, RemIs, Appls, Before ++ B2, + After ++ A2, Mode); + false -> + translate_dep_loop(G, WCs, Is, Appls, Before, + After ++ [I], Mode) % hmm + end; +translate_dep_loop(G, WCs, [I| Is], Appls, Before, After, Mode) -> + translate_dep_loop(G, WCs, Is, Appls, Before, After ++ [I], Mode); % hmm +translate_dep_loop(_G, _WCs, [], _Appls, Before, After, _Mode) -> + {Before, After}. + + +%%----------------------------------------------------------------- +%% make_dependency_graph(Instructions) -> graph() +%% +%% The return value is a digraph graph(). A vertex is a module name +%% Mod, and the associated data is {N, I} where I is the corresponding +%% instruction, and N numbers the instruction in the order given at +%% input. Only instructions that have dependencies are considered. +%% %%----------------------------------------------------------------- +make_dependency_graph(Instructions) -> + %% Filter out dependent instructions + DepIs = lists:filter(fun(I) when is_tuple(I) -> + IName = element(1, I), + lists:member(IName, ?DEP_INSTRS); + (_) -> + false + end, Instructions), + {VDs, _} = lists:mapfoldl( + fun(I, N) -> + Mod = element(2, I), + Mods = element(size(I), I), + {{Mod, Mods, {N, I}}, N+1} + end, 1, DepIs), + G = digraph:new(), + %% Add vertices + lists:foreach( + fun({Mod, _Mods, Data}) -> + case digraph:vertex(G, Mod) of + false -> + digraph:add_vertex(G, Mod, Data); + _ -> + throw({error, {muldef_module, Mod}}) + end + end, VDs), + %% Add edges + lists:foreach( + fun({Mod, Mods, _Data}) -> + lists:foreach( + fun(M) -> + case digraph:add_edge(G, Mod, M) of + {error, _Reason} -> + throw({error, {undef_module, M}}); + _ -> + ok + end + end, Mods) + end, VDs), + G. + +%% get_dependent_instructions(G, WCs, Mod) -> DepIs +%% +%% G is the global dependency graph, WCs are the weak components +%% (lists of vertices) of G, and Mod is the module for which we will +%% pick up all instructions that Mod depends on, or that depend on +%% Mod. +%% +get_dependent_instructions(G, WCs, Mod) -> + case lists:filter(fun(C) -> lists:member(Mod, C) end, WCs) of + [WC] -> + %% restrict G to WC + H = restriction(WC, G), + %% vertices of S are strong components of H + S = condensation(H), + Ts = digraph_utils:topsort(S), + DepIss = lists:map( + fun(T) -> + NIs = lists:map( + fun(V) -> + {_, Data} = + digraph:vertex(H, V), + Data + end, T), + %% NIs = [{N, I}] + SortedNIs = lists:keysort(1, NIs), + lists:map(fun({_N, I}) -> I end, SortedNIs) + end, Ts), + DepIs = lists:flatten(DepIss), % XXX One level flat only + digraph:delete(H), + digraph:delete(S), + DepIs; + [] -> + throw({error, {undef_module, Mod}}); + _ -> + throw({error, {muldef_module, Mod}}) + end. + +%% translate_dep_to_low(Mode, Instructions, Appls) -> {Before, After} +%% +%% Mode = up | dn +%% Instructions are in order of dependency. +%% Appls = [#application] +%% +%% Instructions translated are: update, load_module, and remove_module +%% +%% Before = [{load_object_code, ...}] +%% After = [{suspend, ...}] ++ CodeInstrs ++ [{resume, ...}] +%% CodeInstrs = [{load, ...}] ++ [{code_change, ...}] (Mode == up) +%% = [{code_change, ...}] ++ [{load, ...}] ++ +%% [{code_change, ...}] (Mode == dn) +%% +translate_dep_to_low(Mode, Instructions, Appls) -> + UpdateMods = + filtermap(fun({update, Mod, _, default, _, _, _, _}) -> + {true, Mod}; + ({update, Mod, _, T, _, _, _, _}) -> + {true, {Mod, T}}; + (_) -> + false + end, + Instructions), + RevUpdateMods = lists:reverse(UpdateMods), + + %% Processes are suspended in the order of dependency. + SuspendInstrs = + if + UpdateMods == [] -> []; + true -> [{suspend, UpdateMods}] + end, + + + %% Processes are resumed in the reversed order of dependency. + ResumeInstrs = + if + UpdateMods == [] -> []; + true -> [{resume, + lists:map(fun({Mod, _T}) -> Mod; + (Mod) -> Mod + end, RevUpdateMods)}] + end, + + LoadRemoveInstrs = + filtermap(fun({update, Mod, _, _, _, PreP, PostP, _}) -> + {true, {load, {Mod, PreP, PostP}}}; + ({load_module, Mod, PreP, PostP, _}) -> + {true, {load, {Mod, PreP, PostP}}}; + ({remove_module, Mod, PreP, PostP, _}) -> + {true, {remove, {Mod, PreP, PostP}}}; + (_) -> false + end, + Instructions), + RevLoadRemoveInstrs = lists:reverse(LoadRemoveInstrs), + + %% The order of loading object code is unimportant. The order + %% chosen is the order of dependency. + LoadObjCodeInstrs = + filtermap(fun({load, {Mod, _, _}}) -> + {Lib, LibVsn} = get_lib(Mod, Appls), + {true, {load_object_code, {Lib, LibVsn, [Mod]}}}; + (_) -> false + end, LoadRemoveInstrs), + if + Mode == up -> + %% The order of changing code is unimportant (processes + %% are suspended). The order chosen is the order of + %% dependency. + CodeChangeMods = + filtermap(fun({update, Mod, _, _, + {advanced, Extra}, _, _, _}) -> + {true, {Mod, Extra}}; + (_) -> + false + end, Instructions), + CodeChangeInstrs = + if + CodeChangeMods == [] -> []; + true -> [{code_change, up, CodeChangeMods}] + end, + %% RevLoadRemoveInstrs: When upgrading modules are loaded + %% in the reversed order of dependency. + {LoadObjCodeInstrs, + SuspendInstrs ++ RevLoadRemoveInstrs ++ CodeChangeInstrs ++ + ResumeInstrs}; + + Mode == dn -> + %% PreCodeChangeMods is the list of all modules that have + %% to change code *before* the code is loaded (when + %% downgrading). The order is not important (processes are + %% suspended). The order chosen is the order of + %% dependency. + PreCodeChangeMods = + [{Mod, Extra} || + {update, Mod, dynamic, _, {advanced, Extra}, _, _, _} + <- Instructions], + PreCodeChangeInstrs = + if + PreCodeChangeMods == [] -> []; + true -> [{code_change, down, PreCodeChangeMods}] + end, + %% PostCodeChangeMods is the list of all modules that have + %% to change code *after* the code is loaded (when + %% downgrading). The order is not important (processes are + %% suspended). The order chosen is the order of + %% dependency. + PostCodeChangeMods = + [{Mod, Extra} || + {update, Mod, static, _, {advanced, Extra}, _, _, _} + <- Instructions], + PostCodeChangeInstrs = + if + PostCodeChangeMods == [] -> []; + true -> [{code_change, down, PostCodeChangeMods}] + end, + %% LoadRemoveInstrs: When downgrading modules are loaded + %% in the order of dependency. + {LoadObjCodeInstrs, + SuspendInstrs ++ PreCodeChangeInstrs ++ + LoadRemoveInstrs ++ PostCodeChangeInstrs ++ ResumeInstrs} + end. + +get_lib(Mod, [#application{name = Name, vsn = Vsn, modules = Modules} | T]) -> + %% Module = {Mod, Vsn} | Mod + case lists:keysearch(Mod, 1, Modules) of + {value, _} -> + {Name, Vsn}; + false -> + case lists:member(Mod, Modules) of + true -> {Name, Vsn}; + false -> get_lib(Mod, T) + end + end; +get_lib(Mod, []) -> + throw({error, {no_such_module, Mod}}). + +%%----------------------------------------------------------------- +%% MERGE LOAD_OBJECT_CODE +%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% Merge load_object_code instructions into one load_object_code +%% instruction per lib (optimization). Order is preserved. +%%----------------------------------------------------------------- +merge_load_object_code(Before) -> + {Found, Rest} = split(fun({load_object_code, _}) -> true; + (_) -> false + end, Before), + mlo(Found) ++ Rest. + +mlo([{load_object_code, {Lib, LibVsn, Mods}} | T]) -> + {Same, Other} = split(fun({load_object_code, {Lib2, LibVsn2, _Mods2}}) + when Lib == Lib2, LibVsn == LibVsn2 -> true; + ({load_object_code, {Lib2, LibVsn2, _Mods2}}) + when Lib == Lib2 -> + throw({error, {conflicting_versions, + Lib, LibVsn, LibVsn2}}); + (_) -> false + end, T), + %% io:format("Same = ~p, Other = ~p~n", [Same, Other]), + %% foldr to preserver order. + OCode0 = lists:foldr(fun({load_object_code, {_, _, Ms}}, Res) -> + U = union(Ms, Res), + %% io:format("Ms = ~p, Res = ~p, U = ~p~n", + %% [Ms, Res, U]), + U + end, [], Same), + OCode1 = union(Mods, OCode0), % preserve order + %% io:format("OCode0 = ~p, OCode1 = ~p~n", [OCode0, OCode1]), + [{load_object_code, {Lib, LibVsn, OCode1}} | mlo(Other)]; +mlo([]) -> []. + +%%----------------------------------------------------------------- +%% SYNTAX CHECK +%%----------------------------------------------------------------- +%%----------------------------------------------------------------- +%% Checks the syntax of all instructions. +%%----------------------------------------------------------------- +check_syntax([H|T]) -> + check_op(H), + check_syntax(T); +check_syntax([]) -> ok. + +check_op(mnesia_backup) -> + throw({error, {not_yet_implemented, mnesia_backup}}); +check_op({update, Mod, Change, PrePurge, PostPurge, Mods}) -> + check_mod(Mod), + check_change(Change), + check_purge(PrePurge), + check_purge(PostPurge), + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({update, Mod, Timeout, Change, PrePurge, PostPurge, Mods}) -> + check_mod(Mod), + check_timeout(Timeout), + check_change(Change), + check_purge(PrePurge), + check_purge(PostPurge), + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({update, Mod, ModType, Timeout, Change, PrePurge, PostPurge, + Mods}) -> + check_mod(Mod), + check_mod_type(ModType), + check_timeout(Timeout), + check_change(Change), + check_purge(PrePurge), + check_purge(PostPurge), + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({load_module, Mod, PrePurge, PostPurge, Mods}) -> + check_mod(Mod), + check_purge(PrePurge), + check_purge(PostPurge), + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({add_module, Mod}) -> + check_mod(Mod); +check_op({add_module, Mod, Mods}) -> + check_mod(Mod), + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({remove_module, Mod, PrePurge, PostPurge, Mods}) -> + check_mod(Mod), + check_purge(PrePurge), + check_purge(PostPurge), + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({remove_application, Appl}) -> + check_appl(Appl); +check_op({add_application, Appl}) -> + check_appl(Appl); +check_op({restart_application, Appl}) -> + check_appl(Appl); +check_op(restart) -> ok; +check_op(reboot) -> ok; +check_op({load_object_code, {Lib, LibVsn, Mods}}) -> + check_lib(Lib), + check_lib_vsn(LibVsn), + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op(point_of_no_return) -> ok; +check_op({load, {Mod, PrePurge, PostPurge}}) -> + check_mod(Mod), + check_purge(PrePurge), + check_purge(PostPurge); +check_op({remove, {Mod, PrePurge, PostPurge}}) -> + check_mod(Mod), + check_purge(PrePurge), + check_purge(PostPurge); +check_op({purge, Mods}) -> + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({suspend, Mods}) -> + check_list(Mods), + lists:foreach(fun({M,T}) -> check_mod(M), check_timeout(T); + (M) -> check_mod(M) + end, Mods); +check_op({resume, Mods}) -> + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({code_change, Mods}) -> + check_list(Mods), + lists:foreach(fun({M, _Extra}) -> check_mod(M); + (X) -> throw({error, {bad_code_change, X}}) + end, Mods); +check_op({code_change, Mode, Mods}) -> + check_list(Mods), + check_mode(Mode), + lists:foreach(fun({M, _Extra}) -> check_mod(M); + (X) -> throw({error, {bad_code_change, X}}) + end, Mods); +check_op({stop, Mods}) -> + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({start, Mods}) -> + check_list(Mods), + lists:foreach(fun(M) -> check_mod(M) end, Mods); +check_op({sync_nodes, _Id, {M, F, A}}) -> + check_mod(M), + check_func(F), + check_args(A); +check_op({sync_nodes, _Id, Nodes}) -> + check_list(Nodes), + lists:foreach(fun(Node) -> check_node(Node) end, Nodes); +check_op({apply, {M, F, A}}) -> + check_mod(M), + check_func(F), + check_args(A); +check_op(restart_new_emulator) -> ok; +check_op(X) -> throw({error, {bad_instruction, X}}). + +check_mod(Mod) when is_atom(Mod) -> ok; +check_mod(Mod) -> throw({error, {bad_module, Mod}}). + +check_change(soft) -> ok; +check_change({advanced, _}) -> ok; +check_change(Change) -> throw({error, {bad_change, Change}}). + +check_mod_type(static) -> ok; +check_mod_type(dynamic) -> ok; +check_mod_type(ModType) -> throw({error, {bad_mod_type, ModType}}). + +check_purge(soft_purge) -> ok; +check_purge(brutal_purge) -> ok; +check_purge(Purge) -> throw({error, {bad_purge_method, Purge}}). + +check_list(List) when is_list(List) -> ok; +check_list(List) -> throw({error, {bad_list, List}}). + +check_args(Args) when is_list(Args) -> ok; +check_args(Args) -> throw({error, {bad_args_list, Args}}). + +check_node(Node) when is_atom(Node) -> ok; +check_node(Node) -> throw({error, {bad_node, Node}}). + +check_appl(Appl) when is_atom(Appl) -> ok; +check_appl(Appl) -> throw({error, {bad_application, Appl}}). + +check_func(Func) when is_atom(Func) -> ok; +check_func(Func) -> throw({error, {bad_func, Func}}). + +check_lib(Lib) when is_atom(Lib) -> ok; +check_lib(Lib) -> throw({error, {bad_lib, Lib}}). + +check_lib_vsn(LibVsn) when is_list(LibVsn) -> ok; +check_lib_vsn(LibVsn) -> throw({error, {bad_lib_vsn, LibVsn}}). + +check_timeout(default) -> ok; +check_timeout(infinity) -> ok; +check_timeout(Int) when is_integer(Int), Int > 0 -> ok; +check_timeout(T) -> throw({error, {bad_timeout, T}}). + +check_mode(up) -> ok; +check_mode(down) -> ok; +check_mode(Mode) -> throw({error, {bad_mode, Mode}}). + +%%----------------------------------------------------------------- +%% Format error +%%----------------------------------------------------------------- +format_error({bad_op_before_point_of_no_return, Instruction}) -> + io_lib:format("Bad instruction ~p~nbefore point_of_no_return~n", + [Instruction]); +format_error({no_object_code, Mod}) -> + io_lib:format("No load_object_code found for module: ~p~n", [Mod]); +format_error({suspended_not_resumed, Mods}) -> + io_lib:format("Suspended but not resumed: ~p~n", [Mods]); +format_error({resumed_not_suspended, Mods}) -> + io_lib:format("Resumed but not suspended: ~p~n", [Mods]); +format_error({code_change_not_suspended, Mods}) -> + io_lib:format("Code changed but not suspended: ~p~n", [Mods]); +format_error({start_not_stop, Mods}) -> + io_lib:format("Started but not stopped: ~p~n", [Mods]); +format_error({stop_not_start, Mods}) -> + io_lib:format("Stopped but not started: ~p~n", [Mods]); +format_error({no_such_application, App}) -> + io_lib:format("Started undefined application: ~p~n", [App]); +format_error({removed_application_present, App}) -> + io_lib:format("Removed application present: ~p~n", [App]); +format_error(dup_mnesia_backup) -> + io_lib:format("Duplicate mnesia_backup~n", []); +format_error(bad_mnesia_backup) -> + io_lib:format("mnesia_backup in bad position~n", []); +format_error({conflicting_versions, Lib, V1, V2}) -> + io_lib:format("Conflicting versions for ~p, ~p and ~p~n", [Lib, V1, V2]); +format_error({no_appl_vsn, Appl}) -> + io_lib:format("No version specified for application: ~p~n", [Appl]); +format_error({no_such_module, Mod}) -> + io_lib:format("No such module: ~p~n", [Mod]); +format_error(too_many_point_of_no_return) -> + io_lib:format("Too many point_of_no_return~n", []); + +format_error({bad_instruction, X}) -> + io_lib:format("Bad instruction: ~p~n", [X]); +format_error({bad_module, X}) -> + io_lib:format("Bad module: ~p(should be atom())~n", [X]); +format_error({bad_code_change, X}) -> + io_lib:format("Bad code_change: ~p(should be {Mod, Extra})~n", [X]); +format_error({bad_change, X}) -> + io_lib:format("Bad change spec: ~p(should be soft | {advanced, E})~n", [X]); +format_error({bad_mod_type, X}) -> + io_lib:format("Bad module type: ~p(should be static | dynamic)~n", [X]); +format_error({bad_purge_method, X}) -> + io_lib:format("Bad purge method: ~p(should be soft_purge | brutal_purge)~n", + [X]); +format_error({bad_list, X}) -> + io_lib:format("Bad list: ~p~n", [X]); +format_error({bad_args_list, X}) -> + io_lib:format("Bad argument list: ~p~n", [X]); +format_error({bad_node, X}) -> + io_lib:format("Bad node: ~p(should be atom())~n", [X]); +format_error({bad_application, X}) -> + io_lib:format("Bad application: ~p(should be atom())~n", [X]); +format_error({bad_func, X}) -> + io_lib:format("Bad function: ~p(should be atom())~n", [X]); +format_error({bad_lib, X}) -> + io_lib:format("Bad library: ~p(should be atom())~n", [X]); +format_error({bad_lib_vsn, X}) -> + io_lib:format("Bad library version: ~p(should be string())~n", [X]); +format_error({bad_timeout, X}) -> + io_lib:format("Bad timeout: ~p(should be infinity | int() > 0)~n", [X]); + +format_error({undef_module, Mod}) -> + io_lib:format("Undefined module: ~p~n", [Mod]); +format_error({muldef_module, Mod}) -> + io_lib:format("Multiply defined module: ~p~n", [Mod]); +format_error(E) -> + io_lib:format("~p~n",[E]). + + +%%----------------------------------------------------------------- +%% MISC SUPPORT +%%----------------------------------------------------------------- + +%% filtermap(F, List1) -> List2 +%% F(H) -> false | true | {true, Val} +filtermap(F, List) -> + lists:zf(F, List). + +%% split(F, List1) -> {List2, List3} +%% F(H) -> true | false. Preserves order. +split(Fun, [H | T]) -> + {Found, Rest} = split(Fun, T), + case Fun(H) of + true -> {[H | Found], Rest}; + false -> {Found, [H | Rest]} + end; +split(_Fun, []) -> + {[], []}. + +union([H|T], L) -> + case lists:member(H, L) of + true -> union(T,L); + false -> [H | union(T, L)] + end; +union([], L) -> L. + +difference([H | T], L) -> + case lists:member(H, L) of + true -> difference(T, L); + false -> [H | difference(T, L)] + end; +difference([], _) -> []. + + +%%----------------------------------------------------------------- +%% GRAPHS +%%----------------------------------------------------------------- + +%% Additions to digraph and digraph utils. +%% XXX Should be removed in future versions. + +%% This function should be included in digraph_utils. + +%% condensation(G) -> graph() +%% +%% Given a graph G, returns a new graph H where each vertex V in H is +%% a strong component of G, and where there is an edge from V1 to V2 +%% in H if there are members of v1 and v2 of V1 and V2, respectively, +%% such that there is an edge from v1 to v2 in G. +%% +condensation(G) -> + H = digraph:new(), + HVs = digraph_utils:strong_components(G), + %% Add all vertices + lists:foreach(fun(HV) -> digraph:add_vertex(H, HV) end, HVs), + %% Add edges + lists:foreach( + fun(HV1) -> + GRs = digraph_utils:reachable(HV1, G), + lists:foreach( + fun(HV2) -> + if + HV1 /= HV2 -> + case lists:member(hd(HV2), GRs) of + true -> + digraph:add_edge(H, HV1, HV2); + _ -> + ok + end; + true -> + ok + end + end, HVs) + end, HVs), + H. + + +%% This function should be included in digraph. + +%% restriction(Rs, G) -> graph() +%% +%% Given a graph G, returns a new graph H that is the restriction of +%% G to the vertices Rs. +%% +restriction(Rs, G) -> + H = digraph:new(), + %% Add vertices + lists:foreach( + fun(R) -> + case digraph:vertex(G, R) of + {R, Data} -> + digraph:add_vertex(H, R, Data); + _ -> + ok + end + end, Rs), + %% Add edges + GEs = digraph:edges(G), + lists:foreach( + fun(GE) -> + {_, GV1, GV2, GData} = digraph:edge(G, GE), + case {digraph:vertex(H, GV1), digraph:vertex(H, GV2)} of + {{GV1, _}, {GV2, _}} -> + digraph:add_edge(H, GE, GV1, GV2, GData); + _ -> + ok + end + end, GEs), + H. + + diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl new file mode 100644 index 0000000000..177d50be80 --- /dev/null +++ b/lib/sasl/src/systools_relup.erl @@ -0,0 +1,560 @@ +%% +%% %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% +%% +-module(systools_relup). + +%% +%% GENERATING A RELUP FILE +%% +%% The purpose of this module is to produce one relup file, based on +%% one `top' .rel file, a set of `base' .rel files, and application +%% .app and .appup files. + +%% A .rel file contains a release specification that lists the name +%% and version of the release, the erts version used, and all +%% applications that are contained in the release. +%% +%% In the sequel the term `top' refers to precisely one release that +%% we upgrade to, or downgrade from. The term `base' refers to one or +%% several releases that we upgrade from (`base' -> `top'), or +%% downgrade to (`base' <-- `top'). We should have the following +%% diagram in mind: +%% +%% +%% TopRel +%% +%% / | \ +%% / | \ +%% / | \ +%% / | \ +%% | | | +%% Base-1-Rel Base-2-Rel... Base-N-Rel . +%% +%% .appup files for upgrade or downgrade reside only with the applications +%% in the `top' release. +%% +%% Consider now one of the Base-k-Rel releases, call it BaseRel, +%% and let +%% +%% TopApps = the applications in TopRel +%% BaseApps = the applications in BaseRel, +%% +%% and define the following sets of names: +%% +%% TopAppNames = [App.name || App <- TopApps] +%% BaseAppNames = [App.name || App <- BaseApps] . +%% +%% We have the following disjoint sets: +%% +%% (1) TopAppNames \ BaseAppNames +%% +%% The elements in this set are the (names of) the applications +%% which are only in the `top' release TopRel. +%% +%% (2) TopAppNames /\ BaseAppNames +%% +%% The elements in this set are the (names of) the applications that +%% exist in both releases. +%% +%% (3) BaseAppNames \ TopAppNames +%% +%% The elements in this set are the (names of) the applications that +%% are only in the `base' release BaseRel. +%% +%% Upgrade (`base' --> `top') +%% ========================== +%% +%% TopAppNames \ BaseAppNames New applications. There are no +%% .appup files for these. Generate +%% `add_application' instructions. +%% +%% TopAppNames /\ BaseAppNames Same applications. For those that +%% have different vsns, upgrade according +%% to instructions in .appup file. +%% +%% BaseAppNames \ TopAppNames Old applications. There are no +%% .appup files for these. Generate +%% `remove_application' instructions. +%% +%% Downgrade ( `top' --> `base') +%% ============================= +%% +%% BaseAppNames \ TopAppNames New applications. There are no +%% .appup files for these. Generate +%% `add_application' instructions. +%% +%% TopAppNames /\ BaseAppNames Same applications. For those that +%% have different vsns, downgrade +%% according to instructions in +%% .appup file. +%% +%% TopAppNames \ BaseAppNames Old applications. There are no +%% .appup files for these. Generate +%% `remove_application' instructions. +%% +%% + +-export([mk_relup/3, mk_relup/4, format_error/1, format_warning/1]). +-include("systools.hrl"). + +%%----------------------------------------------------------------- +%% mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) +%% mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) -> Ret +%% +%% TopRelFile = rel_filename() +%% TopUpRelDcs = BaseDnRelDcs = [reldescr()] +%% reldescr() = rel_filename() | {_rel_filename(), description()} +%% rel_filename() = description() = string() +%% Opts = [opt()] +%% opt() = {path, [path()]} | silent | noexec | restart_emulator +%% | {outdir, string()} +%% path() = [string()] +%% Ret = ok | error | {ok, Relup, Module, Warnings} | {error, Module, Error} +%% +%% Creates a "relup" file based on information in the top +%% .rel file and the up and down .rel files. +%% +%% The rel_filename() is stem of a .rel file, i.e. the extension +%% ".rel" is added to the stem to form the name of the real file. +%% +%% XXX WARNING: The default paths used to search for files are those +%% that are returned by code:get_path(). The default path cannot be +%% changed, only prepended through the `path' option. That may have +%% consequences that are hard to predict. +%% +%% The option `path' sets search path, `silent' suppresses printing of +%% error messages to the console, `noexec' inhibits the creation of +%% the output "relup" file, and restart_emulator ensures that the new +%% emulator is restarted (as the final step). +%% ---------------------------------------------------------------- +mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs) -> + mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, []). +mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Opts) -> + case check_opts(Opts) of + [] -> + R = (catch do_mk_relup(TopRelFile,BaseUpRelDcs,BaseDnRelDcs, + add_code_path(Opts), Opts)), + case {get_opt(silent, Opts), get_opt(noexec, Opts)} of + {false, false} -> + case R of + {ok, _Res, _Mod, Ws} -> + print_warnings(Ws), + ok; + Other -> + print_error(Other), + error + end; + _ -> + R + end; + BadArg -> + erlang:error({badarg, BadArg}) + end. + +%% Function for checking validity of options in analogy with +%% check_args_script/1 and check_args_tar/1 in systools_make. +%% To maintain backwards compatibility, actually only outdir is checked. +check_opts([{outdir, Dir}|_Opts]) when is_list(Dir) -> + []; +check_opts([{outdir, BadArg}|_Opts]) -> + [{outdir, BadArg}]; +check_opts([_Opt|Opts]) -> + check_opts(Opts); +check_opts([]) -> + []. + +do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) -> + ModTest = false, + case systools_make:get_release(to_list(TopRelFile), Path, ModTest) of + %% + %% TopRel = #release + %% NameVsnApps = [{{Name, Vsn}, #application}] + {ok, TopRel, NameVsnApps, Ws0} -> + %% + %% TopApps = [#application] + TopApps = lists:map(fun({_, App}) -> App end, NameVsnApps), + + %% Up + {Up, Ws1} = foreach_baserel_up(TopRel, TopApps, BaseUpRelDcs, + Path, Opts, Ws0), + %% Down + {Dn, Ws2} = foreach_baserel_dn(TopRel, TopApps, BaseDnRelDcs, + Path, Opts, Ws1), + Relup = {TopRel#release.vsn, Up, Dn}, + write_relup_file(Relup, Opts), + {ok, Relup, ?MODULE, Ws2}; + Other -> + throw(Other) + end. + +%%----------------------------------------------------------------- +%% foreach_baserel_up(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret +%% foreach_baserel_dn(Rel, TopApps, BaseRelDcs, Path, Opts, Ws) -> Ret +%% +%% TopRel = #release +%% TopApps = [#application] +%% BaseRelDcs = [reldescr()] +%% reldescr() = filename() | {filename(), description()} +%% filename() = description() = string() +%% Opts = [opt()], opt() = {path, [path()]} | silent | noexec | +%% restart_emulator +%% Ws = [term()] +%% Ret = {VDRs, Ws} +%% VDRs = [vdr()], vdr() = {Vsn, Description, RUs} +%% +%% Generates scripts for each base release. +%% +foreach_baserel_up(TopRel, TopApps, BaseRelDcs, Path, Opts, Ws) -> + foreach_baserel_up(TopRel, TopApps, BaseRelDcs, Path, Opts, + Ws, []). + +foreach_baserel_up(TopRel, TopApps, [BaseRelDc|BaseRelDcs], Path, Opts, + Ws, Acc) -> + BaseRelFile = extract_filename(BaseRelDc), + + {ok, BaseRel} = systools_make:read_release(BaseRelFile, Path), + + %% + %% BaseRel = #release + %% + %% RUs = (release upgrade scripts). We really get separate + %% scripts, one for emulator restart, one for each + %% application, one for each added applications, and one for + %% each removed applications. + %% + {RUs1, Ws1} = collect_appup_scripts(up, TopApps, BaseRel, Ws, []), + + {RUs2, Ws2} = create_add_app_scripts(BaseRel, TopRel, RUs1, Ws1), + + {RUs3, Ws3} = create_remove_app_scripts(BaseRel, TopRel, RUs2, Ws2), + + {RUs4, Ws4} = + check_for_emulator_restart(TopRel, BaseRel, RUs3, Ws3, Opts), + + ModTest = false, + BaseApps = + case systools_make:get_release(BaseRelFile, Path, ModTest) of + {ok, _, NameVsnApps, _Warns} -> + lists:map(fun({_,App}) -> App end, NameVsnApps); + Other1 -> + throw(Other1) + end, + + case systools_rc:translate_scripts(up, RUs4, TopApps, BaseApps) of + {ok, RUs} -> + VDR = {BaseRel#release.vsn, + extract_description(BaseRelDc), RUs}, + foreach_baserel_up(TopRel, TopApps, BaseRelDcs, Path, + Opts, Ws4, [VDR| Acc]); + XXX -> + throw(XXX) + end; +foreach_baserel_up( _, _, [], _, _, Ws, Acc) -> + {Acc, Ws}. + +foreach_baserel_dn(TopRel, TopApps, BaseRelDcs, Path, Opts, Ws) -> + foreach_baserel_dn(TopRel, TopApps, BaseRelDcs, Path, Opts, + Ws, []). + +foreach_baserel_dn(TopRel, TopApps, [BaseRelDc|BaseRelDcs], Path, Opts, + Ws, Acc) -> + BaseRelFile = extract_filename(BaseRelDc), + + {ok, BaseRel} = systools_make:read_release(BaseRelFile, Path), + + %% BaseRel = #release + + %% RUs = (release upgrade scripts) + %% + {RUs1, Ws1} = collect_appup_scripts(dn, TopApps, BaseRel, Ws, []), + + ModTest = false, + {BaseApps, Ws2} = + case systools_make:get_release(BaseRelFile, Path, ModTest) of + %% + %% NameVsnApps = [{{Name, Vsn}, #application}] + {ok, _, NameVsnApps, Warns} -> + %% + %% NApps = [#application] + NApps = lists:map(fun({_,App}) -> App end, NameVsnApps), + {NApps, Warns ++ Ws1}; + Other -> + throw(Other) + end, + + RUs2 = RUs1, + + {RUs3, Ws3} = create_add_app_scripts(TopRel, BaseRel, RUs2, Ws2), + + {RUs4, Ws4} = create_remove_app_scripts(TopRel, BaseRel, RUs3, Ws3), + + {RUs5, Ws5} = check_for_emulator_restart(TopRel, BaseRel, + RUs4, Ws4, Opts), + + case systools_rc:translate_scripts(dn, RUs5, BaseApps, TopApps) of + {ok, RUs} -> + VDR = {BaseRel#release.vsn, + extract_description(BaseRelDc), RUs}, + foreach_baserel_dn(TopRel, TopApps, BaseRelDcs, Path, + Opts, Ws5, [VDR| Acc]); + XXX -> + throw(XXX) + end; +foreach_baserel_dn( _, _, [], _, _, Ws, Acc) -> + {Acc, Ws}. + + +%% check_for_emulator_restart(Rel1, Rel2, RUs, Ws, Opts) -> {NRUs, NWs} +%% +%% Rel1 = Rel2 = #release +%% +check_for_emulator_restart(#release{erts_vsn = Vsn1, name = N1}, + #release{erts_vsn = Vsn2, name = N2}, RUs, Ws, + _Opts) when Vsn1 /= Vsn2 -> + {RUs++[[restart_new_emulator]], [{erts_vsn_changed, {N1, N2}} | Ws]}; +check_for_emulator_restart(_, _, RUs, Ws, Opts) -> + case get_opt(restart_emulator, Opts) of + true -> {RUs++[[restart_new_emulator]], Ws}; + _ -> {RUs, Ws} + end. + +%% collect_appup_scripts(Mode, TopApps, BaseRel, Ws, RUs) -> {NRUs, NWs} +%% Mode = up | dn +%% TopApps = [#application] +%% BaseRel = #release +%% +%% Gets the script corresponding to Mode and BaseRel in the .appup file +%% for each application. +%% +collect_appup_scripts(Mode, [TopApp|TopApps], BaseRel, Ws, RUs) -> + + case lists:keysearch(TopApp#application.name, 1, + BaseRel#release.applications) of + {value, {_Name, BaseVsn, _Type}} -> + %% io:format("collect appup script: ~p~n", + %% [TopApp#application.name]), + if + TopApp#application.vsn == BaseVsn -> + %% Same version: nothing to do. + collect_appup_scripts(Mode, TopApps, BaseRel, Ws, RUs); + true -> + %% We must have an upgrade script for BaseVsn + {RU1s, Ws1} = get_script_from_appup(Mode, TopApp, BaseVsn, + Ws, RUs), + collect_appup_scripts(Mode, TopApps, BaseRel, Ws1, RU1s) + end; + false -> + collect_appup_scripts(Mode, TopApps, BaseRel, Ws, RUs) + end; +collect_appup_scripts(_, [], _, Ws, RUs) -> {RUs, Ws}. + + +%% create_add_app_scripts(FromRel, ToRel, RU0s, W0s) -> {RUs, Ws} +%% +%% FromRel = ToRel = #release +%% ToApps = [#application] +%% +create_add_app_scripts(FromRel, ToRel, RU0s, W0s) -> + AddedNs = [N || {N, _V, _T} <- ToRel#release.applications, + not lists:keymember(N, 1, FromRel#release.applications)], + %% io:format("Added apps: ~p~n", [AddedNs]), + RUs = [[{add_application, N}] || N <- AddedNs], + {RUs ++ RU0s, W0s}. + + +%% create_remove_app_scripts(FromRel, ToRel, RU0s, W0s) -> {RUs, Ws} +%% +%% FromRel = ToRel = #release +%% ToApps = [#application] +%% +%% XXX ToApps not used. +%% +create_remove_app_scripts(FromRel, ToRel, RU0s, W0s) -> + RemovedNs = [N || {N, _V, _T} <- FromRel#release.applications, + not lists:keymember(N, 1, ToRel#release.applications)], + %% io:format("Removed apps: ~p~n", [RemovedNs]), + RUs = [[{remove_application, N}] || N <- RemovedNs], + {RUs ++ RU0s, W0s}. + +%% get_script_from_appup(Mode, TopApp, BaseVsn, Ws, RUs) -> {NRUs, NWs} +%% Mode = up | dn +%% TopApp = #application +%% +%% XXX We do not operate on Ws and RUs, we just return (possibly) one +%% warning, and one script. Remove the Ws And RUs arguments and return +%% only what is relevant. +%% +get_script_from_appup(Mode, TopApp, BaseVsn, Ws, RUs) -> + FName = filename:join([TopApp#application.dir, + to_list(TopApp#application.name) ++ ".appup"]), + {VsnRUs, TopVsn} = case systools_lib:read_term(FName) of + {ok, {TopVsn0, UpVsnRUs, DnVsnRUs}} -> + VsnRUs0 = case Mode of + up -> + UpVsnRUs; + dn -> + DnVsnRUs + end, + {VsnRUs0, TopVsn0}; + X -> + throw({error, ?MODULE, {file_problem, + {FName, X}}}) + end, + Ws1 = if + TopApp#application.vsn == TopVsn -> + Ws; + true -> + %% XXX Why is this a warning only? + [{bad_vsn, {TopVsn, TopApp#application.vsn}}| Ws] + end, + case lists:keysearch(BaseVsn, 1, VsnRUs) of + {value, {_, RU}} -> + {RUs ++ [RU], Ws1}; + _ -> + throw({error, ?MODULE, {no_relup, FName, TopApp, BaseVsn}}) + end. + + +%% Primitives for the "lists of release names" that we upgrade from +%% and to. +extract_filename({N, _D}) -> to_list(N); +extract_filename(N) -> to_list(N). + +extract_description({_N, D}) -> D; +extract_description(_) -> []. + +to_list(X) when is_atom(X) -> atom_to_list(X); +to_list(X) when is_list(X) -> X. + + +%% write_relup_file(Relup, Opts) -> {ok. Relup} +%% +%% Writes a relup file. +%% +write_relup_file(Relup, Opts) -> + case get_opt(noexec, Opts) of + true -> + ok; + _ -> + Filename = case get_opt(outdir, Opts) of + OutDir when is_list(OutDir) -> + filename:join(filename:absname(OutDir), + "relup"); + false -> + "relup"; + Badarg -> + throw({error, ?MODULE, {badarg, {outdir,Badarg}}}) + end, + + case file:open(Filename, [write]) of + {ok, Fd} -> + io:format(Fd, "~p.~n", [Relup]), + file:close(Fd); + {error, Reason} -> + throw({error, ?MODULE, {file_problem, {"relup", Reason}}}) + end + end, + {ok, Relup}. + +add_code_path(Opts) -> + case get_opt(path, Opts) of + false -> + code:get_path(); + Paths0 -> + Paths1 = [to_list(P) || P <- Paths0], + %% Allow wild-card expansion. + Paths2 = systools_lib:get_path(Paths1), + make_set(Paths2 ++ code:get_path()) + end. + +get_opt(Opt, Opts) -> + case lists:keysearch(Opt, 1, Opts) of + {value, {_, Val}} -> Val; + _ -> + case lists:member(Opt, Opts) of + true -> true; + _ -> default(Opt) + end + end. + +%% make elements in list unique without rearranging the +%% elements. +%% +%% XXX Not very efficient. +%% +make_set([]) -> []; +make_set([H|T]) -> + [H | [ Y || Y<- make_set(T), + Y =/= H]]. + +default(path) -> false; +default(noexec) -> false; +default(silent) -> false; +default(restart_emulator) -> false; +default(outdir) -> false. + +print_error({'EXIT', Err}) -> + print_error(Err); +print_error({error, Mod, Error}) -> + S = apply(Mod, format_error, [Error]), + io:format(S, []); +print_error(Other) -> + io:format("Error: ~p~n", [Other]). + +format_error({file_problem, {"relup", _Posix}}) -> + io_lib:format("Could not open file relup~n", []); +format_error({file_problem, {File, What}}) -> + io_lib:format("Could not ~p file ~p~n", [get_reason(What), File]); +format_error({no_relup, File, App, Vsn}) -> + io_lib:format("No release upgrade script entry for ~p-~s to ~p-~s " + "in file ~p~n", + [App#application.name, App#application.vsn, + App#application.name, Vsn, File]); + +format_error(Error) -> + io:format("~p~n", [Error]). + + +print_warnings(Ws) when is_list(Ws) -> + lists:foreach(fun(W) -> print_warning(W) end, Ws); +print_warnings(W) -> + print_warning(W). + +print_warning(W) -> + S = format_warning(W), + io:format("~s", [S]). + +format_warning({erts_vsn_changed, {Rel1, Rel2}}) -> + io_lib:format("*WARNING* The ERTS version changed between ~p and ~p~n", + [Rel1, Rel2]); +format_warning(What) -> + io_lib:format("*WARNING* ~p~n",[What]). + + +get_reason({error, {open, _, _}}) -> open; +get_reason({error, {read, _, _}}) -> read; +get_reason({error, {parse, _, _}}) -> parse; +get_reason({error, {open, _}}) -> open; +get_reason({error, {read, _}}) -> read; +get_reason({error, {parse, _}}) -> parse; +get_reason({open, _}) -> open; +get_reason({read, _}) -> read; +get_reason({parse, _}) -> parse; +get_reason(open) -> open; +get_reason(read) -> read; +get_reason(parse) -> parse. |