path: root/lib/kernel/test/interactive_shell_SUITE.erl

%%
%% %CopyrightBegin%
%% 
%% Copyright Ericsson AB 2007-2012. 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(interactive_shell_SUITE).
-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, 
	 get_columns_and_rows/1, exit_initial/1, job_control_local/1, 
	 job_control_remote/1,
	 job_control_remote_noshell/1]).

-export([init_per_testcase/2, end_per_testcase/2]).
%% For spawn
-export([toerl_server/3]).

init_per_testcase(_Func, Config) ->
    Dog = test_server:timetrap(test_server:minutes(3)),
    [{watchdog,Dog}|Config].

end_per_testcase(_Func, Config) ->
    Dog = ?config(watchdog, Config),
    test_server:timetrap_cancel(Dog).


suite() -> [{ct_hooks,[ts_install_cth]}].

all() -> 
    [get_columns_and_rows, exit_initial, job_control_local,
     job_control_remote, job_control_remote_noshell].

groups() -> 
    [].

init_per_suite(Config) ->
    Term = case os:getenv("TERM") of
	       List when is_list(List) ->
		   List;
	       _ ->
		   "dumb"
	   end,
    os:putenv("TERM","vt100"),
    DefShell = get_default_shell(),
    [{default_shell,DefShell},{term,Term}|Config].

end_per_suite(Config) ->
    Term = ?config(term,Config),
    os:putenv("TERM",Term),
    ok.

init_per_group(_GroupName, Config) ->
    Config.

end_per_group(_GroupName, Config) ->
    Config.


%-define(DEBUG,1).
-ifdef(DEBUG).
-define(dbg(Data),erlang:display(Data)).
-else.
-define(dbg(Data),noop).
-endif.

get_columns_and_rows(suite) -> [];
get_columns_and_rows(doc) -> ["Test that the shell can access columns and rows"];
get_columns_and_rows(Config) when is_list(Config) ->
    case proplists:get_value(default_shell,Config) of
	old ->
	    %% Old shell tests
	    ?dbg(old_shell),
	    ?line rtnode([{putline,""},
			  {putline, "2."},
			  {getline, "2"},
			  {putline,"io:columns()."},
			  {getline_re,".*{error,enotsup}"},
			  {putline,"io:rows()."},
			  {getline_re,".*{error,enotsup}"}

			 ],[]),
	    ?line rtnode([{putline,""},
			  {putline, "2."},
			  {getline, "2"},
			  {putline,"io:columns()."},
			  {getline_re,".*{ok,90}"},
			  {putline,"io:rows()."},
			  {getline_re,".*{ok,40}"}],
			 [],
			 "stty rows 40; stty columns 90; ");
	new ->
	    % New shell tests
	    ?dbg(new_shell),
	    ?line rtnode([{putline,""},
			  {putline, "2."},
			  {getline, "2"},
			  {putline,"io:columns()."},
			  %% Behaviour change in R12B-5, returns 80
			  %%		  {getline,"{error,enotsup}"},
			  {getline,"{ok,80}"},
			  {putline,"io:rows()."},
			  %% Behaviour change in R12B-5, returns 24
			  %%		  {getline,"{error,enotsup}"}
			  {getline,"{ok,24}"}
			 ],[]),
	    ?line rtnode([{putline,""},
			  {putline, "2."},
			  {getline, "2"},
			  {putline,"io:columns()."},
			  {getline,"{ok,90}"},
			  {putline,"io:rows()."},
			  {getline,"{ok,40}"}],
			 [],
			 "stty rows 40; stty columns 90; ")
    end.
    
    

