%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1996-2010. 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) ->
call({unpack_release, ReleaseName}).
%%-----------------------------------------------------------------
%% 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) ->
call({check_install_release, Vsn}).
%%-----------------------------------------------------------------
%% 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) ->
call({install_release, Vsn, restart, []}).
install_release(Vsn, Opt) ->
case check_install_options(Opt, restart, []) of
{ok, ErrorAction, InstallOpt} ->
call({install_release, Vsn, ErrorAction, InstallOpt});
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) ->
call({make_permanent, Vsn}).
%%-----------------------------------------------------------------
%% Purpose: Reboots the system from an old release.
%%-----------------------------------------------------------------
reboot_old_release(Vsn) ->
call({reboot_old_release, Vsn}).
%%-----------------------------------------------------------------
%% 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) ->
call({remove_release, Vsn}).
%%-----------------------------------------------------------------
%% 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) ->
call({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) ->
call({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) ->
call({install_file, File, Vsn}).
%%-----------------------------------------------------------------
%% Returns: [{Name, Vsn, [LibName], Status}]
%% Status = unpacked | current | permanent | old
%%-----------------------------------------------------------------
which_releases() ->
call(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(Request) -> Term
%%-----------------------------------------------------------------
call(Req) ->
gen_server:call(release_handler, Req, infinity).
%%-----------------------------------------------------------------
%% 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.
