aboutsummaryrefslogtreecommitdiffstats
path: root/lib/sasl/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/sasl/src')
-rw-r--r--lib/sasl/src/Makefile100
-rw-r--r--lib/sasl/src/alarm_handler.erl95
-rw-r--r--lib/sasl/src/erlsrv.erl420
-rw-r--r--lib/sasl/src/format_lib_supp.erl224
-rw-r--r--lib/sasl/src/misc_supp.erl106
-rw-r--r--lib/sasl/src/overload.erl224
-rw-r--r--lib/sasl/src/rb.erl697
-rw-r--r--lib/sasl/src/rb_format_supp.erl155
-rw-r--r--lib/sasl/src/release_handler.erl1906
-rw-r--r--lib/sasl/src/release_handler_1.erl647
-rw-r--r--lib/sasl/src/sasl.app.src46
-rw-r--r--lib/sasl/src/sasl.appup.src25
-rw-r--r--lib/sasl/src/sasl.erl162
-rw-r--r--lib/sasl/src/sasl_report.erl135
-rw-r--r--lib/sasl/src/sasl_report_file_h.erl60
-rw-r--r--lib/sasl/src/sasl_report_tty_h.erl50
-rw-r--r--lib/sasl/src/si.erl168
-rw-r--r--lib/sasl/src/si_sasl_supp.erl373
-rw-r--r--lib/sasl/src/systools.erl109
-rw-r--r--lib/sasl/src/systools.hrl71
-rw-r--r--lib/sasl/src/systools_lib.erl219
-rw-r--r--lib/sasl/src/systools_make.erl2155
-rw-r--r--lib/sasl/src/systools_rc.erl1044
-rw-r--r--lib/sasl/src/systools_relup.erl560
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.