From c70ca686fe269db6079a2ca1c7e09cdfc0cfa903 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Mon, 5 Sep 2016 16:16:23 +0200
Subject: Don't leak old code when loading a modules with an on_load function

Normally, calling code:delete/1 before re-loading the code for a
module is unnecessary but causes no problem.

But there will be be problems if the new code has an on_load function.
Code with an on_load function will always be loaded as old code
to allowed it to be easily purged if the on_load function would fail.
If the on_load function succeeds, the old and current code will be
swapped.

So in the scenario where code:delete/1 has been called explicitly,
there is old code but no current code. Loading code with an
on_load function will cause the reference to the old code to be
overwritten. That will at best cause a memory leak, and at worst
an emulator crash (especially if NIFs are involved).

To avoid that situation, we will put the code with the on_load
function in a special, third slot in Module.

ERL-240
---
 lib/kernel/src/code_server.erl |  3 +-
 lib/kernel/test/code_SUITE.erl | 94 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 95 insertions(+), 2 deletions(-)

(limited to 'lib')

diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 48541ec500..38c1169308 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -1382,11 +1382,10 @@ finish_on_load(PidRef, OnLoadRes, #state{on_load=OnLoad0}=St0) ->
 
 finish_on_load_1(Mod, OnLoadRes, Waiting, St) ->
     Keep = OnLoadRes =:= ok,
-    erlang:finish_after_on_load(Mod, Keep),
+    erts_code_purger:finish_after_on_load(Mod, Keep),
     Res = case Keep of
 	      false ->
 		  _ = finish_on_load_report(Mod, OnLoadRes),
-		  _ = erts_code_purger:purge(Mod),
 		  {error,on_load_failure};
 	      true ->
 		  {module,Mod}
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 8da67c89f8..c5167efa56 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -36,6 +36,7 @@
 	 code_archive/1, code_archive2/1, on_load/1, on_load_binary/1,
 	 on_load_embedded/1, on_load_errors/1, on_load_update/1,
 	 on_load_purge/1, on_load_self_call/1, on_load_pending/1,
+	 on_load_deleted/1,
 	 big_boot_embedded/1,
 	 native_early_modules/1, get_mode/1,
 	 normalized_paths/1]).
@@ -66,6 +67,7 @@ all() ->
      bad_erl_libs, code_archive, code_archive2, on_load,
      on_load_binary, on_load_embedded, on_load_errors, on_load_update,
      on_load_purge, on_load_self_call, on_load_pending,
+     on_load_deleted,
      big_boot_embedded, native_early_modules, get_mode, normalized_paths].
 
 groups() ->
@@ -1602,6 +1604,98 @@ on_load_pending(_Config) ->
     ok = Mod:t(),
     ok.
 
+on_load_deleted(_Config) ->
+    Mod = ?FUNCTION_NAME,
+
+    R0 = fun() ->
+		 Tree = ?Q(["-module('@Mod@').\n",
+			    "-on_load(f/0).\n",
+			    "f() -> ok.\n"]),
+		 merl:print(Tree),
+		 {ok,Mod,Code} = merl:compile(Tree),
+		 {module,Mod} = code:load_binary(Mod, "", Code)
+	 end,
+    delete_before_reload(Mod, R0),
+    delete_before_reload(Mod, R0),
+
+    R1 = fun() ->
+		 Tree = ?Q(["-module('@Mod@').\n",
+			    "-on_load(f/0).\n",
+			    "f() -> fail.\n"]),
+		 merl:print(Tree),
+		 {ok,Mod,Code} = merl:compile(Tree),
+		 {error,on_load_failure} = code:load_binary(Mod, "", Code)
+	 end,
+    delete_before_reload(Mod, R1),
+    delete_before_reload(Mod, R1),
+
+    OtherMod = list_to_atom(lists:concat([Mod,"_42"])),
+    OtherTree = ?Q(["-module('@OtherMod@').\n"]),
+    merl:print(OtherTree),
+    {ok,OtherMod,OtherCode} = merl:compile(OtherTree),
+
+    R2 = fun() ->
+		 RegName = 'on_load__registered_name',
+		 Tree = ?Q(["-module('@Mod@').\n",
+			    "-on_load(f/0).\n",
+			    "f() ->\n",
+			    "  register('@RegName@', self()),\n",
+			    "  receive _ -> ok end.\n"]),
+		 merl:print(Tree),
+		 {ok,Mod,Code} = merl:compile(Tree),
+		 spawn(fun() ->
+			       {module,Mod} = code:load_binary(Mod, "", Code)
+		       end),
+		 receive after 1 -> ok end,
+		 {module,OtherMod} = code:load_binary(OtherMod, "",
+						      OtherCode),
+		 RegName ! stop
+	 end,
+    delete_before_reload(Mod, R2),
+
+    ok.
+
+delete_before_reload(Mod, Reload) ->
+    false = check_old_code(Mod),
+
+    Tree1 = ?Q(["-module('@Mod@').\n",
+		"-export([f/1]).\n",
+		"f(Parent) ->\n",
+		"  register('@Mod@', self()),\n",
+		"  Parent ! started,\n",
+		"  receive _ -> ok end.\n"]),
+    merl:print(Tree1),
+    {ok,Mod,Code1} = merl:compile(Tree1),
+
+    Self = self(),
+    spawn(fun() ->
+		  {module,Mod} = code:load_binary(Mod, "", Code1),
+		  Mod:f(Self)
+	  end),
+    receive started -> ok end,
+
+    true = code:delete(Mod),
+    true = check_old_code(Mod),
+
+    Reload(),
+
+    %% When loading the the module with the -on_load() function,
+    %% the reference to the old code would be lost. Make sure that
+    %% the old code is remembered and is still preventing the
+    %% purge.
+    false = code:soft_purge(Mod),
+
+    %% Get rid of the old code.
+    Mod ! stop,
+    receive after 1 -> ok end,
+    true = code:soft_purge(Mod),
+
+    %% Unload the version of the module with the -on_load() function.
+    true = code:delete(Mod),
+    true = code:soft_purge(Mod),
+
+    ok.
+
 
 %% Test that the native code of early loaded modules is loaded.
 native_early_modules(Config) when is_list(Config) ->
-- 
cgit v1.2.3