release handling

Martin Bjorklund mbj@REDACTED
Wed Oct 11 10:32:11 CEST 2000


Sean Hinde <Sean.Hinde@REDACTED> wrote:
> First I hacked systools:make_tar/1 to get it to make a tar file just
> containing the new SNMP version ignoring all the dependencies.

Background: systools:make_tar/1 creates a new release package,
including the 'relup' file, emulator (optional).  This package can be
used as an initial release, or to upgrade a running system.  However,
it always contains all applications, even the apps which are not
changed.  Thus, the package is unnecessry large for small upgrades.

I think it would be great with an option to exclude all unchanged
apps.  If you have added such an option, and you'd like to share it, I
think it should be included in the next OTP release.

At bluetail, we use make_tar to create the (large) package, then we
have a script which unpacks the tar file, removes the unchanged apps,
and packs everything together again.  (BTW, this has to be done in
erlang, since the package will be unpacked with erl_tar, which can't
handle tar files created with the std tar in linux :(  )

> We created a new directory underneath releases with the new release name,
> and changed the start_erl.data file to point to my new version.
> 
> We then did init:restart(). but got the old version back again ;-)

Yes.  init:restart() keeps the unix process, but restarts all erlang
code.  Thus, you'll get the same version.

> init:stop() followed by start uses the new version..
> 
> My question is really is there a way to make the system use the new version
> on init:restart(). without going through the entire upgrade process as
> prescribed in the manuals?

If you're using heart, do a init:reboot() instead.  It starts a new
unix process, and if you're using the start_erl scripts, you'll start
the system from the new start.boot file.

> Alternatively, has anyone found a simple mechanism to upgrade a single App
> without going through all the heartache of appup files etc?

You don't have to use the release_handler at all, if you don't want
to.  You would have to unpack the tar file yourself, make sure you've
got the new start.boot script, update the start_erl.data file, and do
a init:reboot().  In this case you'll loose the possibility to
automatically reboot from the old release, should the new one crash,
i.e. the new release will be permanent immediately.

Vance Shipley describes a manual way (see my comments below) which
uses the release_handler to unpack the release and make it permanent.

"Vance Shipley" <vances@REDACTED> wrote:
> What suprised us was that the release_handler did not
> allow us to build an initial system.  It must have a
> release upgrade specification file to complete the job
> and there doesn't seem to be a valid syntax for
> "upgrading" from nothing.

I haven't tested it, but I think that make_tar doesn't check the relup
file, so you could include an empty relup for the initial release.

> My current steps to build and install a release are (assuming
> that the we have written a Beta.rel "release resource file"
> and an sample.app "application resource file"):

[stuff deleted]

> $ vi RELEASES

> *** [ here we change the status of the new release from "unpacked"
> *** to "current"]

At bluetail, we've found this necessary as well.  I've patched the
release_handler to do this.  Actually, the release_handler could be
made much more flexible.  When it was designed we made it pretty
"static" because we simply didn't know how it would be used in the
field.  As we gain experience, I think it should be opened up.  Also,
it was designed to be one component of a larger software management
subsystem.  We didn't think (and I still don't think) that a single
app could/should be generic enough to do everything, e.g. downloading
relase packages to all nodes in the distributed system, handle C-code,
3:rd party code, user interface etc - it all depends on the
requirements of the application.

I've added a few functions to the release_handler (see the enclosed
file) which let you control it's behaviour better from such a software
management subsystem.  If more functions are needed, please add them
and share with the list.  Hopefully they'll make it into OTP...


/martin
-------------- next part --------------
%% ``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 via the world wide web 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.
%% 
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
%% AB. All Rights Reserved.''
%% 
%%     $Id: release_handler.erl,v 1.5 2000/09/27 15:04:34 mbj Exp $
%%
-module(release_handler).

-behaviour(gen_server).

%% 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, get_release_info/1,
	 which_releases/0, make_permanent/1, reboot_old_release/1,
	 reboot_unpacked_release/1, reboot_release/2, prepare_reboot_release/2,
	 set_unpacked/2, set_removed/1, set_tmp_current/1,
	 install_file/2]).

%% Internal exports
-export([init/1, handle_call/3, handle_info/2, terminate/2]).

%% 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.gz>
%%       |            |
%%       |            |- 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.gz))
%% 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(_Opt) -> false.

check_timeout(infinity) -> true;
check_timeout(Int) when 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) ->
    reboot_release(Vsn, old).

reboot_unpacked_release(Vsn) ->
    reboot_release(Vsn, unpacked).