exit_initial(suite) -> [];
exit_initial(doc) -> ["Tests that exit of initial shell restarts shell"];
exit_initial(Config) when is_list(Config) ->
    case proplists:get_value(default_shell,Config) of
	old ->
	    rtnode([{putline,""},
		    {putline, "2."},
		    {getline_re, ".*2"},
		    {putline,"exit()."},
		    {getline,""},
		    {getline,"Eshell"},
		    {putline,""},
		    {putline,"35."},
		    {getline_re,".*35"}],[]);
	new ->
	    rtnode([{putline,""},
		    {putline, "2."},
		    {getline, "2"},
		    {putline,"exit()."},
		    {getline,""},
		    {getline,"Eshell"},
		    {putline,""},
		    {putline,"35."},
		    {getline_re,"35"}],[])
    end.

job_control_local(suite) -> [];
job_control_local(doc) -> [ "Tests that local shell can be "
			    "started by means of job control" ];
job_control_local(Config) when is_list(Config) ->
    case proplists:get_value(default_shell,Config) of
	old ->
	    %% Old shell tests
	    {skip,"No new shell found"};
	new ->
	    %% New shell tests
	    ?line rtnode([{putline,""},
			  {putline, "2."},
			  {getline, "2"},
			  {putline,[7]},
			  {sleep,timeout(short)},
			  {putline,""},
			  {getline," -->"},
			  {putline,"s"},
			  {putline,"c"},
			  {putline_raw,""},
			  {getline,"Eshell"},
			  {putline_raw,""},
			  {getline,"1>"},
			  {putline,"35."},
			  {getline,"35"}],[])
    end.

job_control_remote(suite) -> [];
job_control_remote(doc) -> [ "Tests that remote shell can be "
			     "started by means of job control" ];
job_control_remote(Config) when is_list(Config) ->
    case {node(),proplists:get_value(default_shell,Config)} of
	{nonode@nohost,_} ->
	    ?line exit(not_distributed);
	{_,old} ->
	    {skip,"No new shell found"};
	_ ->
	    ?line RNode = create_nodename(),
	    ?line MyNode = atom_to_list(node()),
	    ?line Pid = spawn_link(fun() ->
					   receive die ->
						   ok
					   end 
				   end),
	    ?line PidStr = pid_to_list(Pid),
	    ?line register(kalaskula,Pid),
	    ?line CookieString = lists:flatten(
				   io_lib:format("~w",
						 [erlang:get_cookie()])),
	    ?line Res = rtnode([{putline,""},
				{putline, "erlang:get_cookie()."},
				{getline, CookieString},
				{putline,[7]},
				{sleep,timeout(short)},
				{putline,""},
				{getline," -->"},
				{putline,"r "++MyNode},
				{putline,"c"},
				{putline_raw,""},
				{getline,"Eshell"},
				{sleep,timeout(short)},
				{putline_raw,""},
				{getline,"("++MyNode++")1>"},
				{putline,"whereis(kalaskula)."},
				{getline,PidStr},
				{sleep,timeout(short)}, % Race, known bug.
				{putline_raw,"exit()."},
				{getline,"***"},
				{putline,[7]},
				{putline,""},
				{getline," -->"},
				{putline,"c 1"},
				{putline,""},
				{sleep,timeout(short)},
				{putline_raw,""},
				{getline,"("++RNode++")"}],RNode),
	    ?line Pid ! die,
	    ?line Res
    end.
job_control_remote_noshell(suite) -> [];
job_control_remote_noshell(doc) -> 
    [ "Tests that remote shell can be "
      "started by means of job control to -noshell node" ];
