erts: Make erlang:purge_module/1 safe

Problem: erlang:purge_module/1 is not safe in the sense
that very bad things may happen if the code to be purged
is still referred to by live processes.

Introduce erts_internal:purge_module which is the same as the old
erlang:purge_module BIF (except it returns false if no such old module).

Implement erlang:purge_module in Erlang and let it invoke
erts_code_purger for safe purging where all clogging processes
first are killed.

11 files changed, 49 insertions, 24 deletions

diff --git a/erts/emulator/beam/beam_bif_load.c b/erts/emulator/beam/beam_bif_load.c
index 6bb70cc5a7..014ee35fd0 100644
--- a/erts/emulator/beam/beam_bif_load.c
+++ b/erts/emulator/beam/beam_bif_load.c
@@ -1094,7 +1094,12 @@ static void copy_literals_commit(void* null) {
 #endif /* ERTS_SMP */
 
 
-BIF_RETTYPE purge_module_1(BIF_ALIST_1)
+/* Do the actualy module purging and return:
+ * true for success
+ * false if no such old module
+ * BADARG if not an atom
+ */
+BIF_RETTYPE erts_internal_purge_module_1(BIF_ALIST_1)
 {
     ErtsCodeIndex code_ix;
     BeamInstr* code;
@@ -1108,7 +1113,8 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
     }
 
     if (!erts_try_seize_code_write_permission(BIF_P)) {
-	ERTS_BIF_YIELD1(bif_export[BIF_purge_module_1], BIF_P, BIF_ARG_1);
+	ERTS_BIF_YIELD1(bif_export[BIF_erts_internal_purge_module_1],
+                        BIF_P, BIF_ARG_1);
     }
 
     code_ix = erts_active_code_ix();
@@ -1118,7 +1124,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
      */
 
     if ((modp = erts_get_module(BIF_ARG_1, code_ix)) == NULL) {
-	ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+        ERTS_BIF_PREP_RET(ret, am_false);
     }
     else {
 	erts_rwlock_old_code(code_ix);
@@ -1127,7 +1133,7 @@ BIF_RETTYPE purge_module_1(BIF_ALIST_1)
 	 * Any code to purge?
 	 */
 	if (!modp->old.code_hdr) {
-	    ERTS_BIF_PREP_ERROR(ret, BIF_P, BADARG);
+            ERTS_BIF_PREP_RET(ret, am_false);
 	}
 	else {
 	    /*
diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab
index 0aee8681c6..3b95ec508c 100644
--- a/erts/emulator/beam/bif.tab
+++ b/erts/emulator/beam/bif.tab
@@ -125,7 +125,6 @@ bif erlang:process_flag/3
 bif erlang:process_info/1
 bif erlang:process_info/2
 bif erlang:processes/0
-bif erlang:purge_module/1
 bif erlang:put/2
 bif erlang:register/2
 bif erlang:registered/0
@@ -643,6 +642,7 @@ bif erts_debug:map_info/1
 #
 
 bif erlang:copy_literals/2
+bif erts_internal:purge_module/1
 bif binary:split/2
 bif binary:split/3
 bif erts_debug:size_shared/1
diff --git a/erts/preloaded/ebin/erlang.beam b/erts/preloaded/ebin/erlang.beam
index 68578c3a49..4353e115ca 100644
--- a/erts/preloaded/ebin/erlang.beam
+++ b/erts/preloaded/ebin/erlang.beam
diff --git a/erts/preloaded/ebin/erts_code_purger.beam b/erts/preloaded/ebin/erts_code_purger.beam
index adfe298a44..553b34b105 100644
--- a/erts/preloaded/ebin/erts_code_purger.beam
+++ b/erts/preloaded/ebin/erts_code_purger.beam
diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam
index 4e1cb7f8a0..150e76505d 100644
--- a/erts/preloaded/ebin/erts_internal.beam
+++ b/erts/preloaded/ebin/erts_internal.beam
diff --git a/erts/preloaded/ebin/init.beam b/erts/preloaded/ebin/init.beam
index a44b022931..b6d1df7bbc 100644
--- a/erts/preloaded/ebin/init.beam
+++ b/erts/preloaded/ebin/init.beam
diff --git a/erts/preloaded/src/erlang.erl b/erts/preloaded/src/erlang.erl
index d9dc9a1976..ab54d716cc 100644
--- a/erts/preloaded/src/erlang.erl
+++ b/erts/preloaded/src/erlang.erl
@@ -1471,8 +1471,16 @@ processes() ->
 %% purge_module/1
 -spec purge_module(Module) -> true when
       Module :: atom().
-purge_module(_Module) ->
-    erlang:nif_error(undefined).
+purge_module(Module) when erlang:is_atom(Module) ->
+    case erts_code_purger:purge(Module) of
+	{false, _} ->
+	    erlang:error(badarg, [Module]);
+	{true, _} ->
+	    true
+    end;
+purge_module(Arg) ->
+    erlang:error(badarg, [Arg]).
+
 
 %% put/2
 -spec put(Key, Val) -> term() when
diff --git a/erts/preloaded/src/erts_code_purger.erl b/erts/preloaded/src/erts_code_purger.erl
index 6bb6e4fcdc..880c86aad1 100644
--- a/erts/preloaded/src/erts_code_purger.erl
+++ b/erts/preloaded/src/erts_code_purger.erl
@@ -70,12 +70,8 @@ do_purge(Mod) ->
             true = erlang:copy_literals(Mod, true),
             DidKill = check_proc_code(erlang:processes(), Mod, true),
             true = erlang:copy_literals(Mod, false),
-            try
-                erlang:purge_module(Mod)
-            catch
-                _:_ -> ignore
-            end,
-            {true, DidKill}
+	    WasPurged = erts_internal:purge_module(Mod),
+            {WasPurged, DidKill}
     end.
 
 %% soft_purge(Module)
@@ -104,11 +100,7 @@ do_soft_purge(Mod) ->
 		    false;
 		true ->
                     true = erlang:copy_literals(Mod, false),
-		    try
-			erlang:purge_module(Mod)
-		    catch
-			_:_ -> ignore
-		    end,
+		    erts_internal:purge_module(Mod),
 		    true
 	    end
     end.
diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl
index 426749264f..6e649e8395 100644
--- a/erts/preloaded/src/erts_internal.erl
+++ b/erts/preloaded/src/erts_internal.erl
@@ -38,6 +38,7 @@
 -export([request_system_task/3]).
 
 -export([check_process_code/2]).
+-export([purge_module/1]).
 
 -export([flush_monitor_messages/3]).
 
@@ -204,6 +205,11 @@ request_system_task(_Pid, _Prio, _Request) ->
 check_process_code(_Module, _OptionList) ->
     erlang:nif_error(undefined).
 
+-spec purge_module(Module) -> boolean() when
+      Module :: module().
+purge_module(_Module) ->
+    erlang:nif_error(undefined).
+
 %% term compare where integer() < float() = true
 
 -spec cmp_term(A,B) -> Result when
diff --git a/erts/preloaded/src/init.erl b/erts/preloaded/src/init.erl
index 383c4a1ec6..ed65c57c0d 100644
--- a/erts/preloaded/src/init.erl
+++ b/erts/preloaded/src/init.erl
@@ -636,9 +636,9 @@ unload(_) ->
     do_unload(sub([heart|erlang:pre_loaded()],erlang:loaded())).
 
 do_unload([M|Mods]) ->
-    catch erlang:purge_module(M),
+    catch erts_internal:purge_module(M),
     catch erlang:delete_module(M),
-    catch erlang:purge_module(M),
+    catch erts_internal:purge_module(M),
     do_unload(Mods);
 do_unload([]) ->
     purge_all_hipe_refs(),
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 071f8d1d3b..772a1e6b14 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -380,8 +380,23 @@ purge(Config) when is_list(Config) ->
 
 purge_many_exits(Config) when is_list(Config) ->
     OldFlag = process_flag(trap_exit, true),
+
     code:purge(code_b_test),
     {'EXIT',_} = (catch code:purge({})),
+
+    CodePurgeF = fun(M, Exp) -> Exp = code:purge(M) end,
+    purge_many_exits_do(CodePurgeF),
+
+    %% Let's repeat test for erlang:purge_module as it does the same thing
+    %% now in erts-8.0 (except for return value).
+    ErlangPurgeF = fun(M, _Exp) -> erlang:purge_module(M) end,
+    purge_many_exits_do(ErlangPurgeF),
+
+    process_flag(trap_exit, OldFlag),
+    ok.
+
+
+purge_many_exits_do(PurgeF) ->
     false = code:purge(code_b_test),
     TPids = lists:map(fun (_) ->
 			      {code_b_test:do_spawn(),
@@ -400,7 +415,7 @@ purge_many_exits(Config) when is_list(Config) ->
 			  false = code_b_test:check_exit(Pid1),
 			  true = erlang:is_process_alive(Pid2)
 		  end, TPids),
-    true = code:purge(code_b_test),
+    PurgeF(code_b_test, true),
     lists:foreach(fun ({Pid1, Pid2}) ->
 			  false = erlang:is_process_alive(Pid1),
 			  true = code_b_test:check_exit(Pid1),
@@ -409,9 +424,7 @@ purge_many_exits(Config) when is_list(Config) ->
 		  end, TPids),
     lists:foreach(fun ({_Pid1, Pid2}) ->
 			  receive {'EXIT', Pid2, _} -> ok end
-		  end, TPids),
-    process_flag(trap_exit, OldFlag),
-    ok.
+		  end, TPids).
 
 
 soft_purge(suite) -> [];