reboot_release(Vsn, Status) ->
    gen_server:call(release_handler, {reboot_release, Vsn, true, Status},
		    infinity).

%% Leave it up to the caller to perform the reboot
%% Status = old | unpacked | any
prepare_reboot_release(Vsn, Status) ->
    gen_server:call(release_handler, {reboot_release, Vsn, false, Status},
		    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}).

%%-----------------------------------------------------------------
%% Args: Vsn = string()
%% Purpose: Makes it possible to handle installation of releases
%%          outside the release_handler.
%% Returns: ok | {error, Reason}
%%-----------------------------------------------------------------
set_tmp_current(Vsn) ->
    gen_server:call(release_handler, {set_tmp_current, 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 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).

%%-----------------------------------------------------------------
%% Returns: {ok, {Name, EVsn, Status}} | 
%%          {error, {no_such_release, Vsn}
%%          Status = unpacked | current | permanent | old
%%-----------------------------------------------------------------
get_release_info(Vsn) ->
    gen_server:call(release_handler, {get_release_info, Vsn}).

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

%%-----------------------------------------------------------------
%% 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 list(Found2) ->
		{do_check, Found2};
	    _ ->
		{no_check, filename:join([Root, "bin", "start"])}
	end,
    Static =
	case application:get_env(static_emulator) of
	    {ok, SFlag} when 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} ->
	    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_release, Vsn, DoReboot, Status}, From, S) ->
    case catch do_reboot_release(S, Vsn, Status) of
	{ok, _Releases} when DoReboot == true ->
	    gen_server:reply(From, ok),
	    init:reboot(),
	    {noreply, S};
	{ok, Releases} ->
	    {reply, ok, S#state{releases = Releases}}; 
	{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) ->
    Root = S#state.root,
    case catch do_set_removed(Root, 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({set_tmp_current, Vsn}, _From, S) ->
    Root = S#state.root,
    case catch do_set_tmp_current(Root, 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};

handle_call({get_release_info, Vsn}, _From, S) ->
    Reply = 
	case lists:keysearch(Vsn, #release.vsn, S#state.releases) of
	    {value, #release{name = Name, erts_vsn = EVsn, status = Status}} ->
		{ok, {Name, EVsn, Status}};
	    _ ->
		{error, {no_such_release, Vsn}}
	end,
    {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, S) ->
    error_logger:info_msg("release_handler: got unknown message: ~p~n", [Msg]),
    {noreply, S}.

terminate(_Reason, S) ->
    ok.

%%%-----------------------------------------------------------------
%%% 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 atom(A) -> atom_list(T);
atom_list([])                 -> true;
atom_list(_)                  -> false.

int_list([I|T]) when 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.gz 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, erts_vsn = EVsn} = 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"),
    Rel = filename:join(RelDir, ReleaseName ++ ".rel"),
    file:delete(Tar),
    file:delete(Rel),
    case os:type() of
	{unix, _} ->
	    Z = Tar ++ ".gz",
	    file:delete(Z);
	_ ->
	    ok
    end.
   
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, {LineNo, Mod, 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) ->
			  case LibSpec of
			      {Lib, LibVsn} -> ok;
			      {Lib, LibVsn, _Subapps} -> ok;
			      {Lib, LibVsn, _AppType, _Subapps} -> ok
			  end,
			  LibName = lists:concat([Lib, "-", LibVsn]),
			  LibDir = 
			      case lists:keysearch(Lib, 1, LibDirs) of
				  {value, {_Lib, _Vsn, Dir}} ->
				      filename:join(Dir, LibName);
				  _ ->
				      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}}).

    
do_check_install_release(RelDir, Vsn, Releases, Masters) ->
    LatestRelease = get_latest_release(Releases),
    case lists:keysearch(Vsn, #release.vsn, Releases) of
	{value, LatestRelease} ->
	    {error, {already_installed, Vsn}};
	{value, Release} ->
	    VsnDir = filename:join([RelDir, Vsn]),
	    check_file(filename:join(VsnDir, "start.boot"), regular, Masters),
%	    check_file(filename:join(VsnDir, "relup"), regular, Masters),
	    check_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),
	    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;
	_ ->
	    {error, {no_such_release, Vsn}}
    end.
	    
do_install_release(#state{start_prg = StartPrg, root = Root,
			  rel_dir = RelDir, releases = Releases,
			  masters = Masters,
			  static_emulator = Static},
		   Vsn, Opts) ->
    LatestRelease = get_latest_release(Releases),
    case lists:keysearch(Vsn, #release.vsn, Releases) of
	{value, LatestRelease} ->
	    {error, {already_installed, Vsn}};
	{value, Release} ->
	    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),
		    os:putenv("ERLSRV_SERVICE_NAME", Name),
		    heart:cycle(),
		    ok;
		Error4 ->
		    throw(Error4)
	    end
    end.
	    
