Merge branch 'siri/sasl/check_process_code/OTP-9395' into dev

* siri/sasl/check_process_code/OTP-9395:
  Add option purge to release_handler:check_install_release
  Improve performance of upgrade when many processes have old code

2 files changed, 106 insertions, 37 deletions

diff --git a/lib/sasl/src/release_handler.erl b/lib/sasl/src/release_handler.erl
index ab54b1d00b..4f01f5f559 100644
--- a/lib/sasl/src/release_handler.erl
+++ b/lib/sasl/src/release_handler.erl
@@ -25,8 +25,8 @@
 -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, 
+	 check_install_release/1, check_install_release/2,
+	 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,
@@ -149,15 +149,35 @@ unpack_release(ReleaseName) ->
 %%-----------------------------------------------------------------
 %% Purpose: Checks the relup script for the specified version.
 %%          The release must be unpacked.
+%%          Options = [purge] - all old code that can be soft purged
+%%          will be purged if all checks succeeds. This can be usefull
+%%          in order to reduce time needed in the following call to
+%%          install_release.
 %% Returns: {ok, FromVsn, Descr} | {error, Reason}
-%%          Reason = {already_installed, Vsn} |
+%%          Reason = {illegal_option, IllegalOpt} |
+%%                   {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}).
+    check_install_release(Vsn, []).
+
+check_install_release(Vsn, Opts) ->
+    case check_check_install_options(Opts, false) of
+	{ok,Purge} ->
+	    call({check_install_release, Vsn, Purge});
+	Error ->
+	    Error
+    end.
+
+check_check_install_options([purge|Opts], _) ->
+    check_check_install_options(Opts, true);
+check_check_install_options([Illegal|_],Purge) ->
+    {error,{illegal_option,Illegal}};
+check_check_install_options([],Purge) ->
+    {ok,Purge}.
 
 
 %%-----------------------------------------------------------------
@@ -541,11 +561,12 @@ handle_call({unpack_release, ReleaseName}, _From, S)
 handle_call({unpack_release, _ReleaseName}, _From, S) ->
     {reply, {error, client_node}, S};
 
-handle_call({check_install_release, Vsn}, _From, S) ->
+handle_call({check_install_release, Vsn, Purge}, _From, S) ->
     case catch do_check_install_release(S#state.rel_dir,
 					Vsn,
 					S#state.releases,
-					S#state.masters) of
+					S#state.masters,
+					Purge) of
 	{ok, CurrentVsn, Descr} -> 
 	    {reply, {ok, CurrentVsn, Descr}, S};
 	{error, Reason}   ->
@@ -855,7 +876,7 @@ check_path_response(Path, {ok, _Info}) ->
 check_path_response(Path, {error, _Reason}) ->
 	throw({error, {no_such_directory, Path}}).
 
