Add code:module_status/1 and modified_modules/0

These functions use the MD5 beam/native checksum to determine whether the
code for a module has changed on disk and is a candidate for loading.

3 files changed, 319 insertions, 1 deletions

diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index 3143cdc825..f881fd76fd 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -899,6 +899,48 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]),
       </desc>
     </func>
     <func>
+      <name name="module_status" arity="1"/>
+      <fsummary>Return the status of the module in relation to object file on disk.</fsummary>
+      <desc>
+	<p>Returns:</p>
+	<taglist>
+	<tag><c>not_loaded</c></tag>
+	<item><p>If <c><anno>Module</anno></c> is not currently loaded.</p></item>
+        <tag><c>loaded</c></tag>
+	<item><p>If <c><anno>Module</anno></c> is loaded and the object file
+	exists and contains the same code.</p></item>
+	<tag><c>removed</c></tag>
+	<item><p>If <c><anno>Module</anno></c> is loaded but no
+	corresponding object file can be found in the code path.</p></item>
+        <tag><c>modified</c></tag>
+	<item><p>If <c><anno>Module</anno></c> is loaded but the object file
+	contains code with a different MD5 checksum.</p></item>
+	</taglist>
+        <p>Preloaded modules are always reported as <c>loaded</c>, without
+        inspecting the contents on disk. Cover compiled modules will always
+        be reported as <c>modified</c> if an object file exists, or as
+        <c>removed</c> otherwise. Modules whose load path is an empty string
+        (which is the convention for auto-generated code) will only be
+        reported as <c>loaded</c> or <c>not_loaded</c>.</p>
+        <p>For modules that have native code loaded (see
+        <seealso marker="#is_module_native/1"><c>is_module_native/1</c></seealso>),
+        the MD5 sum of the native code in the object file is used for the
+        comparison, if it exists; the Beam code in the file is ignored.
+        Reversely, for modules that do not currently have native code
+        loaded, any native code in the file will be ignored.</p>
+        <p>See also <seealso marker="#modified_modules/0"><c>modified_modules/0</c></seealso>.</p>
+      </desc>
+    </func>
+    <func>
+      <name name="modified_modules" arity="0"/>
+      <fsummary>Return a list of all modules modified on disk.</fsummary>
+      <desc>
+        <p>Returns the list of all currently loaded modules for which
+        <seealso marker="#module_status/1"><c>module_status/1</c></seealso>
+        returns <c>modified</c>. See also <seealso marker="#all_loaded/0"><c>all_loaded/0</c></seealso>.</p>
+      </desc>
+    </func>
+    <func>
       <name name="is_module_native" arity="1"/>
       <fsummary>Test if a module has native code.</fsummary>
       <desc>
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index 0ad0676f98..5a7ca493cc 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -70,7 +70,9 @@
 	 where_is_file/2,
 	 set_primary_archive/4,
 	 clash/0,
-     get_mode/0]).
+         module_status/1,
+         modified_modules/0,
+         get_mode/0]).
 
 -deprecated({rehash,0,next_major_release}).
 
@@ -895,3 +897,97 @@ load_all_native_1([{Mod,BeamFilename}|T], ChunkTag) ->
     load_all_native_1(T, ChunkTag);
 load_all_native_1([], _) ->
     ok.
+
+%% Returns the status of the module in relation to object file on disk.
+-spec module_status(Module :: module()) -> not_loaded | loaded | modified | removed.
+module_status(Module) ->
+    module_status(Module, code:get_path()).
+
+%% Note that we don't want to go via which/1, since it doesn't look at the
+%% disk contents at all if the module is already loaded.
+module_status(Module, PathFiles) ->
+    case code:is_loaded(Module) of
+        false -> not_loaded;
+        {file, preloaded} -> loaded;
+        {file, cover_compiled} ->
+            %% cover compilation loads directly to memory and does not
+            %% create a beam file, so report 'modified' if a file exists
+            case which(Module, PathFiles) of
+                non_existing -> removed;
+                _File -> modified
+            end;
+        {file, []} -> loaded;  % no beam file - generated code
+        {file, OldFile} when is_list(OldFile) ->
+            %% we don't care whether or not the file is in the same location
+            %% as when last loaded, as long as it can be found in the path
+            case which(Module, PathFiles) of
+                non_existing -> removed;
+                Path ->
+                    case module_changed_on_disk(Module, Path) of
+                        true -> modified;
+                        false -> loaded
+                    end
+            end
+    end.
+
+%% Detects actual code changes only, e.g. to decide whether a module should
+%% be reloaded; does not care about file timestamps or compilation time
+module_changed_on_disk(Module, Path) ->
+    MD5 = erlang:get_module_info(Module, md5),
+    case erlang:system_info(hipe_architecture) of
+        undefined ->
+            %% straightforward, since native is not supported
+            MD5 =/= beam_file_md5(Path);
+        Architecture ->
+            case code:is_module_native(Module) of
+                true ->
+                    %% MD5 is for native code, so we check only the native
+                    %% code on disk, ignoring the beam code
+                    MD5 =/= beam_file_native_md5(Path, Architecture);
+                _ ->
+                    %% MD5 is for beam code, so check only the beam code on
+                    %% disk, even if the file contains native code as well
+                    MD5 =/= beam_file_md5(Path)
+            end
+    end.
+
+beam_file_md5(Path) ->
+    case beam_lib:md5(Path) of
+        {ok,{_Mod,MD5}} -> MD5;
+        _ -> undefined
+    end.
+
+beam_file_native_md5(Path, Architecture) ->
+    try
+        get_beam_chunk(Path, hipe_unified_loader:chunk_name(Architecture))
+    of
+        NativeCode when is_binary(NativeCode) ->
+            erlang:md5(NativeCode)
+    catch
+        _:_ -> undefined
+    end.
+
+get_beam_chunk(Path, Chunk) ->
+    {ok, {_, [{_, Bin}]}} = beam_lib:chunks(Path, [Chunk]),
+    Bin.
+
+%% Returns a list of all modules modified on disk.
+-spec modified_modules() -> [module()].
+modified_modules() ->
+    PathFiles = path_files(),
+    [M || {M, _} <- code:all_loaded(),
+          module_status(M, PathFiles) =:= modified].
+
+%% prefetch the directory contents of code path directories
+path_files() ->
+    path_files(code:get_path()).
+
+path_files([]) ->
+    [];
+path_files([Path|Tail]) ->
+    case erl_prim_loader:list_dir(Path) of
+        {ok, Files} ->
+            [{Path,Files} | path_files(Tail)];
+        _Error ->
+            path_files(Tail)
+    end.
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 29b3f7caaf..4914ce9e4c 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -38,6 +38,7 @@
 	 on_load_purge/1, on_load_self_call/1, on_load_pending/1,
 	 on_load_deleted/1,
 	 big_boot_embedded/1,
