%%
%% %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.