job_control_remote_noshell(Config) when is_list(Config) ->
    case {node(),proplists:get_value(default_shell,Config)} of
	{nonode@nohost,_} ->
	    ?line exit(not_distributed);
	{_,old} ->
	    {skip,"No new shell found"};
	_ ->
	    ?line RNode = create_nodename(),
	    ?line NSNode = start_noshell_node(interactive_shell_noshell),
	    ?line Pid = spawn_link(NSNode, fun() ->
						   receive die ->
							   ok
						   end 
					   end),
	    ?line PidStr = rpc:call(NSNode,erlang,pid_to_list,[Pid]),
	    ?line true = rpc:call(NSNode,erlang,register,[kalaskula,Pid]),
	    ?line NSNodeStr = atom_to_list(NSNode),
	    ?line CookieString = lists:flatten(
				   io_lib:format("~w",
						 [erlang:get_cookie()])),
	    ?line Res = rtnode([{putline,""},
				{putline, "erlang:get_cookie()."},
				{getline, CookieString},
				{putline,[7]},
				{sleep,timeout(short)},
				{putline,""},
				{getline," -->"},
				{putline,"r "++NSNodeStr},
				{putline,"c"},
				{putline_raw,""},
				{getline,"Eshell"},
				{sleep,timeout(short)},
				{putline_raw,""},
				{getline,"("++NSNodeStr++")1>"},
				{putline,"whereis(kalaskula)."},
				{getline,PidStr},
				{sleep,timeout(short)}, % Race, known bug.
				{putline_raw,"exit()."},
				{getline,"***"},
				{putline,[7]},
				{putline,""},
				{getline," -->"},
				{putline,"c 1"},
				{putline,""},
				{sleep,timeout(short)},
				{putline_raw,""},
				{getline,"("++RNode++")"}],RNode),
	    ?line Pid ! die,
	    ?line stop_noshell_node(NSNode),
	    ?line Res
    end.
	    
rtnode(C,N) ->
    rtnode(C,N,[]).
rtnode(Commands,Nodename,ErlPrefix) ->
    ?line case get_progs() of
	      {error,_Reason} ->
		  ?line {skip,"No runerl present"};
	      {RunErl,ToErl,Erl} ->
		  ?line case create_tempdir() of
			    {error, Reason2} ->
				?line {skip, Reason2};
			    Tempdir ->
				?line SPid = 
				    start_runerl_node(RunErl,ErlPrefix++"\\\""++Erl++"\\\"",
						      Tempdir,Nodename),
				?line CPid = start_toerl_server(ToErl,Tempdir),
				?line erase(getline_skipped),
				?line Res = 
				    (catch get_and_put(CPid, Commands,1)),
				?line case stop_runerl_node(CPid) of
					  {error,_} ->
					      ?line CPid2 = 
						  start_toerl_server
						    (ToErl,Tempdir),
					      ?line erase(getline_skipped),
					      ?line ok = get_and_put
							   (CPid2, 
							    [{putline,[7]},
							     {sleep,
							      timeout(short)},
							     {putline,""},
							     {getline," -->"},
							     {putline,"s"},
							     {putline,"c"},
							     {putline,""}],1),
					      ?line stop_runerl_node(CPid2);
					  _ ->
					      ?line ok
				      end,
				?line wait_for_runerl_server(SPid),
				?line ok = rm_rf(Tempdir),
				?line ok = Res
			end
	  end.

timeout(long) ->
    2 * timeout(normal);
timeout(short) ->
    timeout(normal) div 10;
timeout(normal) ->
    10000 * test_server:timetrap_scale_factor().


start_noshell_node(Name) ->
    PADir =  filename:dirname(code:which(?MODULE)),
    {ok, Node} = test_server:start_node(Name,slave,[{args," -noshell -pa "++
						     PADir++" "}]),
    Node.
stop_noshell_node(Node) ->
    test_server:stop_node(Node).


rm_rf(Dir) ->
    try
      {ok,List} = file:list_dir(Dir),
      Files = [filename:join([Dir,X]) || X <- List],
      [case file:list_dir(Y) of
	   {error, enotdir} ->
	       ok = file:delete(Y);
	   _ ->
	       ok = rm_rf(Y)
       end || Y <- Files],
       ok = file:del_dir(Dir),
       ok
    catch
	_:Exception -> {error, {Exception,Dir}}
    end.
       

get_and_put(_CPid,[],_) ->
    ok;
get_and_put(CPid, [{sleep, X}|T],N) ->
    ?dbg({sleep, X}),
    receive
    after X ->
	    get_and_put(CPid,T,N+1)
    end;