do_make_permanent(#state{root = Root, releases = Releases,
			 rel_dir = RelDir, unpurged = Unpurged,
			 masters = Masters, client_dir = CliDir,
			 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, CliDir, 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} ->
			    {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_release(#state{root = Root, releases = Releases,
			 rel_dir = RelDir, masters = Masters,
			 client_dir = CliDir, static_emulator = Static},
		  Vsn, Status) ->
    case lists:keysearch(Vsn, #release.vsn, Releases) of
	{value, #release{erts_vsn = EVsn, status = Status2}} 
	  when Status == Status2;
	       Status == any ->
	    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, CliDir, 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, NewReleases};
	{value, #release{status = Status2}} ->
	    {error, {bad_status, Status2}};
	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, CliDir, false) ->
    write_start(filename:join([RelDir, "start_erl.data"]),
		EVsn ++ " " ++ Vsn,
		Masters);
set_permanent_files(RelDir, EVsn, Vsn, Masters, CliDir, 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, vsn = Vsn2}, 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, erts_vsn = EVsn, name = Name} = Release,
    case lists:keysearch(Vsn, #release.vsn, Releases) of
	{value, #release{status = unpacked}} -> 
	    throw({error, {already_unpacked, Vsn}});
	{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(Root, 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.

do_set_tmp_current(Root, RelDir, Vsn, Releases, Masters) ->
    %% Currently 'current' gets 'old'...
    NReleases0 = set_status(Vsn, current, Releases),
    %% Vsn gets 'tmp_current'
    NReleases1 = set_status(Vsn, tmp_current_old, NReleases0),
    write_releases(RelDir, NReleases1, Masters),
    {ok, NReleases1}.



%%-----------------------------------------------------------------
%% 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, [{Vsn, ListOfRhScripts, _}]} ->
	    case find_matching_vsn(ListOfRhScripts, CurrentVsn) of
		{ok, RhScript} -> {ok, RhScript};
		false -> error
	    end;
	{ok, _} ->
	    throw({error, {bad_relup_file, Relup}});
	{error, {LineNo, Mod, 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, {LineNo, Mod, Reason}} ->
	    throw({error, {bad_relup_file, Relup}});
	{error, enoent} ->
	    error;
	{error, FileError} -> % FileError is posix atom | no_master
	    throw({error, {FileError, Relup}})
    end.

find_matching_vsn(ListOfRhScripts, CurrentVsn) ->
    fmv(lists:reverse(lists:keysort(1, ListOfRhScripts)), CurrentVsn).

fmv([{FromVsn, Descr, RhScript} | T], CurrentVsn) ->
    case string:re_match(CurrentVsn, [$^|FromVsn]) of
	{match, _, _} -> {ok, {FromVsn, Descr, RhScript}};
	_ -> fmv(T, CurrentVsn)
    end;
fmv([H | _], CurrentVsn) ->
    throw({error, {bad_relup_syntax, H}});
fmv([], _) -> false.


%% 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:file_info(File) of
	{ok, Info} when element(2, Info) == 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;
	_ ->
	    throw({error, {no_such_file, File}})

    end.

do_write_file(File, Str) ->
    case file:open(File, write) of
	{ok, Fd} ->
	    case io:put_chars(Fd, Str) of
		ok ->
		    file:close(Fd),
		    ok;
		{error, Reason} ->
		    file:close(Fd),
		    {error, {Reason, File}}
	    end;
	{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) ->
    {ok, [Cmd | _Args]} = regexp:split(StartPrg, " "),
    check_file(Cmd, 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) when Release#release.status == tmp_current_old ->
		Release#release{status = old};
	   (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) when Release#release.status == tmp_current_old ->
			 case init:script_id() of
			     {Name, Vsn} when Release#release.vsn == Vsn ->
				 Release#release{status = current};
			     _ ->
				 Release#release{status = old}
			 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_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:file_info(FileName) of
	{ok,{_,Type,_,_,_,_,_}} -> ok;
	{error, _Reason} -> throw({error, {no_such_file, FileName}})
    end.

do_check_file(Master, FileName, Type) ->
    case rpc:call(Master, file, file_info, [FileName]) of
	{ok,{_,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, {write_releases, 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: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.


More information about the erlang-questions mailing list