+         module_status/1,
 	 native_early_modules/1, get_mode/1,
 	 normalized_paths/1]).
 
@@ -68,6 +69,7 @@ all() ->
      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,
+     module_status,
      big_boot_embedded, native_early_modules, get_mode, normalized_paths].
 
 groups() ->
@@ -93,6 +95,11 @@ init_per_suite(Config) ->
 end_per_suite(Config) ->
     Config.
 
+-define(TESTMOD, test_dummy).
+-define(TESTMODSTR, "test_dummy").
+-define(TESTMODSRC, ?TESTMODSTR ".erl").
+-define(TESTMODOBJ, ?TESTMODSTR ".beam").
+
 init_per_testcase(big_boot_embedded, Config) ->
     case catch crypto:start() of
 	ok ->
@@ -104,6 +111,13 @@ init_per_testcase(_Func, Config) ->
     P = code:get_path(),
     [{code_path, P}|Config].
 
+end_per_testcase(module_status, Config) ->
+    code:purge(?TESTMOD),
+    code:delete(?TESTMOD),
+    code:purge(?TESTMOD),
+    file:delete(?TESTMODOBJ),
+    file:delete(?TESTMODSRC),
+    end_per_testcase(Config);
 end_per_testcase(TC, Config) when TC == mult_lib_roots;
 				  TC == big_boot_embedded ->
     {ok, HostName} = inet:gethostname(),
@@ -1757,6 +1771,172 @@ do_normalized_paths([M|Ms]) ->
 do_normalized_paths([]) ->
     ok.
 
