%% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% 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 online 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. %% %% %CopyrightEnd% %% -module(erl_prim_loader_SUITE). -include_lib("kernel/include/file.hrl"). -include_lib("test_server/include/test_server.hrl"). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([get_path/1, set_path/1, get_file/1, inet_existing/1, inet_coming_up/1, inet_disconnects/1, multiple_slaves/1, file_requests/1, local_archive/1, remote_archive/1, primary_archive/1, virtual_dir_in_archive/1]). -export([init_per_testcase/2, end_per_testcase/2]). %%----------------------------------------------------------------- %% Test suite for erl_prim_loader. (Most code is run during system start/stop.) %%----------------------------------------------------------------- suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [get_path, set_path, get_file, inet_existing, inet_coming_up, inet_disconnects, multiple_slaves, file_requests, local_archive, remote_archive, primary_archive, virtual_dir_in_archive]. groups() -> []. init_per_suite(Config) -> Config. end_per_suite(_Config) -> ok. init_per_group(_GroupName, Config) -> Config. end_per_group(_GroupName, Config) -> Config. init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> Dog=?t:timetrap(?t:minutes(3)), [{watchdog, Dog}|Config]. end_per_testcase(_Func, Config) -> Dog=?config(watchdog, Config), ?t:timetrap_cancel(Dog). get_path(doc) -> []; get_path(Config) when is_list(Config) -> ?line case erl_prim_loader:get_path() of {ok, Path} when is_list(Path) -> ok; _ -> test_server:fail(get_path) end, ok. set_path(doc) -> []; set_path(Config) when is_list(Config) -> ?line {ok, Path} = erl_prim_loader:get_path(), ?line ok = erl_prim_loader:set_path(Path), ?line {ok, Path} = erl_prim_loader:get_path(), NewPath = Path ++ ["dummy_dir","/dummy_dir/dummy_dir"], ?line ok = erl_prim_loader:set_path(NewPath), ?line {ok, NewPath} = erl_prim_loader:get_path(), ?line ok = erl_prim_loader:set_path(Path), % Reset path. ?line {ok, Path} = erl_prim_loader:get_path(), ?line {'EXIT',_} = (catch erl_prim_loader:set_path(not_a_list)), ?line {ok, Path} = erl_prim_loader:get_path(), ok. get_file(doc) -> []; get_file(Config) when is_list(Config) -> ?line case erl_prim_loader:get_file("lists" ++ code:objfile_extension()) of {ok,Bin,File} when is_binary(Bin), is_list(File) -> ok; _ -> test_server:fail(get_valid_file) end, ?line error = erl_prim_loader:get_file("duuuuuuummmy_file"), ?line error = erl_prim_loader:get_file(duuuuuuummmy_file), ?line error = erl_prim_loader:get_file({dummy}), ok. inet_existing(doc) -> ["Start a node using the 'inet' loading method, ", "from an already started boot server."]; inet_existing(Config) when is_list(Config) -> case os:type() of vxworks -> {comment, "VxWorks: tested separately"}; _ -> ?line Name = erl_prim_test_inet_existing, ?line Host = host(), ?line Cookie = atom_to_list(erlang:get_cookie()), ?line IpStr = ip_str(Host), ?line LFlag = get_loader_flag(os:type()), ?line Args = LFlag ++ " -hosts " ++ IpStr ++ " -setcookie " ++ Cookie, ?line {ok, BootPid} = erl_boot_server:start_link([Host]), ?line {ok, Node} = start_node(Name, Args), ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), ?line stop_node(Node), ?line unlink(BootPid), ?line exit(BootPid, kill), ok end. inet_coming_up(doc) -> ["Start a node using the 'inet' loading method, ", "but start the boot server afterwards."]; inet_coming_up(Config) when is_list(Config) -> case os:type() of vxworks -> {comment, "VxWorks: tested separately"}; _ -> ?line Name = erl_prim_test_inet_coming_up, ?line Cookie = atom_to_list(erlang:get_cookie()), ?line Host = host(), ?line IpStr = ip_str(Host), ?line LFlag = get_loader_flag(os:type()), ?line Args = LFlag ++ " -hosts " ++ IpStr ++ " -setcookie " ++ Cookie, ?line {ok, Node} = start_node(Name, Args, [{wait, false}]), %% Wait a while, then start boot server, and wait for node to start. ?line test_server:sleep(test_server:seconds(6)), io:format("erl_boot_server:start_link([~p]).", [Host]), ?line {ok, BootPid} = erl_boot_server:start_link([Host]), ?line wait_really_started(Node, 25), %% Check loader argument, then cleanup. ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), ?line stop_node(Node), ?line unlink(BootPid), ?line exit(BootPid, kill), ok end. wait_really_started(Node, 0) -> test_server:fail({not_booted,Node}); wait_really_started(Node, N) -> case rpc:call(Node, init, get_status, []) of {started, _} -> ok; _ -> test_server:sleep(1000), wait_really_started(Node, N - 1) end. inet_disconnects(doc) -> ["Start a node using the 'inet' loading method, ", "then lose the connection."]; inet_disconnects(Config) when is_list(Config) -> case test_server:is_native(erl_boot_server) of true -> {skip,"erl_boot_server is native"}; false -> ?line Name = erl_prim_test_inet_disconnects, ?line Host = host(), ?line Cookie = atom_to_list(erlang:get_cookie()), ?line IpStr = ip_str(Host), ?line LFlag = get_loader_flag(os:type()), ?line Args = LFlag ++ " -hosts " ++ IpStr ++ " -setcookie " ++ Cookie, ?line {ok, BootPid} = erl_boot_server:start([Host]), Self = self(), %% This process shuts down the boot server during loading. ?line Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), ?line receive {Stopper,ready} -> ok end, %% Let the loading begin... ?line {ok, Node} = start_node(Name, Args, [{wait, false}]), %% When the stopper is ready, the slave node should be %% looking for a boot server again. receive {Stopper,ok} -> ok; {Stopper,{error,Reason}} -> ?line ?t:fail(Reason) after 60000 -> ?line ?t:fail(stopper_died) end, %% Start new boot server to see that loading is continued. ?line {ok, BootPid2} = erl_boot_server:start_link([Host]), ?line wait_really_started(Node, 25), ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), ?line stop_node(Node), ?line unlink(BootPid2), ?line exit(BootPid2, kill), ok end. %% Trace boot server calls and stop the server before loading is finished. stop_boot(BootPid, Super) -> erlang:trace(all, true, [call]), 1 = erlang:trace_pattern({erl_boot_server,send_file_result,3}, true, [local]), BootRef = erlang:monitor(process, BootPid), Super ! {self(),ready}, Result = get_calls(100, BootPid), exit(BootPid, kill), erlang:trace_pattern({erl_boot_server,send_file_result,3}, false, [local]), erlang:trace(all, false, [call]), receive {'DOWN',BootRef,_,_, killed} -> ok end, Super ! {self(),Result}. get_calls(0, _) -> ok; get_calls(Count, Pid) -> receive {trace,_,call,_MFA} -> get_calls(Count-1, Pid) after 10000 -> {error,{trace_msg_timeout,Count}} end. multiple_slaves(doc) -> ["Start nodes in parallell, all using the 'inet' loading method, ", "verify that the boot server manages"]; multiple_slaves(Config) when is_list(Config) -> case os:type() of vxworks -> {comment, "VxWorks: tested separately"}; {ose,_} -> {comment, "OSE: multiple nodes not supported"}; _ -> ?line Name = erl_prim_test_multiple_slaves, ?line Host = host(), ?line Cookie = atom_to_list(erlang:get_cookie()), ?line IpStr = ip_str(Host), ?line LFlag = get_loader_flag(os:type()), ?line Args = LFlag ++ " -hosts " ++ IpStr ++ " -setcookie " ++ Cookie, NoOfNodes = 10, % no of slave nodes to be started NamesAndNodes = lists:map(fun(N) -> NameN = atom_to_list(Name) ++ integer_to_list(N), NodeN = NameN ++ "@" ++ Host, {list_to_atom(NameN),list_to_atom(NodeN)} end, lists:seq(1, NoOfNodes)), ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []), %% "queue up" the nodes to wait for the boot server to respond %% (note: test_server supervises each node start by accept() %% on a socket, the timeout value for the accept has to be quite %% long for this test to work). ?line test_server:sleep(test_server:seconds(5)), %% start the code loading circus! ?line {ok,BootPid} = erl_boot_server:start_link([Host]), %% give the nodes a chance to boot up before attempting to stop them ?line test_server:sleep(test_server:seconds(10)), ?line wait_and_shutdown(lists:reverse(Nodes), 30), ?line unlink(BootPid), ?line exit(BootPid, kill), ok end. start_multiple_nodes([{Name,Node} | NNs], Args, Started) -> ?line {ok,Node} = start_node(Name, Args, [{wait, false}]), start_multiple_nodes(NNs, Args, [Node | Started]); start_multiple_nodes([], _, Nodes) -> Nodes. wait_and_shutdown([Node | Nodes], Tries) -> ?line wait_really_started(Node, Tries), ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), ?line stop_node(Node), wait_and_shutdown(Nodes, Tries); wait_and_shutdown([], _) -> ok. file_requests(doc) -> ["Start a node using the 'inet' loading method, ", "verify that the boot server responds to file requests."]; file_requests(Config) when is_list(Config) -> ?line {ok, Node, BootPid} = complete_start_node(erl_prim_test_file_req), %% compare with results from file server calls (the %% boot server uses the same file sys and cwd) {ok,Files} = file:list_dir("."), io:format("Files: ~p~n",[Files]), ?line {ok,Files} = rpc:call(Node, erl_prim_loader, list_dir, ["."]), {ok,Info} = file:read_file_info(code:which(test_server)), ?line {ok,Info} = rpc:call(Node, erl_prim_loader, read_file_info, [code:which(test_server)]), {ok,Cwd} = file:get_cwd(), ?line {ok,Cwd} = rpc:call(Node, erl_prim_loader, get_cwd, []), case file:get_cwd("C:") of {error,enotsup} -> ok; {ok,DCwd} -> ?line {ok,DCwd} = rpc:call(Node, erl_prim_loader, get_cwd, ["C:"]) end, ?line stop_node(Node), ?line unlink(BootPid), ?line exit(BootPid, kill), ok. complete_start_node(Name) -> ?line Host = host(), ?line Cookie = atom_to_list(erlang:get_cookie()), ?line IpStr = ip_str(Host), ?line LFlag = get_loader_flag(os:type()), ?line Args = LFlag ++ " -hosts " ++ IpStr ++ " -setcookie " ++ Cookie, ?line {ok,BootPid} = erl_boot_server:start_link([Host]), ?line {ok,Node} = start_node(Name, Args), ?line wait_really_started(Node, 25), {ok, Node, BootPid}. local_archive(suite) -> []; local_archive(doc) -> ["Read files from local archive."]; local_archive(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), KernelDir = filename:basename(code:lib_dir(kernel)), Archive = filename:join([PrivDir, KernelDir ++ init:archive_extension()]), file:delete(Archive), ?line {ok, Archive} = create_archive(Archive, [KernelDir]), Node = node(), BeamName = "inet.beam", ?line ok = test_archive(Node, Archive, KernelDir, BeamName), %% Cleanup ?line ok = rpc:call(Node, erl_prim_loader, release_archives, []), ?line ok = file:delete(Archive), ok. remote_archive(suite) -> {req, [{local_slave_nodes, 1}, {time, 10}]}; remote_archive(doc) -> ["Read files from remote archive."]; remote_archive(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), KernelDir = filename:basename(code:lib_dir(kernel)), Archive = filename:join([PrivDir, KernelDir ++ init:archive_extension()]), file:delete(Archive), ?line {ok, Archive} = create_archive(Archive, [KernelDir]), ?line {ok, Node, BootPid} = complete_start_node(remote_archive), BeamName = "inet.beam", ?line ok = test_archive(Node, Archive, KernelDir, BeamName), %% Cleanup ?line stop_node(Node), ?line unlink(BootPid), ?line exit(BootPid, kill), ok. primary_archive(suite) -> {req, [{local_slave_nodes, 1}, {time, 10}]}; primary_archive(doc) -> ["Read files from primary archive."]; primary_archive(Config) when is_list(Config) -> %% Copy the orig files to priv_dir PrivDir = ?config(priv_dir, Config), Archive = filename:join([PrivDir, "primary_archive.zip"]), file:delete(Archive), DataDir = ?config(data_dir, Config), ?line {ok, _} = zip:create(Archive, ["primary_archive"], [{compress, []}, {cwd, DataDir}]), ?line {ok, _} = zip:extract(Archive, [{cwd, PrivDir}]), TopDir = filename:join([PrivDir, "primary_archive"]), %% Compile the code DictDir = "primary_archive_dict-1.0", DummyDir = "primary_archive_dummy", ?line ok = compile_app(TopDir, DictDir), ?line ok = compile_app(TopDir, DummyDir), %% Create the archive {ok, TopFiles} = file:list_dir(TopDir), ?line {ok, {_, ArchiveBin}} = zip:create(Archive, TopFiles, [memory, {compress, []}, {cwd, TopDir}]), %% Use temporary node to simplify cleanup ?line Cookie = atom_to_list(erlang:get_cookie()), ?line Args = " -setcookie " ++ Cookie, ?line {ok,Node} = start_node(primary_archive, Args), ?line wait_really_started(Node, 25), ?line {_,_,_} = rpc:call(Node, erlang, date, []), %% Set primary archive ExpectedEbins = [Archive, DictDir ++ "/ebin", DummyDir ++ "/ebin"], io:format("ExpectedEbins: ~p\n", [ExpectedEbins]), ?line {ok, FileInfo} = prim_file:read_file_info(Archive), ?line {ok, Ebins} = rpc:call(Node, erl_prim_loader, set_primary_archive, [Archive, ArchiveBin, FileInfo]), ?line ExpectedEbins = lists:sort(Ebins), % assert ?line {ok, TopFiles2} = rpc:call(Node, erl_prim_loader, list_dir, [Archive]), ?line [DictDir, DummyDir] = lists:sort(TopFiles2), BeamName = "primary_archive_dict_app.beam", ?line ok = test_archive(Node, Archive, DictDir, BeamName), %% Cleanup ?line {ok, []} = rpc:call(Node, erl_prim_loader, set_primary_archive, [undefined, undefined, undefined]), ?line stop_node(Node), ?line ok = file:delete(Archive), ok. test_archive(Node, TopDir, AppDir, BeamName) -> %% List dir io:format("test_archive: ~p\n", [rpc:call(Node, erl_prim_loader, list_dir, [TopDir])]), ?line {ok, TopFiles} = rpc:call(Node, erl_prim_loader, list_dir, [TopDir]), ?line true = lists:member(AppDir, TopFiles), AbsAppDir = TopDir ++ "/" ++ AppDir, ?line {ok, AppFiles} = rpc:call(Node, erl_prim_loader, list_dir, [AbsAppDir]), ?line true = lists:member("ebin", AppFiles), Ebin = AbsAppDir ++ "/ebin", ?line {ok, EbinFiles} = rpc:call(Node, erl_prim_loader, list_dir, [Ebin]), Beam = Ebin ++ "/" ++ BeamName, ?line true = lists:member(BeamName, EbinFiles), ?line error = rpc:call(Node, erl_prim_loader, list_dir, [TopDir ++ "/no_such_file"]), ?line error = rpc:call(Node, erl_prim_loader, list_dir, [TopDir ++ "/ebin/no_such_file"]), %% File info ?line {ok, #file_info{type = directory}} = rpc:call(Node, erl_prim_loader, read_file_info, [TopDir]), ?line {ok, #file_info{type = directory}} = rpc:call(Node, erl_prim_loader, read_file_info, [Ebin]), ?line {ok, #file_info{type = regular} = FI} = rpc:call(Node, erl_prim_loader, read_file_info, [Beam]), ?line error = rpc:call(Node, erl_prim_loader, read_file_info, [TopDir ++ "/no_such_file"]), ?line error = rpc:call(Node, erl_prim_loader, read_file_info, [TopDir ++ "/ebin/no_such_file"]), %% Get file ?line {ok, Bin, Beam} = rpc:call(Node, erl_prim_loader, get_file, [Beam]), ?line if FI#file_info.size =:= byte_size(Bin) -> ok; true -> exit({FI#file_info.size, byte_size(Bin)}) end, ?line error = rpc:call(Node, erl_prim_loader, get_file, ["/no_such_file"]), ?line error = rpc:call(Node, erl_prim_loader, get_file, ["/ebin/no_such_file"]), ok. create_archive(Archive, AppDirs) -> LibDir = code:lib_dir(), Opts = [{compress, []}, {cwd, LibDir}], io:format("zip:create(~p,\n\t~p,\n\t~p).\n", [Archive, AppDirs, Opts]), zip:create(Archive, AppDirs, Opts). virtual_dir_in_archive(suite) -> []; virtual_dir_in_archive(doc) -> ["Read virtual directories from archive."]; virtual_dir_in_archive(Config) when is_list(Config) -> PrivDir = ?config(priv_dir, Config), Data = <<"A little piece of data.">>, ArchiveBase = "archive_with_virtual_dirs", Archive = filename:join([PrivDir, ArchiveBase ++ init:archive_extension()]), FileBase = "a_data_file.beam", EbinBase = "ebin", FileInArchive = filename:join([ArchiveBase, EbinBase, FileBase]), BinFiles = [{FileInArchive, Data}], Opts = [{compress, []}], ?line file:delete(Archive), io:format("zip:create(~p,\n\t~p,\n\t~p).\n", [Archive, BinFiles, Opts]), ?line {ok, Archive} = zip:create(Archive, BinFiles, Opts), %% Verify that there is no directories ?line {ok, BinFiles} = zip:unzip(Archive, [memory]), FullPath = filename:join([Archive, FileInArchive]), ?line {ok, _} = erl_prim_loader:read_file_info(FullPath), %% Read one virtual dir EbinDir = filename:dirname(FullPath), ?line {ok, _} = erl_prim_loader:read_file_info(EbinDir), ?line {ok, [FileBase]} = erl_prim_loader:list_dir(EbinDir), %% Read another virtual dir AppDir = filename:dirname(EbinDir), ?line {ok, _} = erl_prim_loader:read_file_info(AppDir), ?line {ok, [EbinBase]} = erl_prim_loader:list_dir(AppDir), %% Cleanup ?line ok = erl_prim_loader:release_archives(), ?line ok = file:delete(Archive), ok. %% Misc. functions ip_str({A, B, C, D}) -> lists:concat([A, ".", B, ".", C, ".", D]); ip_str(Host) -> {ok,Ip} = inet:getaddr(Host, inet), ip_str(Ip). start_node(Name, Args) -> start_node(Name, Args, []). start_node(Name, Args, Opts) -> Opts2 = [{args, Args}|Opts], io:format("test_server:start_node(~p, peer, ~p).\n", [Name, Opts2]), Res = test_server:start_node(Name, peer, Opts2), io:format("start_node -> ~p\n", [Res]), Res. host() -> {ok,Host} = inet:gethostname(), Host. stop_node(Node) -> test_server:stop_node(Node). get_loader_flag(_) -> " -loader inet ". compile_app(TopDir, AppName) -> AppDir = filename:join([TopDir, AppName]), SrcDir = filename:join([AppDir, "src"]), OutDir = filename:join([AppDir, "ebin"]), ?line {ok, Files} = file:list_dir(SrcDir), compile_files(Files, SrcDir, OutDir). compile_files([File | Files], SrcDir, OutDir) -> case filename:extension(File) of ".erl" -> AbsFile = filename:join([SrcDir, File]), case compile:file(AbsFile, [{outdir, OutDir}]) of {ok, _Mod} -> compile_files(Files, SrcDir, OutDir); Error -> {compilation_error, AbsFile, OutDir, Error} end; _ -> compile_files(Files, SrcDir, OutDir) end; compile_files([], _, _) -> ok.