aboutsummaryrefslogtreecommitdiffstats
path: root/lib/sasl/src/release_handler.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/sasl/src/release_handler.erl')
-rw-r--r--lib/sasl/src/release_handler.erl1906
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.