+%% Test that module_status/1 behaves as expected
+module_status(_Config) ->
+    %% basics
+    not_loaded = code:module_status(fubar),     % nonexisting
+    {file, preloaded} = code:is_loaded(erlang),
+    loaded = code:module_status(erlang),        % preloaded
+    loaded = code:module_status(?MODULE),       % normal known loaded
+
+    non_existing = code:which(?TESTMOD), % verify dummy name not in path
+    code:purge(?TESTMOD), % ensure no previous version in memory
+    code:delete(?TESTMOD),
+    code:purge(?TESTMOD),
+
+    %% generated code is detected as such
+    {ok,?TESTMOD,Bin} = compile:forms(dummy_ast(), []),
+    {module,?TESTMOD} = code:load_binary(?TESTMOD,"",Bin),  % no source file
+    ok = ?TESTMOD:f(),
+    "" = code:which(?TESTMOD), % verify empty string for source file
+    loaded = code:module_status(?TESTMOD),
+
+    %% deleting generated code
+    true = code:delete(?TESTMOD),
+    non_existing = code:which(?TESTMOD), % verify still not in path
+    not_loaded = code:module_status(?TESTMOD),
+
+    %% beam file exists but not loaded
+    make_source_file(<<"0">>),
+    compile_beam(0),
+    true = (non_existing =/= code:which(?TESTMOD)), % verify in path
+    not_loaded = code:module_status(?TESTMOD),
+
+    %% loading code from disk makes it loaded
+    load_code(),
+    loaded = code:module_status(?TESTMOD), % loaded
+
+    %% cover compiling a module
+    {ok,?TESTMOD} = cover:compile(?TESTMOD),
+    {file, cover_compiled} = code:is_loaded(?TESTMOD), % verify cover compiled
+    modified = code:module_status(?TESTMOD), % loaded cover code but file exists
+    remove_code(),
+    removed = code:module_status(?TESTMOD), % removed
+    compile_beam(0),
+    modified = code:module_status(?TESTMOD), % recreated
+    load_code(),
+    loaded = code:module_status(?TESTMOD), % loading removes cover status
+    code:purge(?TESTMOD),
+    true = code:delete(?TESTMOD),
+    not_loaded = code:module_status(?TESTMOD), % deleted
+
+    %% recompilation ignores timestamps, only md5 matters
+    load_code(),
+    compile_beam(1100),
+    loaded = code:module_status(?TESTMOD),
+
+    %% modifying module detects different md5
+    make_source_file(<<"1">>),
+    compile_beam(0),
+    modified = code:module_status(?TESTMOD),
+
+    %% loading the modified code from disk makes it loaded
+    load_code(),
+    loaded = code:module_status(?TESTMOD),
+
+    %% removing and recreating a module with same md5
+    remove_code(),
+    removed = code:module_status(?TESTMOD),
+    compile_beam(0),
+    loaded = code:module_status(?TESTMOD),
+
+    case erlang:system_info(hipe_architecture) of
+	undefined ->
+	    %% no native support
+	    ok;
+	_ ->
+	    %% native chunk is ignored if beam code is already loaded
+	    load_code(),
+	    loaded = code:module_status(?TESTMOD),
+	    false = has_native(?TESTMOD),
+	    compile_native(0),
+	    BeamMD5 = erlang:get_module_info(?TESTMOD, md5),
+	    {ok,{?TESTMOD,BeamMD5}} = beam_lib:md5(?TESTMODOBJ), % beam md5 unchanged
+	    loaded = code:module_status(?TESTMOD),
+
+	    %% native code reported as loaded, though different md5 from beam
+	    load_code(),
+	    true = has_native(?TESTMOD),
+	    NativeMD5 = erlang:get_module_info(?TESTMOD, md5),
+	    true = (BeamMD5 =/= NativeMD5),
+	    loaded = code:module_status(?TESTMOD),
+
+	    %% recompilation ignores timestamps, only md5 matters
+	    compile_native(1100), % later timestamp
+	    loaded = code:module_status(?TESTMOD),
+
+	    %% modifying native module detects different md5
+	    make_source_file(<<"2">>),
+	    compile_native(0),
+	    modified = code:module_status(?TESTMOD),
+
+	    %% loading the modified native code from disk makes it loaded
+	    load_code(),
+	    true = has_native(?TESTMOD),
+	    NativeMD5_2 = erlang:get_module_info(?TESTMOD, md5),
+	    true = (NativeMD5 =/= NativeMD5_2), % verify native md5 changed
+	    {ok,{?TESTMOD,BeamMD5_2}} = beam_lib:md5(?TESTMODOBJ),
+	    true = (BeamMD5_2 =/= NativeMD5_2), % verify md5 differs from beam
+	    loaded = code:module_status(?TESTMOD),
+
+	    %% removing and recreating a native module with same md5
+	    remove_code(),
+	    removed = code:module_status(?TESTMOD),
+	    compile_native(0),
+	    loaded = code:module_status(?TESTMOD),
+
+	    %% purging/deleting native module
+	    code:purge(?TESTMOD),
+	    true = code:delete(?TESTMOD),
+	    not_loaded = code:module_status(?TESTMOD)
+    end,
+    ok.
+
+compile_beam(Sleep) ->
+    compile(Sleep, []).
+
+compile_native(Sleep) ->
+    compile(Sleep, [native]).
+
+compile(Sleep, Opts) ->
+    timer:sleep(Sleep),  % increment compilation timestamp
+    {ok,?TESTMOD} = compile:file(?TESTMODSRC, Opts).
+
+load_code() ->
+    code:purge(?TESTMOD),
+    {module,?TESTMOD} = code:load_file(?TESTMOD).
+
+remove_code() ->
+    ok = file:delete(?TESTMODOBJ).
+
+has_native(Module) ->
+    case erlang:get_module_info(Module, native_addresses) of
+	[] -> false;
+	[_|_] -> true
+    end.
+
+make_source_file(Body) ->
+    ok = file:write_file(?TESTMODSRC, dummy_source(Body)).
+
+dummy_source(Body) ->
+    [<<"-module(" ?TESTMODSTR ").\n"
+       "-export([f/0]).\n"
+       "f() -> ">>, Body, <<".\n">>].
+
+dummy_ast() ->
+    dummy_ast(?TESTMODSTR).
+
+dummy_ast(Mod) when is_atom(Mod) ->
+    dummy_ast(atom_to_list(Mod));
+dummy_ast(ModStr) ->
+    [scan_form("-module(" ++ ModStr ++ ")."),
+     scan_form("-export([f/0])."),
+     scan_form("f() -> ok.")].
+
+scan_form(String) ->
+    {ok,Ts,_} = erl_scan:string(String),
+    {ok,F} = erl_parse:parse_form(Ts),
+    F.
 
 %%-----------------------------------------------------------------
 %% error_logger handler.