-do_check_install_release(RelDir, Vsn, Releases, Masters) ->
+do_check_install_release(RelDir, Vsn, Releases, Masters, Purge) ->
     case lists:keysearch(Vsn, #release.vsn, Releases) of
 	{value, #release{status = current}} ->
 	    {error, {already_installed, Vsn}};
@@ -880,7 +901,20 @@ do_check_install_release(RelDir, Vsn, Releases, Masters) ->
 		    case get_rh_script(LatestRelease, Release, RelDir, Masters) of
 			{ok, {CurrentVsn, Descr, Script}} ->
 			    case catch check_script(Script, Libs) of
-				ok ->
+				{ok,SoftPurgeMods} when Purge=:=true ->
+				    %% Get modules with brutal_purge
+				    %% instructions, but that can be
+				    %% soft purged
+				    {ok,BrutalPurgeMods} =
+					release_handler_1:check_old_processes(
+					  Script,brutal_purge),
+				    lists:foreach(
+				      fun(Mod) ->
+					      catch erlang:purge_module(Mod)
+				      end,
+				      SoftPurgeMods ++ BrutalPurgeMods),
+				    {ok, CurrentVsn, Descr};
+				{ok,_} ->
 				    {ok, CurrentVsn, Descr};
 				Else ->
 				    Else
diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl
index ff62f847ac..ef95606bb5 100644
--- a/lib/sasl/src/release_handler_1.erl
+++ b/lib/sasl/src/release_handler_1.erl
@@ -19,7 +19,8 @@
 -module(release_handler_1).
 
 %% External exports
--export([eval_script/1, eval_script/5, check_script/2]).
+-export([eval_script/1, eval_script/5,
+	 check_script/2, check_old_processes/2]).
 -export([get_current_vsn/1]). %% exported because used in a test case
 
 -record(eval_state, {bins = [], stopped = [], suspended = [], apps = [],
@@ -47,17 +48,20 @@
 %%% This is a low-level release handler.
 %%%-----------------------------------------------------------------
 check_script(Script, LibDirs) ->
-    case catch check_old_processes(Script) of
-	ok ->
+    case catch check_old_processes(Script,soft_purge) of
+	{ok, PurgeMods} ->
 	    {Before, _After} = split_instructions(Script),
 	    case catch lists:foldl(fun(Instruction, EvalState1) ->
 					   eval(Instruction, EvalState1)
 				   end,
 				   #eval_state{libdirs = LibDirs},
 				   Before) of
-		EvalState2 when is_record(EvalState2, eval_state) -> ok;
-		{error, Error} -> {error, Error};
-		Other -> {error, Other}
+		EvalState2 when is_record(EvalState2, eval_state) ->
+		    {ok,PurgeMods};
+		{error, Error} ->
+		    {error, Error};
+		Other ->
+		    {error, Other}
 	    end;
 	{error, Mod} ->
 	    {error, {old_processes, Mod}}
@@ -68,8 +72,8 @@ eval_script(Script) ->
     eval_script(Script, [], [], [], []).
 
 eval_script(Script, Apps, LibDirs, NewLibs, Opts) ->
-    case catch check_old_processes(Script) of
-	ok ->
+    case catch check_old_processes(Script,soft_purge) of
+	{ok,_} ->
 	    {Before, After} = split_instructions(Script),
 	    case catch lists:foldl(fun(Instruction, EvalState1) ->
 					   eval(Instruction, EvalState1)
@@ -112,32 +116,63 @@ split_instructions([], Before) ->
     {[], lists:reverse(Before)}.
 
 %%-----------------------------------------------------------------
-%% Func: check_old_processes/1
+%% Func: check_old_processes/2
 %% Args: Script = [instruction()]
+%%       PrePurgeMethod = soft_purge | brutal_purge
 %% Purpose: Check if there is any process that runs an old version
-%%          of a module that should be soft_purged, (i.e. not purged
-%%          at all if there is any such process).  Returns {error, Mod}
-%%          if so, ok otherwise.
-%% Returns: ok | {error, Mod}
+%%          of a module that should be purged according to PrePurgeMethod.
+%%          Returns a list of modules that can be soft_purged.
+%%
+%%          If PrePurgeMethod == soft_purge, the function will succeed
+%%          only if there is no process running old code of any of the
+%%          modules. Else it will throw {error,Mod}, where Mod is the
+%%          first module found that can not be soft_purged.
+%%
+%%          If PrePurgeMethod == brutal_purge, the function will
+%%          always succeed and return a list of all modules that are
+%%          specified in the script with PrePurgeMethod brutal_purge,
+%%          but that can be soft_purged.
+%%
+%% Returns: {ok,PurgeMods} | {error, Mod}
+%%          PurgeMods = [Mod]
 %%          Mod = atom()  
 %%-----------------------------------------------------------------
-check_old_processes(Script) ->
-    lists:foreach(fun({load, {Mod, soft_purge, _PostPurgeMethod}}) ->
-			  check_old_code(Mod);
-		     ({remove, {Mod, soft_purge, _PostPurgeMethod}}) ->
-			  check_old_code(Mod);
-		     (_) -> ok
-		  end,
-		  Script).
+check_old_processes(Script,PrePurgeMethod) ->
+    Procs = erlang:processes(),
+    {ok,lists:flatmap(
+	  fun({load, {Mod, PPM, _PostPurgeMethod}}) when PPM==PrePurgeMethod ->
+		  check_old_code(Mod,Procs,PrePurgeMethod);
+	     ({remove, {Mod, PPM, _PostPurgeMethod}}) when PPM==PrePurgeMethod ->
+		  check_old_code(Mod,Procs,PrePurgeMethod);
+	     (_) -> []
+	  end,
+	  Script)}.
+
+check_old_code(Mod,Procs,PrePurgeMethod) ->
+    case erlang:check_old_code(Mod) of
+	true when PrePurgeMethod==soft_purge ->
+	    do_check_old_code(Mod,Procs);
+	true when PrePurgeMethod==brutal_purge ->
+	    case catch do_check_old_code(Mod,Procs) of
+		{error,Mod} -> [];
+		R -> R
+	    end;
+	false ->
+	    []
+    end.
+
+
+do_check_old_code(Mod,Procs) ->
+    lists:foreach(
+      fun(Pid) ->
+	      case erlang:check_process_code(Pid, Mod) of
+		  false -> ok;
+		  true -> throw({error, Mod})
+	      end
+      end,
+      Procs),
+    [Mod].
 
-check_old_code(Mod) ->
-    lists:foreach(fun(Pid) ->
-			  case erlang:check_process_code(Pid, Mod) of
-			      false -> ok;
-			      true -> throw({error, Mod})
-			  end
-		  end,
-		  erlang:processes()).
 
 %%-----------------------------------------------------------------
 %% An unpurged module is a module for which there exist an old