get_and_put(CPid, [{getline, Match}|T],N) ->
    ?dbg({getline, Match}),
    CPid ! {self(), {get_line, timeout(normal)}},
    receive
	{get_line, timeout} ->
	    error_logger:error_msg("~p: getline timeout waiting for \"~s\" "
				   "(command number ~p, skipped: ~p)~n",
				   [?MODULE, Match,N,get(getline_skipped)]),
	    {error, timeout};
	{get_line, Data} ->
	    ?dbg({data,Data}),
	    case lists:prefix(Match, Data) of
		true ->
		    erase(getline_skipped),
		    get_and_put(CPid, T,N+1);
		false ->
		    case get(getline_skipped) of
			undefined ->
			    put(getline_skipped,[Data]);
			List ->
			    put(getline_skipped,List ++ [Data])
		    end,
		    get_and_put(CPid,  [{getline, Match}|T],N)
	    end
    end;

%% Hey ho copy paste from stdlib/io_proto_SUITE
get_and_put(CPid, [{getline_re, Match}|T],N) ->
    ?dbg({getline_re, Match}),
    CPid ! {self(), {get_line, timeout(normal)}},
    receive
	{get_line, timeout} ->
	    error_logger:error_msg("~p: getline_re timeout waiting for \"~s\" "
				   "(command number ~p, skipped: ~p)~n",
				   [?MODULE, Match,N,get(getline_skipped)]),
	    {error, timeout};
	{get_line, Data} ->
	    ?dbg({data,Data}),
	    case re:run(Data, Match,[{capture,none}]) of
		match ->
		    erase(getline_skipped),
		    get_and_put(CPid, T,N+1);
		_ ->
		    case get(getline_skipped) of
			undefined ->
			    put(getline_skipped,[Data]);
			List ->
			    put(getline_skipped,List ++ [Data])
		    end,
		    get_and_put(CPid,  [{getline_re, Match}|T],N)
	    end
    end;

get_and_put(CPid, [{putline_raw, Line}|T],N) ->
    ?dbg({putline_raw, Line}),
    CPid ! {self(), {send_line, Line}},
    Timeout = timeout(normal),
    receive
	{send_line, ok} ->
	     get_and_put(CPid, T,N+1)
    after Timeout ->
	    error_logger:error_msg("~p: putline_raw timeout (~p) sending "
				   "\"~s\" (command number ~p)~n",
				   [?MODULE, Timeout, Line, N]),
	    {error, timeout}
    end;

get_and_put(CPid, [{putline, Line}|T],N) ->
    ?dbg({putline, Line}),
    CPid ! {self(), {send_line, Line}},
    Timeout = timeout(normal),
    receive
	{send_line, ok} ->
	     get_and_put(CPid, [{getline, []}|T],N)
    after Timeout ->
	    error_logger:error_msg("~p: putline timeout (~p) sending "
				   "\"~s\" (command number ~p)~n[~p]~n",
				   [?MODULE, Timeout, Line, N,get()]),
	    {error, timeout}
    end.

wait_for_runerl_server(SPid) ->
    Ref = erlang:monitor(process, SPid), 
    Timeout = timeout(long),
    receive
	{'DOWN', Ref, process, SPid, _} ->
	    ok
    after Timeout ->
	    {error, timeout}
    end.
	
    

stop_runerl_node(CPid) ->
    Ref = erlang:monitor(process, CPid),
    CPid ! {self(), kill_emulator},
    Timeout = timeout(long),
    receive
	{'DOWN', Ref, process, CPid, noproc} ->
	    ok;
	{'DOWN', Ref, process, CPid, normal} ->
	    ok;
	{'DOWN', Ref, process, CPid, {error, Reason}} ->
	    {error, Reason}
    after Timeout ->
	    {error, timeout}
    end.

