diff options
Diffstat (limited to 'lib/sasl/src/release_handler.erl')
| -rw-r--r-- | lib/sasl/src/release_handler.erl | 1906 |
1 files changed, 1906 insertions, 0 deletions
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. |