get_progs() ->
    case os:type() of
	{unix,freebsd} ->
	    {error,"cant use run_erl on freebsd"};
	{unix,openbsd} ->
	    {error,"cant use run_erl on openbsd"};
	{unix,_} ->
	    case os:find_executable("run_erl") of
		RE when is_list(RE) ->
		    case  os:find_executable("to_erl") of
			TE when is_list(TE) ->
			    case os:find_executable("erl") of
				E when is_list(E) ->
				    {RE,TE,E};
				_ ->
				    {error, "Could not find erl command"}
			    end;
			_ ->
			    {error, "Could not find to_erl command"}
		    end;
		_ ->
		    {error, "Could not find run_erl command"}
	    end;
	_ ->
	    {error, "Not a unix OS"}
    end.

create_tempdir() ->
    create_tempdir(filename:join(["/tmp","rtnode"++os:getpid()]),$A).

create_tempdir(Dir,X) when X > $Z, X < $a ->
    create_tempdir(Dir,$a);
create_tempdir(Dir,X) when X > $z -> 
    Estr = lists:flatten(
		     io_lib:format("Unable to create ~s, reason eexist",
				   [Dir++[$z]])),
    {error, Estr};
create_tempdir(Dir0, Ch) ->
    % Expect fairly standard unix.
    Dir = Dir0++[Ch],
    case file:make_dir(Dir) of
	{error, eexist} ->
	    create_tempdir(Dir0, Ch+1);
	{error, Reason} ->
	    Estr = lists:flatten(
		     io_lib:format("Unable to create ~s, reason ~p",
				   [Dir,Reason])),
	    {error,Estr};
	ok ->
	    Dir
    end.

create_nodename() ->
    create_nodename($A).

create_nodename(X) when X > $Z, X < $a ->
    create_nodename($a);
create_nodename(X) when X > $z -> 
    {error,out_of_nodenames};
create_nodename(X) ->
    NN = "rtnode"++os:getpid()++[X],
    case file:read_file_info(filename:join(["/tmp",NN])) of
	{error,enoent} ->
	    Host = lists:nth(2,string:tokens(atom_to_list(node()),"@")),
	    NN++"@"++Host;
	_ ->
	    create_nodename(X+1)
    end.


start_runerl_node(RunErl,Erl,Tempdir,Nodename) ->
    XArg = case Nodename of
	       [] ->
		   [];
	       _ ->
		   " -sname "++(if is_atom(Nodename) -> atom_to_list(Nodename);
				  true -> Nodename 
			       end)++
		       " -setcookie "++atom_to_list(erlang:get_cookie())
	   end,
    spawn(fun() ->
		  os:cmd("\""++RunErl++"\" "++Tempdir++"/ "++Tempdir++" \""++
			 Erl++XArg++"\"")
	  end).

start_toerl_server(ToErl,Tempdir) ->
    Pid = spawn(?MODULE,toerl_server,[self(),ToErl,Tempdir]),
    receive
	{Pid,started} ->
	    Pid;
	{Pid,error,Reason} ->
	    {error,Reason}
    end.

try_to_erl(_Command, 0) ->
    {error, cannot_to_erl};
try_to_erl(Command, N) ->
    ?dbg({?LINE,N}),
    Port = open_port({spawn, Command},[eof,{line,1000}]),
    Timeout = timeout(normal) div 2,
    receive
	{Port, eof} -> 	
	    receive after Timeout ->
			    ok
		    end,
	    try_to_erl(Command, N-1)
    after Timeout ->
	    ?dbg(Port),
	    Port
    end.

toerl_server(Parent,ToErl,Tempdir) ->
    Port = try_to_erl("\""++ToErl++"\" "++Tempdir++"/ 2>/dev/null",8),
    case Port of
	P when is_port(P) ->
	    Parent ! {self(),started};
	{error,Other} ->
	    Parent ! {self(),error,Other},
	    exit(Other)
    end,
    case toerl_loop(Port,[]) of
	normal ->
	    ok;
	{error, Reason} ->
	    error_logger:error_msg("toerl_server exit with reason ~p~n",
				   [Reason]),
	    exit(Reason)
    end.

toerl_loop(Port,Acc) ->
    ?dbg({toerl_loop, Port, Acc}),
    receive
	{Port,{data,{Tag0,Data}}} when is_port(Port) ->
	    ?dbg({?LINE,Port,{data,{Tag0,Data}}}),
	    case Acc of
		[{noeol,Data0}|T0] ->
		    toerl_loop(Port,[{Tag0, Data0++Data}|T0]);
		_ ->
		    toerl_loop(Port,[{Tag0,Data}|Acc])
	    end;
	 {Pid,{get_line,Timeout}} ->
	    case Acc of
		[] ->
		    case get_data_within(Port,Timeout,[]) of
			timeout ->
			    Pid ! {get_line, timeout},
			    toerl_loop(Port,[]);
			{noeol,Data1} ->
			    Pid ! {get_line, timeout},
			    toerl_loop(Port,[{noeol,Data1}]);
			{eol,Data2} ->
			    Pid ! {get_line, Data2}, 
			    toerl_loop(Port,[])
		    end;
		[{noeol,Data3}] ->
		    case get_data_within(Port,Timeout,Data3) of
			timeout ->
			    Pid ! {get_line, timeout},
			    toerl_loop(Port,Acc);
			{noeol,Data4} ->
			    Pid ! {get_line, timeout},
			    toerl_loop(Port,[{noeol,Data4}]);
			{eol,Data5} ->
			    Pid ! {get_line, Data5},
			    toerl_loop(Port,[])
		    end;
		List ->
		    {NewAcc,[{eol,Data6}]} = lists:split(length(List)-1,List),
		    Pid ! {get_line,Data6},
		    toerl_loop(Port,NewAcc)
	    end;
	{Pid, {send_line, Data7}} ->
	    Port ! {self(),{command, Data7++"\n"}},
	    Pid ! {send_line, ok},
	    toerl_loop(Port,Acc);
	{_Pid, kill_emulator} ->
	    Port ! {self(),{command, "init:stop().\n"}},
	    Timeout1 = timeout(long),
	    receive
		{Port,eof} ->
		    normal
	    after Timeout1 ->
		    {error, kill_timeout}
	    end;
	{Port, eof} ->
	    {error, unexpected_eof};
	Other ->
	    {error, {unexpected, Other}}
    end.
	
millistamp() ->
    {Mega, Secs, Micros} = erlang:now(),
    (Micros div 1000) + Secs * 1000 + Mega * 1000000000.
    
get_data_within(Port, X, Acc) when X =< 0 ->
    ?dbg({get_data_within, X, Acc, ?LINE}),
    receive
	{Port,{data,{Tag0,Data}}} ->
	    ?dbg({?LINE,Port,{data,{Tag0,Data}}}),
	    {Tag0, Acc++Data}
    after 0 ->
	    case Acc of
		[] ->
		    timeout;
		Noeol ->
		    {noeol,Noeol}
	    end
    end;


get_data_within(Port, Timeout, Acc) ->	
    ?dbg({get_data_within, Timeout, Acc, ?LINE}),
    T1 = millistamp(),
    receive 
	{Port,{data,{noeol,Data}}} ->
	    ?dbg({?LINE,Port,{data,{noeol,Data}}}),
	    Elapsed = millistamp() - T1 + 1,
	    get_data_within(Port, Timeout - Elapsed, Acc ++ Data); 
	{Port,{data,{eol,Data1}}} ->
	    ?dbg({?LINE,Port,{data,{eol,Data1}}}),
	    {eol, Acc ++ Data1}
    after Timeout ->
	    timeout
    end.
	    
get_default_shell() ->
    try
	rtnode([{putline,""},
		{putline, "whereis(user_drv)."},
		{getline, "undefined"}],[]),
	old
    catch E:R ->
	    ?dbg({E,R}),
	    new
    end.