aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/src/Makefile2
-rw-r--r--lib/common_test/src/ct_logs.erl15
-rw-r--r--lib/common_test/src/ct_netconfc.erl157
-rw-r--r--lib/common_test/src/ct_run.erl71
-rw-r--r--lib/common_test/src/ct_telnet.erl93
-rw-r--r--lib/common_test/src/ct_webtool.erl1207
-rw-r--r--lib/common_test/src/ct_webtool_sup.erl74
-rw-r--r--lib/common_test/src/vts.erl10
-rw-r--r--lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl19
-rw-r--r--lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl18
-rw-r--r--lib/common_test/test/telnet_server.erl6
-rw-r--r--lib/common_test/vsn.mk2
-rw-r--r--lib/inets/doc/src/httpd.xml3
-rw-r--r--lib/inets/doc/src/notes.xml23
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl8
-rw-r--r--lib/inets/src/http_server/httpd_response.erl7
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/snmp/src/agent/snmpa_net_if.erl6
-rw-r--r--lib/snmp/src/app/snmp.appup.src4
-rw-r--r--lib/snmp/src/manager/snmpm_net_if.erl4
-rw-r--r--lib/snmp/src/manager/snmpm_server.erl8
-rw-r--r--lib/snmp/vsn.mk4
-rw-r--r--lib/ssh/doc/src/notes.xml43
-rw-r--r--lib/ssh/doc/src/ssh.xml23
-rw-r--r--lib/ssh/src/ssh.appup.src54
-rw-r--r--lib/ssh/src/ssh.erl11
-rw-r--r--lib/ssh/src/ssh_acceptor.erl4
-rw-r--r--lib/ssh/src/ssh_connection.erl216
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl11
-rw-r--r--lib/ssh/src/ssh_info.erl146
-rw-r--r--lib/ssh/src/ssh_transport.erl34
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl171
-rw-r--r--lib/ssh/vsn.mk3
-rw-r--r--lib/test_server/src/erl2html2.erl60
-rw-r--r--lib/test_server/src/test_server.erl33
-rw-r--r--lib/test_server/src/test_server_sup.erl65
-rw-r--r--lib/test_server/vsn.mk2
37 files changed, 2171 insertions, 448 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile
index 8d74546880..449cba6c83 100644
--- a/lib/common_test/src/Makefile
+++ b/lib/common_test/src/Makefile
@@ -62,6 +62,8 @@ MODULES= \
ct_telnet_client \
ct_make \
vts \
+ ct_webtool \
+ ct_webtool_sup \
unix_telnet \
ct_config \
ct_config_plain \
diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index dc118ed149..fa55a9754e 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -1908,13 +1908,14 @@ sort_all_runs(Dirs) ->
sort_ct_runs(Dirs) ->
%% Directory naming: <Prefix>.NodeName.Date_Time[/...]
%% Sort on Date_Time string: "YYYY-MM-DD_HH.MM.SS"
- lists:sort(fun(Dir1,Dir2) ->
- [_Prefix,_Node1,DateHH1,MM1,SS1] =
- string:tokens(filename:dirname(Dir1),[$.]),
- [_Prefix,_Node2,DateHH2,MM2,SS2] =
- string:tokens(filename:dirname(Dir2),[$.]),
- {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2}
- end, Dirs).
+ lists:sort(
+ fun(Dir1,Dir2) ->
+ [SS1,MM1,DateHH1 | _] =
+ lists:reverse(string:tokens(filename:dirname(Dir1),[$.])),
+ [SS2,MM2,DateHH2 | _] =
+ lists:reverse(string:tokens(filename:dirname(Dir2),[$.])),
+ {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2}
+ end, Dirs).
dir_diff_all_runs(Dirs, LogCache) ->
case LogCache#log_cache.all_runs of
diff --git a/lib/common_test/src/ct_netconfc.erl b/lib/common_test/src/ct_netconfc.erl
index 85fb1ea8d2..80ffb51ab9 100644
--- a/lib/common_test/src/ct_netconfc.erl
+++ b/lib/common_test/src/ct_netconfc.erl
@@ -172,6 +172,7 @@
only_open/2,
hello/1,
hello/2,
+ hello/3,
close_session/1,
close_session/2,
kill_session/2,
@@ -456,23 +457,35 @@ only_open(KeyOrName, ExtraOpts) ->
%%----------------------------------------------------------------------
%% @spec hello(Client) -> Result
-%% @equiv hello(Client, infinity)
+%% @equiv hello(Client, [], infinity)
hello(Client) ->
- hello(Client,?DEFAULT_TIMEOUT).
+ hello(Client,[],?DEFAULT_TIMEOUT).
%%----------------------------------------------------------------------
-spec hello(Client,Timeout) -> Result when
Client :: handle(),
Timeout :: timeout(),
Result :: ok | {error,error_reason()}.
+%% @spec hello(Client, Timeout) -> Result
+%% @equiv hello(Client, [], Timeout)
+hello(Client,Timeout) ->
+ hello(Client,[],Timeout).
+
+%%----------------------------------------------------------------------
+-spec hello(Client,Options,Timeout) -> Result when
+ Client :: handle(),
+ Options :: [{capability, [string()]}],
+ Timeout :: timeout(),
+ Result :: ok | {error,error_reason()}.
%% @doc Exchange `hello' messages with the server.
%%
-%% Sends a `hello' message to the server and waits for the return.
-%%
+%% Adds optional capabilities and sends a `hello' message to the
+%% server and waits for the return.
%% @end
%%----------------------------------------------------------------------
-hello(Client,Timeout) ->
- call(Client, {hello, Timeout}).
+hello(Client,Options,Timeout) ->
+ call(Client, {hello, Options, Timeout}).
+
%%----------------------------------------------------------------------
%% @spec get_session_id(Client) -> Result
@@ -1040,9 +1053,9 @@ terminate(_, #state{connection=Connection}) ->
ok.
%% @private
-handle_msg({hello,Timeout}, From,
+handle_msg({hello, Options, Timeout}, From,
#state{connection=Connection,hello_status=HelloStatus} = State) ->
- case do_send(Connection, client_hello()) of
+ case do_send(Connection, client_hello(Options)) of
ok ->
case HelloStatus of
undefined ->
@@ -1118,7 +1131,9 @@ handle_msg({Ref,timeout},#state{pending=Pending} = State) ->
close_session -> stop;
_ -> noreply
end,
- {R,State#state{pending=Pending1}}.
+ %% Halfhearted try to get in correct state, this matches
+ %% the implementation before this patch
+ {R,State#state{pending=Pending1, buff= <<>>}}.
%% @private
%% Called by ct_util_server to close registered connections before terminate.
@@ -1222,10 +1237,14 @@ set_request_timer(T) ->
%%%-----------------------------------------------------------------
-client_hello() ->
+client_hello(Options) when is_list(Options) ->
+ UserCaps = [{capability, UserCap} ||
+ {capability, UserCap} <- Options,
+ is_list(hd(UserCap))],
{hello, ?NETCONF_NAMESPACE_ATTR,
[{capabilities,
- [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}]}]}.
+ [{capability,[?NETCONF_BASE_CAP++?NETCONF_BASE_CAP_VSN]}|
+ UserCaps]}]}.
%%%-----------------------------------------------------------------
@@ -1308,72 +1327,54 @@ to_xml_doc(Simple) ->
%%%-----------------------------------------------------------------
%%% Parse and handle received XML data
-handle_data(NewData,#state{connection=Connection,buff=Buff} = State) ->
+handle_data(NewData,#state{connection=Connection,buff=Buff0} = State0) ->
log(Connection,recv,NewData),
- Data = <<Buff/binary,NewData/binary>>,
- case xmerl_sax_parser:stream(<<>>,
- [{continuation_fun,fun sax_cont/1},
- {continuation_state,{Data,Connection,false}},
- {event_fun,fun sax_event/3},
- {event_state,[]}]) of
- {ok, Simple, Rest} ->
- decode(Simple,State#state{buff=Rest});
- {fatal_error,_Loc,Reason,_EndTags,_EventState} ->
- ?error(Connection#connection.name,[{parse_error,Reason},
- {buffer,Buff},
- {new_data,NewData}]),
- case Reason of
- {could_not_fetch_data,Msg} ->
- handle_msg(Msg,State#state{buff = <<>>});
- _Other ->
- Pending1 =
- case State#state.pending of
- [] ->
- [];
- Pending ->
- %% Assuming the first request gets the
- %% first answer
- P=#pending{tref=TRef,caller=Caller} =
- lists:last(Pending),
- _ = timer:cancel(TRef),
- Reason1 = {failed_to_parse_received_data,Reason},
- ct_gen_conn:return(Caller,{error,Reason1}),
- lists:delete(P,Pending)
- end,
- {noreply,State#state{pending=Pending1,buff = <<>>}}
- end
- end.
-
-%%%-----------------------------------------------------------------
-%%% Parsing of XML data
-%% Contiuation function for the sax parser
-sax_cont(done) ->
- {<<>>,done};
-sax_cont({Data,Connection,false}) ->
+ Data = append_wo_initial_nl(Buff0,NewData),
case binary:split(Data,[?END_TAG],[]) of
- [All] ->
- %% No end tag found. Remove what could be a part
- %% of an end tag from the data and save for next
- %% iteration
- SafeSize = size(All)-5,
- <<New:SafeSize/binary,Save:5/binary>> = All,
- {New,{Save,Connection,true}};
- [_Msg,_Rest]=Msgs ->
- %% We have at least one full message. Any excess data will
- %% be returned from xmerl_sax_parser:stream/2 in the Rest
- %% parameter.
- {list_to_binary(Msgs),done}
- end;
-sax_cont({Data,Connection,true}) ->
- case ssh_receive_data() of
- {ok,Bin} ->
- log(Connection,recv,Bin),
- sax_cont({<<Data/binary,Bin/binary>>,Connection,false});
- {error,Reason} ->
- throw({could_not_fetch_data,Reason})
+ [_NoEndTagFound] ->
+ {noreply, State0#state{buff=Data}};
+ [FirstMsg,Buff1] ->
+ SaxArgs = [{event_fun,fun sax_event/3}, {event_state,[]}],
+ case xmerl_sax_parser:stream(FirstMsg, SaxArgs) of
+ {ok, Simple, _Thrash} ->
+ case decode(Simple, State0#state{buff=Buff1}) of
+ {noreply, #state{buff=Buff} = State} when Buff =/= <<>> ->
+ %% Recurse if we have more data in buffer
+ handle_data(<<>>, State);
+ Other ->
+ Other
+ end;
+ {fatal_error,_Loc,Reason,_EndTags,_EventState} ->
+ ?error(Connection#connection.name,
+ [{parse_error,Reason},
+ {buffer, Buff0},
+ {new_data,NewData}]),
+ handle_error(Reason, State0#state{buff= <<>>})
+ end
end.
-
+%% xml does not accept a leading nl and some netconf server add a nl after
+%% each ?END_TAG, ignore them
+append_wo_initial_nl(<<>>,NewData) -> NewData;
+append_wo_initial_nl(<<"\n", Data/binary>>, NewData) ->
+ append_wo_initial_nl(Data, NewData);
+append_wo_initial_nl(Data, NewData) ->
+ <<Data/binary, NewData/binary>>.
+
+handle_error(Reason, State) ->
+ Pending1 = case State#state.pending of
+ [] -> [];
+ Pending ->
+ %% Assuming the first request gets the
+ %% first answer
+ P=#pending{tref=TRef,caller=Caller} =
+ lists:last(Pending),
+ _ = timer:cancel(TRef),
+ Reason1 = {failed_to_parse_received_data,Reason},
+ ct_gen_conn:return(Caller,{error,Reason1}),
+ lists:delete(P,Pending)
+ end,
+ {noreply, State#state{pending=Pending1}}.
%% Event function for the sax parser. It builds a simple XML structure.
%% Care is taken to keep namespace attributes and prefixes as in the original XML.
@@ -1836,16 +1837,6 @@ get_tag([]) ->
%%%-----------------------------------------------------------------
%%% SSH stuff
-ssh_receive_data() ->
- receive
- {ssh_cm, CM, {data, Ch, _Type, Data}} ->
- ssh_connection:adjust_window(CM,Ch,size(Data)),
- {ok, Data};
- {ssh_cm, _CM, {Closed, _Ch}} = X when Closed == closed; Closed == eof ->
- {error,X};
- {_Ref,timeout} = X ->
- {error,X}
- end.
ssh_open(#options{host=Host,timeout=Timeout,port=Port,ssh=SshOpts,name=Name}) ->
case ssh:connect(Host, Port,
diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl
index 4a12481214..be547b443b 100644
--- a/lib/common_test/src/ct_run.erl
+++ b/lib/common_test/src/ct_run.erl
@@ -225,18 +225,24 @@ finish(Tracing, ExitStatus, Args) ->
if ExitStatus == interactive_mode ->
interactive_mode;
true ->
- %% it's possible to tell CT to finish execution with a call
- %% to a different function than the normal halt/1 BIF
- %% (meant to be used mainly for reading the CT exit status)
- case get_start_opt(halt_with,
- fun([HaltMod,HaltFunc]) ->
- {list_to_atom(HaltMod),
- list_to_atom(HaltFunc)} end,
- Args) of
- undefined ->
- halt(ExitStatus);
- {M,F} ->
- apply(M, F, [ExitStatus])
+ case get_start_opt(vts, true, Args) of
+ true ->
+ %% VTS mode, don't halt the node
+ ok;
+ _ ->
+ %% it's possible to tell CT to finish execution with a call
+ %% to a different function than the normal halt/1 BIF
+ %% (meant to be used mainly for reading the CT exit status)
+ case get_start_opt(halt_with,
+ fun([HaltMod,HaltFunc]) ->
+ {list_to_atom(HaltMod),
+ list_to_atom(HaltFunc)} end,
+ Args) of
+ undefined ->
+ halt(ExitStatus);
+ {M,F} ->
+ apply(M, F, [ExitStatus])
+ end
end
end.
@@ -244,7 +250,7 @@ script_start1(Parent, Args) ->
%% read general start flags
Label = get_start_opt(label, fun([Lbl]) -> Lbl end, Args),
Profile = get_start_opt(profile, fun([Prof]) -> Prof end, Args),
- Vts = get_start_opt(vts, true, Args),
+ Vts = get_start_opt(vts, true, undefined, Args),
Shell = get_start_opt(shell, true, Args),
Cover = get_start_opt(cover, fun([CoverFile]) -> ?abs(CoverFile) end, Args),
CoverStop = get_start_opt(cover_stop,
@@ -330,8 +336,8 @@ script_start1(Parent, Args) ->
Stylesheet = get_start_opt(stylesheet,
fun([SS]) -> ?abs(SS) end, Args),
%% basic_html - used by ct_logs
- BasicHtml = case proplists:get_value(basic_html, Args) of
- undefined ->
+ BasicHtml = case {Vts,proplists:get_value(basic_html, Args)} of
+ {undefined,undefined} ->
application:set_env(common_test, basic_html, false),
undefined;
_ ->
@@ -364,9 +370,10 @@ script_start1(Parent, Args) ->
scale_timetraps = ScaleTT,
create_priv_dir = CreatePrivDir,
starter = script},
-
+
%% check if log files should be refreshed or go on to run tests...
Result = run_or_refresh(Opts, Args),
+
%% send final results to starting process waiting in script_start/0
Parent ! {self(), Result}.
@@ -757,21 +764,6 @@ script_start4(Opts = #opts{tests = Tests}, Args) ->
%%% @doc Print usage information for <code>ct_run</code>.
script_usage() ->
io:format("\n\nUsage:\n\n"),
- io:format("Run tests in web based GUI:\n\n"
- "\tct_run -vts [-browser Browser]"
- "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]"
- "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]"
- "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |"
- "\n\t[-suite Suite [-case Case]]"
- "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]"
- "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]"
- "\n\t[-include InclDir1 InclDir2 .. InclDirN]"
- "\n\t[-no_auto_compile]"
- "\n\t[-abort_if_missing_suites]"
- "\n\t[-multiply_timetraps N]"
- "\n\t[-scale_timetraps]"
- "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]"
- "\n\t[-basic_html]\n\n"),
io:format("Run tests from command line:\n\n"
"\tct_run [-dir TestDir1 TestDir2 .. TestDirN] |"
"\n\t[[-dir TestDir] -suite Suite1 Suite2 .. SuiteN"
@@ -831,7 +823,22 @@ script_usage() ->
io:format("Run CT in interactive mode:\n\n"
"\tct_run -shell"
"\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]"
- "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n").
+ "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]\n\n"),
+ io:format("Run tests in web based GUI:\n\n"
+ "\tct_run -vts [-browser Browser]"
+ "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]"
+ "\n\t[-decrypt_key Key] | [-decrypt_file KeyFile]"
+ "\n\t[-dir TestDir1 TestDir2 .. TestDirN] |"
+ "\n\t[-suite Suite [-case Case]]"
+ "\n\t[-logopts LogOpt1 LogOpt2 .. LogOptN]"
+ "\n\t[-verbosity GenVLvl | [CategoryVLvl1 .. CategoryVLvlN]]"
+ "\n\t[-include InclDir1 InclDir2 .. InclDirN]"
+ "\n\t[-no_auto_compile]"
+ "\n\t[-abort_if_missing_suites]"
+ "\n\t[-multiply_timetraps N]"
+ "\n\t[-scale_timetraps]"
+ "\n\t[-create_priv_dir auto_per_run | auto_per_tc | manual_per_tc]"
+ "\n\t[-basic_html]\n\n").
%%%-----------------------------------------------------------------
%%% @hidden
diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl
index d906a267a1..844f53731e 100644
--- a/lib/common_test/src/ct_telnet.erl
+++ b/lib/common_test/src/ct_telnet.erl
@@ -486,7 +486,8 @@ expect(Connection,Patterns) ->
%%% Opts = [Opt]
%%% Opt = {idle_timeout,IdleTimeout} | {total_timeout,TotalTimeout} |
%%% repeat | {repeat,N} | sequence | {halt,HaltPatterns} |
-%%% ignore_prompt | no_prompt_check
+%%% ignore_prompt | no_prompt_check | wait_for_prompt |
+%%% {wait_for_prompt,Prompt}
%%% IdleTimeout = infinity | integer()
%%% TotalTimeout = infinity | integer()
%%% N = integer()
@@ -499,9 +500,9 @@ expect(Connection,Patterns) ->
%%%
%%% @doc Get data from telnet and wait for the expected pattern.
%%%
-%%% <p><code>Pattern</code> can be a POSIX regular expression. If more
-%%% than one pattern is given, the function returns when the first
-%%% match is found.</p>
+%%% <p><code>Pattern</code> can be a POSIX regular expression. The function
+%%% returns as soon as a pattern has been successfully matched (at least one,
+%%% in the case of multiple patterns).</p>
%%%
%%% <p><code>RxMatch</code> is a list of matched strings. It looks
%%% like this: <code>[FullMatch, SubMatch1, SubMatch2, ...]</code>
@@ -524,10 +525,13 @@ expect(Connection,Patterns) ->
%%% milliseconds, <code>{error,timeout}</code> is returned. The default
%%% value is <code>infinity</code> (i.e. no time limit).</p>
%%%
-%%% <p>The function will always return when a prompt is found, unless
-%%% any of the <code>ignore_prompt</code> or
-%%% <code>no_prompt_check</code> options are used, in which case it
-%%% will return when a match is found or after a timeout.</p>
+%%% <p>The function will return when a prompt is received, even if no
+%%% pattern has yet been matched. In this event,
+%%% <code>{error,{prompt,Prompt}}</code> is returned.
+%%% However, this behaviour may be modified with the
+%%% <code>ignore_prompt</code> or <code>no_prompt_check</code> option, which
+%%% tells <code>expect</code> to return only when a match is found or after a
+%%% timeout.</p>
%%%
%%% <p>If the <code>ignore_prompt</code> option is used,
%%% <code>ct_telnet</code> will ignore any prompt found. This option
@@ -541,6 +545,13 @@ expect(Connection,Patterns) ->
%%% is useful if, for instance, the <code>Pattern</code> itself
%%% matches the prompt.</p>
%%%
+%%% <p>The <code>wait_for_prompt</code> option forces <code>ct_telnet</code>
+%%% to wait until the prompt string has been received before returning
+%%% (even if a pattern has already been matched). This is equal to calling:
+%%% <code>expect(Conn, Patterns++[{prompt,Prompt}], [sequence|Opts])</code>.
+%%% Note that <code>idle_timeout</code> and <code>total_timeout</code>
+%%% may abort the operation of waiting for prompt.</p>
+%%%
%%% <p>The <code>repeat</code> option indicates that the pattern(s)
%%% shall be matched multiple times. If <code>N</code> is given, the
%%% pattern(s) will be matched <code>N</code> times, and the function
@@ -653,18 +664,21 @@ handle_msg({cmd,Cmd,Opts},State) ->
start_gen_log(heading(cmd,State#state.name)),
log(State,cmd,"Cmd: ~p",[Cmd]),
+ %% whatever is in the buffer from previous operations
+ %% will be ignored as we go ahead with this telnet cmd
+
debug_cont_gen_log("Throwing Buffer:",[]),
debug_log_lines(State#state.buffer),
case {State#state.type,State#state.prompt} of
- {ts,_} ->
+ {ts,_} ->
silent_teln_expect(State#state.name,
State#state.teln_pid,
State#state.buffer,
prompt,
State#state.prx,
[{idle_timeout,2000}]);
- {ip,false} ->
+ {ip,false} ->
silent_teln_expect(State#state.name,
State#state.teln_pid,
State#state.buffer,
@@ -1029,10 +1043,12 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) ->
end,
PromptCheck = get_prompt_check(Opts),
- Seq = get_seq(Opts),
- Pattern = convert_pattern(Pattern0,Seq),
- {IdleTimeout,TotalTimeout} = get_timeouts(Opts),
+ {WaitForPrompt,Pattern1,Opts1} = wait_for_prompt(Pattern0,Opts),
+
+ Seq = get_seq(Opts1),
+ Pattern2 = convert_pattern(Pattern1,Seq),
+ {IdleTimeout,TotalTimeout} = get_timeouts(Opts1),
EO = #eo{teln_pid=Pid,
prx=Prx,
@@ -1042,9 +1058,16 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) ->
haltpatterns=HaltPatterns,
prompt_check=PromptCheck},
- case get_repeat(Opts) of
+ case get_repeat(Opts1) of
false ->
- case teln_expect1(Name,Pid,Data,Pattern,[],EO) of
+ case teln_expect1(Name,Pid,Data,Pattern2,[],EO) of
+ {ok,Matched,Rest} when WaitForPrompt ->
+ case lists:reverse(Matched) of
+ [{prompt,_},Matched1] ->
+ {ok,Matched1,Rest};
+ [{prompt,_}|Matched1] ->
+ {ok,lists:reverse(Matched1),Rest}
+ end;
{ok,Matched,Rest} ->
{ok,Matched,Rest};
{halt,Why,Rest} ->
@@ -1054,7 +1077,7 @@ teln_expect(Name,Pid,Data,Pattern0,Prx,Opts) ->
end;
N ->
EO1 = EO#eo{repeat=N},
- repeat_expect(Name,Pid,Data,Pattern,[],EO1)
+ repeat_expect(Name,Pid,Data,Pattern2,[],EO1)
end.
convert_pattern(Pattern,Seq)
@@ -1118,6 +1141,40 @@ get_ignore_prompt(Opts) ->
get_prompt_check(Opts) ->
not lists:member(no_prompt_check,Opts).
+wait_for_prompt(Pattern, Opts) ->
+ case lists:member(wait_for_prompt, Opts) of
+ true ->
+ wait_for_prompt1(prompt, Pattern,
+ lists:delete(wait_for_prompt,Opts));
+ false ->
+ case proplists:get_value(wait_for_prompt, Opts) of
+ undefined ->
+ {false,Pattern,Opts};
+ PromptStr ->
+ wait_for_prompt1({prompt,PromptStr}, Pattern,
+ proplists:delete(wait_for_prompt,Opts))
+ end
+ end.
+
+wait_for_prompt1(Prompt, [Ch|_] = Pattern, Opts) when is_integer(Ch) ->
+ wait_for_prompt2(Prompt, [Pattern], Opts);
+wait_for_prompt1(Prompt, Pattern, Opts) when is_list(Pattern) ->
+ wait_for_prompt2(Prompt, Pattern, Opts);
+wait_for_prompt1(Prompt, Pattern, Opts) ->
+ wait_for_prompt2(Prompt, [Pattern], Opts).
+
+wait_for_prompt2(Prompt, Pattern, Opts) ->
+ Pattern1 = case lists:reverse(Pattern) of
+ [prompt|_] -> Pattern;
+ [{prompt,_}|_] -> Pattern;
+ _ -> Pattern ++ [Prompt]
+ end,
+ Opts1 = case lists:member(sequence, Opts) of
+ true -> Opts;
+ false -> [sequence|Opts]
+ end,
+ {true,Pattern1,Opts1}.
+
%% Repeat either single or sequence. All match results are accumulated
%% and returned when a halt condition is fulllfilled.
repeat_expect(_Name,_Pid,Rest,_Pattern,Acc,#eo{repeat=0}) ->
@@ -1210,7 +1267,7 @@ get_data1(Pid) ->
%% 1) Single expect.
%% First the whole data chunk is searched for a prompt (to avoid doing
%% a regexp match for the prompt at each line).
-%% If we are searching for anyting else, the datachunk is split into
+%% If we are searching for anything else, the datachunk is split into
%% lines and each line is matched against each pattern.
%% one_expect: split data chunk at prompts
@@ -1227,7 +1284,7 @@ one_expect(Name,Pid,Data,Pattern,EO) ->
log(name_or_pid(Name,Pid),"PROMPT: ~ts",[PromptType]),
{match,{prompt,PromptType},Rest};
[{prompt,_OtherPromptType}] ->
- %% Only searching for one specific prompt, not thisone
+ %% Only searching for one specific prompt, not this one
log_lines(Name,Pid,UptoPrompt),
{nomatch,Rest};
_ ->
diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl
new file mode 100644
index 0000000000..b67a7c2a92
--- /dev/null
+++ b/lib/common_test/src/ct_webtool.erl
@@ -0,0 +1,1207 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2010. 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(ct_webtool).
+-behaviour(gen_server).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% The general idea is: %%
+%% %%
+%% %%
+%% 1. Scan through the path for *.tool files and find all the web %%
+%% based tools. Query each tool for configuration data. %%
+%% 2. Add Alias for Erlscript and html for each tool to %%
+%% the webserver configuration data. %%
+%% 3. Start the webserver. %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%% API functions
+-export([start/0, start/2, stop/0]).
+
+%% Starting Webtool from a shell script
+-export([script_start/0, script_start/1]).
+
+%% Web api
+-export([started_tools/2, toolbar/2, start_tools/2, stop_tools/2]).
+
+%% API against other tools
+-export([is_localhost/0]).
+
+%% Debug export s
+-export([get_tools1/1]).
+-export([debug/1, stop_debug/0, debug_app/1]).
+
+%% gen_server callbacks
+-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
+ terminate/2, code_change/3]).
+
+-include_lib("kernel/include/file.hrl").
+-include_lib("stdlib/include/ms_transform.hrl").
+
+-record(state,{priv_dir,app_data,supvis,web_data,started=[]}).
+
+-define(MAX_NUMBER_OF_WEBTOOLS,256).
+-define(DEFAULT_PORT,8888).% must be >1024 or the user must be root on unix
+-define(DEFAULT_ADDR,{127,0,0,1}).
+
+-define(WEBTOOL_ALIAS,{ct_webtool,[{alias,{erl_alias,"/ct_webtool",[ct_webtool]}}]}).
+-define(HEADER,"Pragma:no-cache\r\n Content-type: text/html\r\n\r\n").
+-define(HTML_HEADER,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool</TITLE>\r\n</HEAD>\r\n<BODY BGCOLOR=\"#FFFFFF\">\r\n").
+-define(HTML_HEADER_RELOAD,"<HTML>\r\n<HEAD>\r\n<TITLE>WebTool
+ </TITLE>\r\n</HEAD>\r\n
+ <BODY BGCOLOR=\"#FFFFFF\" onLoad=reloadCompiledList()>\r\n").
+
+-define(HTML_END,"</BODY></HTML>").
+
+-define(SEND_URL_TIMEOUT,5000).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% For debugging only. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Start tracing with
+%% debug(Functions).
+%% Functions = local | global | FunctionList
+%% FunctionList = [Function]
+%% Function = {FunctionName,Arity} | FunctionName |
+%% {Module, FunctionName, Arity} | {Module,FunctionName}
+debug(F) ->
+ ttb:tracer(all,[{file,"webtool.trc"}]), % tracing all nodes
+ ttb:p(all,[call,timestamp]),
+ MS = [{'_',[],[{return_trace},{message,{caller}}]}],
+ tp(F,MS),
+ ttb:ctp(?MODULE,stop_debug), % don't want tracing of the stop_debug func
+ ok.
+tp(local,MS) -> % all functions
+ ttb:tpl(?MODULE,MS);
+tp(global,MS) -> % all exported functions
+ ttb:tp(?MODULE,MS);
+tp([{M,F,A}|T],MS) -> % Other module
+ ttb:tpl(M,F,A,MS),
+ tp(T,MS);
+tp([{M,F}|T],MS) when is_atom(F) -> % Other module
+ ttb:tpl(M,F,MS),
+ tp(T,MS);
+tp([{F,A}|T],MS) -> % function/arity
+ ttb:tpl(?MODULE,F,A,MS),
+ tp(T,MS);
+tp([F|T],MS) -> % function
+ ttb:tpl(?MODULE,F,MS),
+ tp(T,MS);
+tp([],_MS) ->
+ ok.
+stop_debug() ->
+ ttb:stop([format]).
+
+debug_app(Mod) ->
+ ttb:tracer(all,[{file,"webtool_app.trc"},{handler,{fun out/4,true}}]),
+ ttb:p(all,[call,timestamp]),
+ MS = [{'_',[],[{return_trace},{message,{caller}}]}],
+ ttb:tp(Mod,MS),
+ ok.
+
+out(_,{trace_ts,Pid,call,MFA={M,F,A},{W,_,_},TS},_,S)
+ when W==webtool;W==mod_esi->
+ io:format("~w: (~p)~ncall ~s~n", [TS,Pid,ffunc(MFA)]),
+ [{M,F,length(A)}|S];
+out(_,{trace_ts,Pid,return_from,MFA,R,TS},_,[MFA|S]) ->
+ io:format("~w: (~p)~nreturned from ~s -> ~p~n", [TS,Pid,ffunc(MFA),R]),
+ S;
+out(_,_,_,_) ->
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Functions called via script. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+script_start() ->
+ usage(),
+ halt().
+script_start([App]) ->
+ DefaultBrowser =
+ case os:type() of
+ {win32,_} -> iexplore;
+ _ -> firefox
+ end,
+ script_start([App,DefaultBrowser]);
+script_start([App,Browser]) ->
+ io:format("Starting webtool...\n"),
+ start(),
+ AvailableApps = get_applications(),
+ {OSType,_} = os:type(),
+ case lists:keysearch(App,1,AvailableApps) of
+ {value,{App,StartPage}} ->
+ io:format("Starting ~w...\n",[App]),
+ start_tools([],"app=" ++ atom_to_list(App)),
+ PortStr = integer_to_list(get_port()),
+ Url = case StartPage of
+ "/" ++ Page ->
+ "http://localhost:" ++ PortStr ++ "/" ++ Page;
+ _ ->
+ "http://localhost:" ++ PortStr ++ "/" ++ StartPage
+ end,
+ case Browser of
+ none ->
+ ok;
+ iexplore when OSType == win32->
+ io:format("Starting internet explorer...\n"),
+ {ok,R} = win32reg:open(""),
+ Key="\\local_machine\\SOFTWARE\\Microsoft\\IE Setup\\Setup",
+ win32reg:change_key(R,Key),
+ {ok,Val} = win32reg:value(R,"Path"),
+ IExplore=filename:join(win32reg:expand(Val),"iexplore.exe"),
+ os:cmd("\"" ++ IExplore ++ "\" " ++ Url);
+ _ when OSType == win32 ->
+ io:format("Starting ~w...\n",[Browser]),
+ os:cmd("\"" ++ atom_to_list(Browser) ++ "\" " ++ Url);
+ B when B==firefox; B==mozilla ->
+ io:format("Sending URL to ~w...",[Browser]),
+ BStr = atom_to_list(Browser),
+ SendCmd = BStr ++ " -raise -remote \'openUrl(" ++
+ Url ++ ")\'",
+ Port = open_port({spawn,SendCmd},[exit_status]),
+ receive
+ {Port,{exit_status,0}} ->
+ io:format("done\n"),
+ ok;
+ {Port,{exit_status,_Error}} ->
+ io:format(" not running, starting ~w...\n",
+ [Browser]),
+ os:cmd(BStr ++ " " ++ Url),
+ ok
+ after ?SEND_URL_TIMEOUT ->
+ io:format(" failed, starting ~w...\n",[Browser]),
+ erlang:port_close(Port),
+ os:cmd(BStr ++ " " ++ Url)
+ end;
+ _ ->
+ io:format("Starting ~w...\n",[Browser]),
+ os:cmd(atom_to_list(Browser) ++ " " ++ Url)
+ end,
+ ok;
+ false ->
+ stop(),
+ io:format("\n{error,{unknown_app,~p}}\n",[App]),
+ halt()
+ end.
+
+usage() ->
+ io:format("Starting webtool...\n"),
+ start(),
+ Apps = lists:map(fun({A,_}) -> A end,get_applications()),
+ io:format(
+ "\nUsage: start_webtool application [ browser ]\n"
+ "\nAvailable applications are: ~p\n"
+ "Default browser is \'iexplore\' (Internet Explorer) on Windows "
+ "or else \'firefox\'\n",
+ [Apps]),
+ stop().
+
+
+get_applications() ->
+ gen_server:call(ct_web_tool,get_applications).
+
+get_port() ->
+ gen_server:call(ct_web_tool,get_port).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Api functions to the genserver. %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%
+%----------------------------------------------------------------------
+
+start()->
+ start(standard_path,standard_data).
+
+start(Path,standard_data)->
+ case get_standard_data() of
+ {error,Reason} ->
+ {error,Reason};
+ Data ->
+ start(Path,Data)
+ end;
+
+start(standard_path,Data)->
+ Path=get_path(),
+ start(Path,Data);
+
+start(Path,Port) when is_integer(Port)->
+ Data = get_standard_data(Port),
+ start(Path,Data);
+
+start(Path,Data0)->
+ Data = Data0 ++ rest_of_standard_data(),
+ gen_server:start({local,ct_web_tool},ct_webtool,{Path,Data},[]).
+
+stop()->
+ gen_server:call(ct_web_tool,stoppit).
+
+%----------------------------------------------------------------------
+%Web Api functions called by the web
+%----------------------------------------------------------------------
+started_tools(Env,Input)->
+ gen_server:call(ct_web_tool,{started_tools,Env,Input}).
+
+toolbar(Env,Input)->
+ gen_server:call(ct_web_tool,{toolbar,Env,Input}).
+
+start_tools(Env,Input)->
+ gen_server:call(ct_web_tool,{start_tools,Env,Input}).
+
+stop_tools(Env,Input)->
+ gen_server:call(ct_web_tool,{stop_tools,Env,Input}).
+%----------------------------------------------------------------------
+%Support API for other tools
+%----------------------------------------------------------------------
+
+is_localhost()->
+ gen_server:call(ct_web_tool,is_localhost).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%%The gen_server callback functions that builds the webbpages %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+handle_call(get_applications,_,State)->
+ MS = ets:fun2ms(fun({Tool,{web_data,{_,Start}}}) -> {Tool,Start} end),
+ Tools = ets:select(State#state.app_data,MS),
+ {reply,Tools,State};
+
+handle_call(get_port,_,State)->
+ {value,{port,Port}}=lists:keysearch(port,1,State#state.web_data),
+ {reply,Port,State};
+
+handle_call({started_tools,_Env,_Input},_,State)->
+ {reply,started_tools_page(State),State};
+
+handle_call({toolbar,_Env,_Input},_,State)->
+ {reply,toolbar(),State};
+
+handle_call({start_tools,Env,Input},_,State)->
+ {NewState,Page}=start_tools_page(Env,Input,State),
+ {reply,Page,NewState};
+
+handle_call({stop_tools,Env,Input},_,State)->
+ {NewState,Page}=stop_tools_page(Env,Input,State),
+ {reply,Page,NewState};
+
+handle_call(stoppit,_From,Data)->
+ {stop,normal,ok,Data};
+
+handle_call(is_localhost,_From,Data)->
+ Result=case proplists:get_value(bind_address, Data#state.web_data) of
+ ?DEFAULT_ADDR ->
+ true;
+ _IpNumber ->
+ false
+ end,
+ {reply,Result,Data}.
+
+
+handle_info(_Message,State)->
+ {noreply,State}.
+
+handle_cast(_Request,State)->
+ {noreply,State}.
+
+code_change(_,State,_)->
+ {ok,State}.
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% The other functions needed by the gen_server behaviour
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+% Start the gen_server
+%----------------------------------------------------------------------
+init({Path,Config})->
+ case filelib:is_dir(Path) of
+ true ->
+ {ok, Table} = get_tool_files_data(),
+ insert_app(?WEBTOOL_ALIAS, Table),
+ case ct_webtool_sup:start_link() of
+ {ok, Pid} ->
+ case start_webserver(Table, Path, Config) of
+ {ok, _} ->
+ print_url(Config),
+ {ok,#state{priv_dir=Path,
+ app_data=Table,
+ supvis=Pid,
+ web_data=Config}};
+ {error, Error} ->
+ {stop, {error, Error}}
+ end;
+ Error ->
+ {stop,Error}
+ end;
+ false ->
+ {stop, {error, error_dir}}
+ end.
+
+terminate(_Reason,Data)->
+ %%shut down the webbserver
+ shutdown_server(Data),
+ %%Shutdown the different tools that are started with application:start
+ shutdown_apps(Data),
+ %%Shutdown the supervisor and its children will die
+ shutdown_supervisor(Data),
+ ok.
+
+print_url(ConfigData)->
+ Server=proplists:get_value(server_name,ConfigData,"undefined"),
+ Port=proplists:get_value(port,ConfigData,"undefined"),
+ {A,B,C,D}=proplists:get_value(bind_address,ConfigData,"undefined"),
+ io:format("WebTool is available at http://~s:~w/~n",[Server,Port]),
+ io:format("Or http://~w.~w.~w.~w:~w/~n",[A,B,C,D,Port]).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% begin build the pages
+%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+%The page that shows the started tools
+%----------------------------------------------------------------------
+started_tools_page(State)->
+ [?HEADER,?HTML_HEADER,started_tools(State),?HTML_END].
+
+toolbar()->
+ [?HEADER,?HTML_HEADER,toolbar_page(),?HTML_END].
+
+
+start_tools_page(_Env,Input,State)->
+ %%io:format("~n======= ~n ~p ~n============~n",[Input]),
+ case get_tools(Input) of
+ {tools,Tools}->
+ %%io:format("~n======= ~n ~p ~n============~n",[Tools]),
+ {ok,NewState}=handle_apps(Tools,State,start),
+ {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(),
+ show_unstarted_apps(NewState),?HTML_END]};
+ _ ->
+ {State,[?HEADER,?HTML_HEADER,show_unstarted_apps(State),?HTML_END]}
+ end.
+
+stop_tools_page(_Env,Input,State)->
+ case get_tools(Input) of
+ {tools,Tools}->
+ {ok,NewState}=handle_apps(Tools,State,stop),
+ {NewState,[?HEADER,?HTML_HEADER_RELOAD,reload_started_apps(),
+ show_started_apps(NewState),?HTML_END]};
+ _ ->
+ {State,[?HEADER,?HTML_HEADER,show_started_apps(State),?HTML_END]}
+ end.
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% Functions that start and config the webserver
+%% 1. Collect the config data
+%% 2. Start webserver
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+% Start the webserver
+%----------------------------------------------------------------------
+start_webserver(Data,Path,Config)->
+ case get_conf_data(Data,Path,Config) of
+ {ok,Conf_data}->
+ %%io:format("Conf_data: ~p~n",[Conf_data]),
+ start_server(Conf_data);
+ {error,Error} ->
+ {error,{error_server_conf_file,Error}}
+ end.
+
+start_server(Conf_data)->
+ case inets:start(httpd, Conf_data, stand_alone) of
+ {ok,Pid}->
+ {ok,Pid};
+ Error->
+ {error,{server_error,Error}}
+ end.
+
+%----------------------------------------------------------------------
+% Create config data for the webserver
+%----------------------------------------------------------------------
+get_conf_data(Data,Path,Config)->
+ Aliases=get_aliases(Data),
+ ServerRoot = filename:join([Path,"root"]),
+ MimeTypesFile = filename:join([ServerRoot,"conf","mime.types"]),
+ case httpd_conf:load_mime_types(MimeTypesFile) of
+ {ok,MimeTypes} ->
+ Config1 = Config ++ Aliases,
+ Config2 = [{server_root,ServerRoot},
+ {document_root,filename:join([Path,"root/doc"])},
+ {mime_types,MimeTypes} |
+ Config1],
+ {ok,Config2};
+ Error ->
+ Error
+ end.
+
+%----------------------------------------------------------------------
+% Control the path for *.tools files
+%----------------------------------------------------------------------
+get_tool_files_data()->
+ Tools=get_tools1(code:get_path()),
+ %%io:format("Data : ~p ~n",[Tools]),
+ get_file_content(Tools).
+
+%----------------------------------------------------------------------
+%Control that the data in the file really is erlang terms
+%----------------------------------------------------------------------
+get_file_content(Tools)->
+ Get_data=fun({tool,ToolData}) ->
+ %%io:format("Data : ~p ~n",[ToolData]),
+ case proplists:get_value(config_func,ToolData) of
+ {M,F,A}->
+ case catch apply(M,F,A) of
+ {'EXIT',_} ->
+ bad_data;
+ Data when is_tuple(Data) ->
+ Data;
+ _->
+ bad_data
+ end;
+ _ ->
+ bad_data
+ end
+ end,
+ insert_file_content([X ||X<-lists:map(Get_data,Tools),X/=bad_data]).
+
+%----------------------------------------------------------------------
+%Insert the data from the file in to the ets:table
+%----------------------------------------------------------------------
+insert_file_content(Content)->
+ Table=ets:new(app_data,[bag]),
+ lists:foreach(fun(X)->
+ insert_app(X,Table)
+ end,Content),
+ {ok,Table}.
+
+%----------------------------------------------------------------------
+%Control that we got a a tuple of a atom and a list if so add the
+%elements in the list to the ets:table
+%----------------------------------------------------------------------
+insert_app({Name,Key_val_list},Table) when is_list(Key_val_list),is_atom(Name)->
+ %%io:format("ToolData: ~p: ~p~n",[Name,Key_val_list]),
+ lists:foreach(
+ fun({alias,{erl_alias,Alias,Mods}}) ->
+ Key_val = {erl_script_alias,{Alias,Mods}},
+ %%io:format("Insert: ~p~n",[Key_val]),
+ ets:insert(Table,{Name,Key_val});
+ (Key_val_pair)->
+ %%io:format("Insert: ~p~n",[Key_val_pair]),
+ ets:insert(Table,{Name,Key_val_pair})
+ end,
+ Key_val_list);
+
+insert_app(_,_)->
+ ok.
+
+%----------------------------------------------------------------------
+% Select all the alias in the database
+%----------------------------------------------------------------------
+get_aliases(Data)->
+ MS = ets:fun2ms(fun({_,{erl_script_alias,Alias}}) ->
+ {erl_script_alias,Alias};
+ ({_,{alias,Alias}}) ->
+ {alias,Alias}
+ end),
+ ets:select(Data,MS).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Helper functions %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+get_standard_data(Port)->
+ [
+ {port,Port},
+ {bind_address,?DEFAULT_ADDR},
+ {server_name,"localhost"}
+ ].
+
+get_standard_data()->
+ case get_free_port(?DEFAULT_PORT,?MAX_NUMBER_OF_WEBTOOLS) of
+ {error,Reason} -> {error,Reason};
+ Port ->
+ [
+ {port,Port},
+ {bind_address,?DEFAULT_ADDR},
+ {server_name,"localhost"}
+ ]
+ end.
+
+get_free_port(_Port,0) ->
+ {error,no_free_port_found};
+get_free_port(Port,N) ->
+ case gen_tcp:connect("localhost",Port,[]) of
+ {error, _Reason} ->
+ Port;
+ {ok,Sock} ->
+ gen_tcp:close(Sock),
+ get_free_port(Port+1,N-1)
+ end.
+
+rest_of_standard_data() ->
+ [
+ %% Do not allow the server to be crashed by malformed http-request
+ {max_header_siz,1024},
+ {max_header_action,reply414},
+ %% Go on a straight ip-socket
+ {com_type,ip_comm},
+ %% Do not change the order of these module names!!
+ {modules,[mod_alias,
+ mod_auth,
+ mod_esi,
+ mod_actions,
+ mod_cgi,
+ mod_include,
+ mod_dir,
+ mod_get,
+ mod_head,
+ mod_log,
+ mod_disk_log]},
+ {directory_index,["index.html"]},
+ {default_type,"text/plain"}
+ ].
+
+
+get_path()->
+ code:priv_dir(webtool).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% These functions is used to shutdown the webserver
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+% Shut down the webbserver
+%----------------------------------------------------------------------
+shutdown_server(State)->
+ {Addr,Port} = get_addr_and_port(State#state.web_data),
+ inets:stop(httpd,{Addr,Port}).
+
+get_addr_and_port(Config) ->
+ Addr = proplists:get_value(bind_address,Config,?DEFAULT_ADDR),
+ Port = proplists:get_value(port,Config,?DEFAULT_PORT),
+ {Addr,Port}.
+
+%----------------------------------------------------------------------
+% Select all apps in the table and close them
+%----------------------------------------------------------------------
+shutdown_apps(State)->
+ Data=State#state.app_data,
+ MS = ets:fun2ms(fun({_,{start,HowToStart}}) -> HowToStart end),
+ lists:foreach(fun(Start_app)->
+ stop_app(Start_app)
+ end,
+ ets:select(Data,MS)).
+
+%----------------------------------------------------------------------
+%Shuts down the supervisor that supervises tools that is not
+%Designed as applications
+%----------------------------------------------------------------------
+shutdown_supervisor(State)->
+ %io:format("~n==================~n"),
+ ct_webtool_sup:stop(State#state.supvis).
+ %io:format("~n==================~n").
+
+%----------------------------------------------------------------------
+%close the individual apps.
+%----------------------------------------------------------------------
+stop_app({child,_Real_name})->
+ ok;
+
+stop_app({app,Real_name})->
+ application:stop(Real_name);
+
+stop_app({func,_Start,Stop})->
+ case Stop of
+ {M,F,A} ->
+ catch apply(M,F,A);
+ _NoStop ->
+ ok
+ end.
+
+
+
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% These functions creates the webpage where the user can select if
+%% to start apps or to stop apps
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+toolbar_page()->
+ "<TABLE>
+ <TR>
+ <TD>
+ <B>Select Action</B>
+ </TD>
+ </TR>
+ <TR>
+ <TD>
+ <A HREF=\"./start_tools\" TARGET=right> Start Tools</A>
+ </TD>
+ </TR>
+ <TR>
+ <TD>
+ <A HREF=\"./stop_tools\" TARGET=right> Stop Tools</A>
+ </TD>
+ </TR>
+ </TABLE>".
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%% These functions creates the webbpage that shows the started apps
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%----------------------------------------------------------------------
+% started_tools(State)->String (html table)
+% State is a record of type state
+%----------------------------------------------------------------------
+started_tools(State)->
+ Names=get_started_apps(State#state.app_data,State#state.started),
+ "<TABLE BORDER=1 WIDTH=100%>
+ "++ make_rows(Names,[],0) ++"
+ </TABLE>".
+%----------------------------------------------------------------------
+%get_started_apps(Data,Started)-> [{web_name,link}]
+%selects the started apps from the ets table of apps.
+%----------------------------------------------------------------------
+
+get_started_apps(Data,Started)->
+ SelectData=fun({Name,Link}) ->
+ {Name,Link}
+ end,
+ MS = lists:map(fun(A) -> {{A,{web_data,'$1'}},[],['$1']} end,Started),
+
+ [{"WebTool","/tool_management.html"} |
+ [SelectData(X) || X <- ets:select(Data,MS)]].
+
+%----------------------------------------------------------------------
+% make_rows(List,Result,Fields)-> String (The rows of a htmltable
+% List a list of tupler discibed above
+% Result an accumulator for the result
+% Field, counter that counts the number of cols in each row.
+%----------------------------------------------------------------------
+make_rows([],Result,Fields)->
+ Result ++ fill_out(Fields);
+make_rows([Data|Paths],Result,Field)when Field==0->
+ make_rows(Paths,Result ++ "<TR>" ++ make_field(Data),Field+1);
+
+make_rows([Path|Paths],Result,Field)when Field==4->
+ make_rows(Paths,Result ++ make_field(Path) ++ "</TR>",0);
+
+make_rows([Path|Paths],Result,Field)->
+ make_rows(Paths,Result ++ make_field(Path),Field+1).
+
+%----------------------------------------------------------------------
+% make_fields(Path)-> String that is a field i a html table
+% Path is a name url tuple {Name,url}
+%----------------------------------------------------------------------
+make_field(Path)->
+ "<TD WIDTH=20%>" ++ get_name(Path) ++ "</TD>".
+
+
+%----------------------------------------------------------------------
+%get_name({Nae,Url})->String that represents a <A> tag in html.
+%----------------------------------------------------------------------
+get_name({Name,Url})->
+ "<A HREF=\"" ++ Url ++ "\" TARGET=app_frame>" ++ Name ++ "</A>".
+
+
+%----------------------------------------------------------------------
+% fill_out(Nr)-> String, that represent Nr fields in a html-table.
+%----------------------------------------------------------------------
+fill_out(Nr)when Nr==0->
+ [];
+fill_out(Nr)when Nr==4->
+ "<TD WIDTH=\"20%\" >&nbsp</TD></TR>";
+
+fill_out(Nr)->
+ "<TD WIDTH=\"20%\">&nbsp</TD>" ++ fill_out(Nr+1).
+
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%%
+%%These functions starts applicatons and builds the page showing tools
+%%to start
+%%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------------------------------------
+%Controls whether the user selected a tool to start
+%----------------------------------------------------------------------
+get_tools(Input)->
+ case httpd:parse_query(Input) of
+ []->
+ no_tools;
+ Tools->
+ FormatData=fun({_Name,Data}) -> list_to_atom(Data) end,
+ SelectData=
+ fun({Name,_Data}) -> string:equal(Name,"app") end,
+ {tools,[FormatData(X)||X<-Tools,SelectData(X)]}
+ end.
+
+%----------------------------------------------------------------------
+% Selects the data to start the applications the user has ordered
+% starting of
+%----------------------------------------------------------------------
+handle_apps([],State,_Cmd)->
+ {ok,State};
+
+handle_apps([Tool|Tools],State,Cmd)->
+ case ets:match_object(State#state.app_data,{Tool,{start,'_'}}) of
+ []->
+ Started = case Cmd of
+ start ->
+ [Tool|State#state.started];
+ stop ->
+ lists:delete(Tool,State#state.started)
+ end,
+ {ok,#state{priv_dir=State#state.priv_dir,
+ app_data=State#state.app_data,
+ supvis=State#state.supvis,
+ web_data=State#state.web_data,
+ started=Started}};
+ ToStart ->
+ case handle_apps2(ToStart,State,Cmd) of
+ {ok,NewState}->
+ handle_apps(Tools,NewState,Cmd);
+ _->
+ handle_apps(Tools,State,Cmd)
+ end
+ end.
+
+%----------------------------------------------------------------------
+%execute every start or stop data about a tool.
+%----------------------------------------------------------------------
+handle_apps2([{Name,Start_data}],State,Cmd)->
+ case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd) of
+ ok->
+ Started = case Cmd of
+ start ->
+ [Name|State#state.started];
+ stop ->
+
+ lists:delete(Name,State#state.started)
+ end,
+ {ok,#state{priv_dir=State#state.priv_dir,
+ app_data=State#state.app_data,
+ supvis=State#state.supvis,
+ web_data=State#state.web_data,
+ started=Started}};
+ _->
+ error
+ end;
+
+handle_apps2([{Name,Start_data}|Rest],State,Cmd)->
+ case handle_app({Name,Start_data},State#state.app_data,State#state.supvis,Cmd)of
+ ok->
+ handle_apps2(Rest,State,Cmd);
+ _->
+ error
+ end.
+
+
+%----------------------------------------------------------------------
+% Handle start and stop of applications
+%----------------------------------------------------------------------
+
+handle_app({Name,{start,{func,Start,Stop}}},Data,_Pid,Cmd)->
+ Action = case Cmd of
+ start ->
+ Start;
+ _ ->
+ Stop
+ end,
+ case Action of
+ {M,F,A} ->
+ case catch apply(M,F,A) of
+ {'EXIT',_} = Exit->
+ %%! Here the tool disappears from the webtool interface!!
+ io:format("\n=======ERROR (webtool, line ~w) =======\n"
+ "Could not start application \'~p\'\n\n"
+ "~w:~w(~s) ->\n"
+ "~p\n\n",
+ [?LINE,Name,M,F,format_args(A),Exit]),
+ ets:delete(Data,Name);
+ _OK->
+ ok
+ end;
+ _NoStart ->
+ ok
+ end;
+
+
+handle_app({Name,{start,{child,ChildSpec}}},Data,Pid,Cmd)->
+ case Cmd of
+ start ->
+ case catch supervisor:start_child(Pid,ChildSpec) of
+ {ok,_}->
+ ok;
+ {ok,_,_}->
+ ok;
+ {error,Reason}->
+ %%! Here the tool disappears from the webtool interface!!
+ io:format("\n=======ERROR (webtool, line ~w) =======\n"
+ "Could not start application \'~p\'\n\n"
+ "supervisor:start_child(~p,~p) ->\n"
+ "~p\n\n",
+ [?LINE,Name,Pid,ChildSpec,{error,Reason}]),
+ ets:delete(Data,Name);
+ Error ->
+ %%! Here the tool disappears from the webtool interface!!
+ io:format("\n=======ERROR (webtool, line ~w) =======\n"
+ "Could not start application \'~p\'\n\n"
+ "supervisor:start_child(~p,~p) ->\n"
+ "~p\n\n",
+ [?LINE,Name,Pid,ChildSpec,Error]),
+ ets:delete(Data,Name)
+ end;
+ stop ->
+ case catch supervisor:terminate_child(websup,element(1,ChildSpec)) of
+ ok ->
+ supervisor:delete_child(websup,element(1,ChildSpec));
+ _ ->
+ error
+ end
+ end;
+
+
+
+handle_app({Name,{start,{app,Real_name}}},Data,_Pid,Cmd)->
+ case Cmd of
+ start ->
+ case application:start(Real_name,temporary) of
+ ok->
+ io:write(Name),
+ ok;
+ {error,{already_started,_}}->
+ %% Remove it from the database so we dont start
+ %% anything already started
+ ets:match_delete(Data,{Name,{start,{app,Real_name}}}),
+ ok;
+ {error,_Reason}=Error->
+ %%! Here the tool disappears from the webtool interface!!
+ io:format("\n=======ERROR (webtool, line ~w) =======\n"
+ "Could not start application \'~p\'\n\n"
+ "application:start(~p,~p) ->\n"
+ "~p\n\n",
+ [?LINE,Name,Real_name,temporary,Error]),
+ ets:delete(Data,Name)
+ end;
+
+ stop ->
+ application:stop(Real_name)
+ end;
+
+%----------------------------------------------------------------------
+% If the data is incorrect delete the app
+%----------------------------------------------------------------------
+handle_app({Name,Incorrect},Data,_Pid,Cmd)->
+ %%! Here the tool disappears from the webtool interface!!
+ io:format("\n=======ERROR (webtool, line ~w) =======\n"
+ "Could not ~w application \'~p\'\n\n"
+ "Incorrect data: ~p\n\n",
+ [?LINE,Cmd,Name,Incorrect]),
+ ets:delete(Data,Name).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% this functions creates the page that shows the unstarted tools %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+reload_started_apps()->
+ "<script>
+ function reloadCompiledList()
+ {
+ parent.parent.top1.document.location.href=\"/webtool/webtool/started_tools\";
+ }
+ </script>".
+
+show_unstarted_apps(State)->
+ "<TABLE HEIGHT=100% WIDTH=100% BORDER=0>
+ <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\">
+ <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/start_tools\" >
+ <TABLE BORDER=1 WIDTH=60%>
+ <TR BGCOLOR=\"#8899AA\">
+ <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Available Tools<FONT></TD>
+ </TR>
+ <TR>
+ <TD WIDTH=50%>
+ <TABLE BORDER=0>
+ "++ list_available_apps(State)++"
+ <TR><TD COLSPAN=2>&nbsp;</TD></TR>
+ <TR>
+ <TD COLSPAN=2 ALIGN=\"center\">
+ <INPUT TYPE=submit VALUE=\"Start\">
+ </TD>
+ </TR>
+ </TABLE>
+ </TD>
+ <TD>
+ To Start a Tool:
+ <UL>
+ <LI>Select the
+ checkbox for each tool to
+ start.</LI>
+ <LI>Click on the
+ button marked <EM>Start</EM>.</LI></UL>
+ </TD>
+ </TR>
+ </TABLE>
+ </FORM>
+ </TD></TR>
+ <TR><TD>&nbsp;</TD></TR>
+ </TABLE>".
+
+
+
+list_available_apps(State)->
+ MS = ets:fun2ms(fun({Tool,{web_data,{Name,_}}}) -> {Tool,Name} end),
+ Unstarted_apps=
+ lists:filter(
+ fun({Tool,_})->
+ false==lists:member(Tool,State#state.started)
+ end,
+ ets:select(State#state.app_data,MS)),
+ case Unstarted_apps of
+ []->
+ "<TR><TD>All tools are started</TD></TR>";
+ _->
+ list_apps(Unstarted_apps)
+ end.
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% these functions creates the page that shows the started apps %%
+%% the user can select to shutdown %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+show_started_apps(State)->
+ "<TABLE HEIGHT=100% WIDTH=100% BORDER=0>
+ <TR HEIGHT=80%><TD ALIGN=\"center\" VALIGN=\"middle\">
+ <FORM NAME=\"stop_apps\" ACTION=\"/webtool/webtool/stop_tools\" >
+ <TABLE BORDER=1 WIDTH=60%>
+ <TR BGCOLOR=\"#8899AA\">
+ <TD ALIGN=CENTER COLSPAN=2><FONT SIZE=4>Started Tools<FONT></TD>
+ </TR>
+ <TR>
+ <TD WIDTH=50%>
+ <TABLE BORDER=0>
+ "++ list_started_apps(State)++"
+ <TR><TD COLSPAN=2>&nbsp;</TD></TR>
+ <TR>
+ <TD COLSPAN=2 ALIGN=\"center\">
+ <INPUT TYPE=submit VALUE=\"Stop\">
+ </TD>
+ </TR>
+ </TABLE>
+ </TD>
+ <TD>
+ Stop a Tool:
+ <UL>
+ <LI>Select the
+ checkbox for each tool to
+ stop.</LI>
+ <LI>Click on the
+ button marked <EM>Stop</EM>.</LI></UL>
+ </TD>
+ </TR>
+ </TABLE>
+ </FORM>
+ </TD></TR>
+ <TR><TD>&nbsp;</TD></TR>
+ </TABLE>".
+
+list_started_apps(State)->
+ MS = lists:map(fun(A) -> {{A,{web_data,{'$1','_'}}},[],[{{A,'$1'}}]} end,
+ State#state.started),
+ Started_apps= ets:select(State#state.app_data,MS),
+ case Started_apps of
+ []->
+ "<TR><TD>No tool is started yet.</TD></TR>";
+ _->
+ list_apps(Started_apps)
+ end.
+
+
+list_apps(Apps) ->
+ lists:map(fun({Tool,Name})->
+ "<TR><TD>
+ <INPUT TYPE=\"checkbox\" NAME=\"app\" VALUE=\""
+ ++ atom_to_list(Tool) ++ "\">
+ " ++ Name ++ "
+ </TD></TR>"
+ end,
+ Apps).
+
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% %%
+%% Collecting the data from the *.tool files %%
+%% %%
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%----------------------------------------
+% get_tools(Dirs) => [{M,F,A},{M,F,A}...{M,F,A}]
+% Dirs - [string()] Directory names
+% Calls get_tools2/2 recursively for a number of directories
+% to retireve the configuration data for the web based tools.
+%----------------------------------------
+get_tools1(Dirs)->
+ get_tools1(Dirs,[]).
+
+get_tools1([Dir|Rest],Data) when is_list(Dir) ->
+ Tools=case filename:basename(Dir) of
+ %% Dir is an 'ebin' directory, check in '../priv' as well
+ "ebin" ->
+ [get_tools2(filename:join(filename:dirname(Dir),"priv")) |
+ get_tools2(Dir)];
+ _ ->
+ get_tools2(Dir)
+ end,
+ get_tools1(Rest,[Tools|Data]);
+
+get_tools1([],Data) ->
+ lists:flatten(Data).
+
+%----------------------------------------
+% get_tools2(Directory) => DataList
+% DataList : [WebTuple]|[]
+% WebTuple: {tool,[{web,M,F,A}]}
+%
+%----------------------------------------
+get_tools2(Dir)->
+ get_tools2(tool_files(Dir),[]).
+
+get_tools2([ToolFile|Rest],Data) ->
+ case get_tools3(ToolFile) of
+ {tool,WebData} ->
+ get_tools2(Rest,[{tool,WebData}|Data]);
+ {error,_Reason} ->
+ get_tools2(Rest,Data);
+ nodata ->
+ get_tools2(Rest,Data)
+ end;
+
+get_tools2([],Data) ->
+ Data.
+
+%----------------------------------------
+% get_tools3(ToolFile) => {ok,Tool}|{error,Reason}|nodata
+% Tool: {tool,[KeyValTuple]}
+% ToolFile - string() A .tool file
+% Now we have the file get the data and sort it out
+%----------------------------------------
+get_tools3(ToolFile) ->
+ case file:consult(ToolFile) of
+ {error,open} ->
+ {error,nofile};
+ {error,read} ->
+ {error,format};
+ {ok,[{version,"1.2"},ToolInfo]} when is_list(ToolInfo)->
+ webdata(ToolInfo);
+ {ok,[{version,_Vsn},_Info]} ->
+ {error,old_version};
+ {ok,_Other} ->
+ {error,format}
+ end.
+
+
+%----------------------------------------------------------------------
+% webdata(TupleList)-> ToolTuple| nodata
+% ToolTuple: {tool,[{config_func,{M,F,A}}]}
+%
+% There are a little unneccesary work in this format but it is extendable
+%----------------------------------------------------------------------
+webdata(TupleList)->
+ case proplists:get_value(config_func,TupleList,nodata) of
+ {M,F,A} ->
+ {tool,[{config_func,{M,F,A}}]};
+ _ ->
+ nodata
+ end.
+
+
+%=============================================================================
+% Functions for getting *.tool configuration files
+%=============================================================================
+
+%----------------------------------------
+% tool_files(Dir) => ToolFiles
+% Dir - string() Directory name
+% ToolFiles - [string()]
+% Return the list of all files in Dir ending with .tool (appended to Dir)
+%----------------------------------------
+tool_files(Dir) ->
+ case file:list_dir(Dir) of
+ {ok,Files} ->
+ filter_tool_files(Dir,Files);
+ {error,_Reason} ->
+ []
+ end.
+
+%----------------------------------------
+% filter_tool_files(Dir,Files) => ToolFiles
+% Dir - string() Directory name
+% Files, ToolFiles - [string()] File names
+% Filters out the files in Files ending with .tool and append them to Dir
+%----------------------------------------
+filter_tool_files(_Dir,[]) ->
+ [];
+filter_tool_files(Dir,[File|Rest]) ->
+ case filename:extension(File) of
+ ".tool" ->
+ [filename:join(Dir,File)|filter_tool_files(Dir,Rest)];
+ _ ->
+ filter_tool_files(Dir,Rest)
+ end.
+
+
+%%%-----------------------------------------------------------------
+%%% format functions
+ffunc({M,F,A}) when is_list(A) ->
+ io_lib:format("~w:~w(~s)\n",[M,F,format_args(A)]);
+ffunc({M,F,A}) when is_integer(A) ->
+ io_lib:format("~w:~w/~w\n",[M,F,A]).
+
+format_args([]) ->
+ "";
+format_args(Args) ->
+ Str = lists:append(["~p"|lists:duplicate(length(Args)-1,",~p")]),
+ io_lib:format(Str,Args).
diff --git a/lib/common_test/src/ct_webtool_sup.erl b/lib/common_test/src/ct_webtool_sup.erl
new file mode 100644
index 0000000000..1d612a2d18
--- /dev/null
+++ b/lib/common_test/src/ct_webtool_sup.erl
@@ -0,0 +1,74 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2001-2009. 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(ct_webtool_sup).
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start_link/0,stop/1]).
+
+%% supervisor callbacks
+-export([init/1]).
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+start_link() ->
+ supervisor:start_link({local,ct_websup},ct_webtool_sup, []).
+
+stop(Pid)->
+ exit(Pid,normal).
+%%%----------------------------------------------------------------------
+%%% Callback functions from supervisor
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok, {SupFlags, [ChildSpec]}} |
+%% ignore |
+%% {error, Reason}
+%%----------------------------------------------------------------------
+init(_StartArgs) ->
+ %%Child1 =
+ %%Child2 ={webcover_backend,{webcover_backend,start_link,[]},permanent,2000,worker,[webcover_backend]},
+ %%{ok,{{simple_one_for_one,5,10},[Child1]}}.
+ {ok,{{one_for_one,100,10},[]}}.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl
index b340c6fdd1..ab13e7d0ee 100644
--- a/lib/common_test/src/vts.erl
+++ b/lib/common_test/src/vts.erl
@@ -63,21 +63,21 @@
%%%-----------------------------------------------------------------
%%% User API
start() ->
- webtool:start(),
- webtool:start_tools([],"app=vts").
+ ct_webtool:start(),
+ ct_webtool:start_tools([],"app=vts").
init_data(ConfigFiles,EvHandlers,LogDir,LogOpts,Tests) ->
call({init_data,ConfigFiles,EvHandlers,LogDir,LogOpts,Tests}).
stop() ->
- webtool:stop_tools([],"app=vts"),
- webtool:stop().
+ ct_webtool:stop_tools([],"app=vts"),
+ ct_webtool:stop().
report(What,Data) ->
call({report,What,Data}).
%%%-----------------------------------------------------------------
-%%% Return config data used by webtool
+%%% Return config data used by ct_webtool
config_data() ->
{ok,LogDir} =
case lists:keysearch(logdir,1,init:get_arguments()) of
diff --git a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
index a145d85b1d..d01211b0c6 100644
--- a/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
+++ b/lib/common_test/test/ct_netconfc_SUITE_data/netconfc1_SUITE.erl
@@ -164,7 +164,7 @@ hello_from_server_first(Config) ->
{ok,Client} = ct_netconfc:only_open(?DEFAULT_SSH_OPTS(DataDir)),
ct:sleep(500),
?NS:expect(hello),
- ?ok = ct_netconfc:hello(Client),
+ ?ok = ct_netconfc:hello(Client, [{capability, ["urn:com:ericsson:ebase:1.1.0"]}], infinity),
?NS:expect_do_reply('close-session',close,ok),
?ok = ct_netconfc:close_session(Client),
ok.
@@ -490,13 +490,16 @@ action(Config) ->
Data = [{myactionreturn,[{xmlns,"myns"}],["value"]}],
%% test either to receive {data,Data} or {ok,Data},
%% both need to be handled
- {Reply,RetVal} = case element(3, now()) rem 2 of
- 0 -> {{data,Data},{ok,Data}};
- 1 -> {{ok,Data},ok}
- end,
- ct:log("Client will receive {~w,Data}", [element(1,Reply)]),
- ?NS:expect_reply(action,Reply),
- RetVal = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}),
+ ct:log("Client will receive {~w,~p}", [data,Data]),
+ ct:log("Expecting ~p", [{ok, Data}]),
+ ?NS:expect_reply(action,{data, Data}),
+ {ok, Data} = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}),
+
+ ct:log("Client will receive {~w,~p}", [ok,Data]),
+ ct:log("Expecting ~p", [ok]),
+ ?NS:expect_reply(action,{ok, Data}),
+ ok = ct_netconfc:action(Client,{myaction,[{xmlns,"myns"}],[]}),
+
?NS:expect_do_reply('close-session',close,ok),
?ok = ct_netconfc:close_session(Client),
ok.
diff --git a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
index 1d3f5918d2..9dc9095f47 100644
--- a/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
+++ b/lib/common_test/test/ct_telnet_SUITE_data/ct_telnet_own_server_SUITE.erl
@@ -40,6 +40,7 @@ all() ->
expect,
expect_repeat,
expect_sequence,
+ expect_wait_until_prompt,
expect_error_prompt,
expect_error_timeout1,
expect_error_timeout2,
@@ -81,6 +82,8 @@ end_per_group(_GroupName, Config) ->
expect(_) ->
{ok, Handle} = ct_telnet:open(telnet_server_conn1),
ok = ct_telnet:send(Handle, "echo ayt"),
+ {ok,["ayt"]} = ct_telnet:expect(Handle, "ayt"),
+ ok = ct_telnet:send(Handle, "echo ayt"),
{ok,["ayt"]} = ct_telnet:expect(Handle, ["ayt"]),
ok = ct_telnet:close(Handle),
ok.
@@ -103,6 +106,21 @@ expect_sequence(_) ->
ok = ct_telnet:close(Handle),
ok.
+%% Check that expect can wait for delayed prompt
+expect_wait_until_prompt(_) ->
+ {ok, Handle} = ct_telnet:open(telnet_server_conn1),
+ Timeouts = [{idle_timeout,5000},{total_timeout,7000}],
+
+ ok = ct_telnet:send(Handle, "echo_delayed_prompt 3000 xxx"),
+ {ok,["xxx"]} =
+ ct_telnet:expect(Handle, "xxx",
+ [wait_for_prompt|Timeouts]),
+ ok = ct_telnet:send(Handle, "echo_delayed_prompt 3000 yyy zzz"),
+ {ok,[["yyy"],["zzz"]]} =
+ ct_telnet:expect(Handle, ["yyy","zzz"],
+ [{wait_for_prompt,"> "}|Timeouts]),
+ ok.
+
%% Check that expect returns when a prompt is found, even if pattern
%% is not matched.
expect_error_prompt(_) ->
diff --git a/lib/common_test/test/telnet_server.erl b/lib/common_test/test/telnet_server.erl
index 11959c3e12..2db5a9bc44 100644
--- a/lib/common_test/test/telnet_server.erl
+++ b/lib/common_test/test/telnet_server.erl
@@ -242,6 +242,12 @@ do_handle_data("echo_loop " ++ Data,State) ->
ReturnData = string:join(Lines,"\n"),
send_loop(list_to_integer(TStr),ReturnData,State),
{ok,State};
+do_handle_data("echo_delayed_prompt "++Data,State) ->
+ [MsStr|EchoData] = string:tokens(Data, " "),
+ send(string:join(EchoData,"\n"),State),
+ ct:sleep(list_to_integer(MsStr)),
+ send("\r\n> ",State),
+ {ok,State};
do_handle_data("disconnect_after " ++WaitStr,State) ->
Wait = list_to_integer(string:strip(WaitStr,right,$\n)),
dbg("Server will close connection in ~w ms...", [Wait]),
diff --git a/lib/common_test/vsn.mk b/lib/common_test/vsn.mk
index d654a8afb3..e2d921729c 100644
--- a/lib/common_test/vsn.mk
+++ b/lib/common_test/vsn.mk
@@ -1 +1 @@
-COMMON_TEST_VSN = 1.10
+COMMON_TEST_VSN = 1.10.1
diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml
index 20c8a6b1b1..e40660ab39 100644
--- a/lib/inets/doc/src/httpd.xml
+++ b/lib/inets/doc/src/httpd.xml
@@ -315,7 +315,7 @@ text/plain asc txt
</item>
<marker id="prop_server_tokens"></marker>
- <tag>{server_tokens, prod|major|minor|minimal|os|full|{private, string()}}</tag>
+ <tag>{server_tokens, none|prod|major|minor|minimal|os|full|{private, string()}}</tag>
<item>
<p>ServerTokens defines how the value of the server header
should look. </p>
@@ -323,6 +323,7 @@ text/plain asc txt
here is what the server header string could look like for
the different values of server-tokens: </p>
<pre>
+none "" % A Server: header will not be generated
prod "inets"
major "inets/5"
minor "inets/5.8"
diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index 2c3ee79f31..12bbc2b736 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -32,7 +32,28 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 5.10.6</title>
+ <section><title>Inets 5.10.7</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ New value in <c>server_tokens</c> config for limiting
+ banner grabbing attempts. </p>
+ <p>
+ By setting <c>{server_tokens, none}</c> in
+ <c>ServiceConfig</c> for <c>inets:start(httpd,
+ ServiceConfig)</c>, the "Server:" header will not be set
+ in messages from the server.</p>
+ <p>
+ Own Id: OTP-12661 Aux Id: seq12840 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 5.10.6</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl
index 78dda794db..dbdc1be272 100644
--- a/lib/inets/src/http_server/httpd_conf.erl
+++ b/lib/inets/src/http_server/httpd_conf.erl
@@ -219,14 +219,14 @@ load("ServerName " ++ ServerName, []) ->
load("ServerTokens " ++ ServerTokens, []) ->
%% These are the valid *plain* server tokens:
- %% sprod, major, minor, minimum, os, full
+ %% none, prod, major, minor, minimum, os, full
%% It can also be a "private" server token: private:<any string>
case string:tokens(ServerTokens, [$:]) of
["private", Private] ->
{ok,[], {server_tokens, clean(Private)}};
[TokStr] ->
Tok = list_to_atom(clean(TokStr)),
- case lists:member(Tok, [prod, major, minor, minimum, os, full]) of
+ case lists:member(Tok, [none, prod, major, minor, minimum, os, full]) of
true ->
{ok,[], {server_tokens, Tok}};
false ->
@@ -850,6 +850,8 @@ server(full = _ServerTokens) ->
OS = os_info(full),
lists:flatten(
io_lib:format("~s ~s OTP/~s", [?SERVER_SOFTWARE, OS, OTPRelease]));
+server(none = _ServerTokens) ->
+ "";
server({private, Server} = _ServerTokens) when is_list(Server) ->
%% The user provide its own
Server;
@@ -1299,7 +1301,7 @@ ssl_ca_certificate_file(ConfigDB) ->
end.
plain_server_tokens() ->
- [prod, major, minor, minimum, os, full].
+ [none, prod, major, minor, minimum, os, full].
error_report(Where,M,F,Error) ->
error_logger:error_report([{?MODULE, Where},
diff --git a/lib/inets/src/http_server/httpd_response.erl b/lib/inets/src/http_server/httpd_response.erl
index 0895729d05..2fa91d47a0 100644
--- a/lib/inets/src/http_server/httpd_response.erl
+++ b/lib/inets/src/http_server/httpd_response.erl
@@ -287,8 +287,11 @@ create_header(ConfigDb, KeyValueTupleHeaders) ->
ContentType = "text/html",
Server = server(ConfigDb),
NewHeaders = add_default_headers([{"date", Date},
- {"content-type", ContentType},
- {"server", Server}],
+ {"content-type", ContentType}
+ | if Server=="" -> [];
+ true -> [{"server", Server}]
+ end
+ ],
KeyValueTupleHeaders),
lists:map(fun fix_header/1, NewHeaders).
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index e5b63a6446..e9ecb2632a 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -18,6 +18,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 5.10.6
+INETS_VSN = 5.10.7
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
diff --git a/lib/snmp/src/agent/snmpa_net_if.erl b/lib/snmp/src/agent/snmpa_net_if.erl
index 840d56d563..57d63bab5b 100644
--- a/lib/snmp/src/agent/snmpa_net_if.erl
+++ b/lib/snmp/src/agent/snmpa_net_if.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2015. 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
@@ -297,14 +297,14 @@ socket_open(snmpUDPDomain = Domain, [IpPort | Opts]) ->
Fd = list_to_integer(FdStr),
?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p",
[Domain, IpPort, Opts, Fd]),
- gen_udp_open(IpPort, [{fd, Fd} | Opts]);
+ gen_udp_open(0, [{fd, Fd} | Opts]);
error ->
case init:get_argument(snmpa_fd) of
{ok, [[FdStr]]} ->
Fd = list_to_integer(FdStr),
?vdebug("socket_open(~p, [~p | ~p]) Fd: ~p",
[Domain, IpPort, Opts, Fd]),
- gen_udp_open(IpPort, [{fd, Fd} | Opts]);
+ gen_udp_open(0, [{fd, Fd} | Opts]);
error ->
?vdebug("socket_open(~p, [~p | ~p])",
[Domain, IpPort, Opts]),
diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src
index e7e54f5b7e..081163b368 100644
--- a/lib/snmp/src/app/snmp.appup.src
+++ b/lib/snmp/src/app/snmp.appup.src
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2015. 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
@@ -28,6 +28,7 @@
%% {update, snmpa_local_db, soft, soft_purge, soft_purge, []}
%% {add_module, snmpm_net_if_mt}
[
+ {"5.1.1", [{restart_application, snmp}]},
{"5.1", [ % Only compiler changes
]},
{"5.0", [{restart_application, snmp}]},
@@ -46,6 +47,7 @@
%% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}}
[
+ {"5.1.1", [{restart_application, snmp}]},
{"5.1", [ % Only compiler changes
]},
{"5.0", [{restart_application, snmp}]},
diff --git a/lib/snmp/src/manager/snmpm_net_if.erl b/lib/snmp/src/manager/snmpm_net_if.erl
index b4cc165d2e..0e1c51c609 100644
--- a/lib/snmp/src/manager/snmpm_net_if.erl
+++ b/lib/snmp/src/manager/snmpm_net_if.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2015. 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
@@ -330,7 +330,7 @@ socket_params(Domain, {IpAddr, IpPort} = Addr, BindTo, CommonSocketOpts) ->
end,
case Family of
inet ->
- case init:get_argument(snmp_fd) of
+ case init:get_argument(snmpm_fd) of
{ok, [[FdStr]]} ->
Fd = list_to_integer(FdStr),
case BindTo of
diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl
index a75122d0bb..8fc3359159 100644
--- a/lib/snmp/src/manager/snmpm_server.erl
+++ b/lib/snmp/src/manager/snmpm_server.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2015. 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
@@ -2116,7 +2116,8 @@ do_handle_agent(DefUserId, DefMod,
ok;
InvalidResult ->
- CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData],
+ CallbackArgs =
+ [Domain_or_Ip, Addr_or_Port, Type, SnmpInfo, DefData],
handle_invalid_result(handle_agent, CallbackArgs, InvalidResult)
catch
@@ -2212,7 +2213,8 @@ do_handle_agent(DefUserId, DefMod,
end;
T:E ->
- CallbackArgs = [Domain, Addr, Type, SnmpInfo, DefData],
+ CallbackArgs =
+ [Domain_or_Ip, Addr_or_Port, Type, SnmpInfo, DefData],
handle_invalid_result(handle_agent, CallbackArgs, T, E)
end.
diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk
index 345cc790f2..67adf0a34f 100644
--- a/lib/snmp/vsn.mk
+++ b/lib/snmp/vsn.mk
@@ -2,7 +2,7 @@
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1997-2014. All Rights Reserved.
+# Copyright Ericsson AB 1997-2015. 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
@@ -18,6 +18,6 @@
# %CopyrightEnd%
APPLICATION = snmp
-SNMP_VSN = 5.1.1
+SNMP_VSN = 5.1.2
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)"
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index f22bca36f4..41885c684c 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -29,6 +29,49 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 3.2.2</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ New option <c>id_string</c> for <c>ssh:daemon</c> and
+ <c>ssh:connect</c> for limiting banner grabbing attempts.</p>
+ <p>
+ The possible values are: <c>{id_string,string()}</c> and
+ <c>{id_string,random}</c>. The latter will make ssh
+ generate a random nonsence id-string for each new
+ connection.</p>
+ <p>
+ Own Id: OTP-12659</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Ssh 3.2.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Ssh crashed if a message was sent on a channel with
+ packet_size = 0.</p>
+ <p>
+ A new option for ssh:daemon is also introduced:
+ <c>minimal_remote_max_packet_size</c>. This option sets
+ the least max packet size declaration that the daemon
+ will accept from a client. The default value is 0 to
+ maintain compatibility with OpenSSH and the rfc:s.</p>
+ <p>
+ Own Id: OTP-12645 Aux Id: seq12816 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Ssh 3.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index d481a75c9a..72dafc0c09 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -180,6 +180,15 @@
<item>
<p>If true, the client will not print out anything on authorization.</p>
</item>
+
+ <tag><c><![CDATA[{id_string, random | string()}]]></c></tag>
+ <item>
+ <p>The string that the client presents to a connected server initially. The default value is "Erlang/VSN" where VSN is the ssh application version number.
+ </p>
+ <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version.
+ </p>
+ </item>
+
<tag><c><![CDATA[{fd, file_descriptor()}]]></c></tag>
<item>
<p>Allow an existing file descriptor to be used
@@ -338,6 +347,20 @@
</warning>
</item>
+ <tag><c><![CDATA[{minimal_remote_max_packet_size, non_negative_integer()}]]></c></tag>
+ <item>
+ <p>The least maximum packet size that the daemon will accept in channel open requests from the client. The default value is 0.
+ </p>
+ </item>
+
+ <tag><c><![CDATA[{id_string, random | string()}]]></c></tag>
+ <item>
+ <p>The string the daemon will present to a connecting peer initially. The default value is "Erlang/VSN" where VSN is the ssh application version number.
+ </p>
+ <p>The value <c>random</c> will cause a random string to be created at each connection attempt. This is to make it a bit more difficult for a malicious peer to find the ssh software brand and version.
+ </p>
+ </item>
+
<tag><c><![CDATA[{key_cb, atom()}]]></c></tag>
<item>
<p>Module implementing the behaviour <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>.
diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src
index b2b2994eed..e76c110c04 100644
--- a/lib/ssh/src/ssh.appup.src
+++ b/lib/ssh/src/ssh.appup.src
@@ -1,7 +1,7 @@
%% -*- erlang -*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2015. 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
@@ -19,61 +19,9 @@
{"%VSN%",
[
- {"3.0.8", [{load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_xfer]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, []}
- ]},
- {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
- {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
{<<".*">>, [{restart_application, ssh}]}
],
[
- {"3.0.8", [{load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, []},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, []},
- {load_module, ssh_xfer, soft_purge, soft_purge, []}
- ]},
- {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
- {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
{<<".*">>, [{restart_application, ssh}]}
]
}.
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index eae33e3683..d4b02a024e 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -345,9 +345,16 @@ handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([parallel_login|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option({parallel_login,true}) | SshOptions]);
+handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
+handle_option([{id_string, _ID} = Opt|Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([Opt | Rest], SocketOptions, SshOptions) ->
handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions).
+
+handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 ->
+ Opt;
handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) ->
Opt;
handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) ->
@@ -434,6 +441,10 @@ handle_ssh_option({idle_time, Value} = Opt) when is_integer(Value), Value > 0 ->
Opt;
handle_ssh_option({rekey_limit, Value} = Opt) when is_integer(Value) ->
Opt;
+handle_ssh_option({id_string, random}) ->
+ {id_string, {random,2,5}}; %% 2 - 5 random characters
+handle_ssh_option({id_string, ID} = Opt) when is_list(ID) ->
+ Opt;
handle_ssh_option(Opt) ->
throw({error, {eoptions, Opt}}).
diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl
index 6c443eeb9c..34988f17b6 100644
--- a/lib/ssh/src/ssh_acceptor.erl
+++ b/lib/ssh/src/ssh_acceptor.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2015. 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
@@ -43,7 +43,7 @@ start_link(Port, Address, SockOpts, Opts, AcceptTimeout) ->
acceptor_init(Parent, Port, Address, SockOpts, Opts, AcceptTimeout) ->
{_, Callback, _} =
proplists:get_value(transport, Opts, {tcp, gen_tcp, tcp_closed}),
- case (catch do_socket_listen(Callback, Port, SockOpts)) of
+ case (catch do_socket_listen(Callback, Port, [{active, false} | SockOpts])) of
{ok, ListenSocket} ->
proc_lib:init_ack(Parent, {ok, self()}),
acceptor_loop(Callback,
diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl
index c66f810948..654b9d4bde 100644
--- a/lib/ssh/src/ssh_connection.erl
+++ b/lib/ssh/src/ssh_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2015. 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
@@ -326,9 +326,7 @@ channel_data(ChannelId, DataType, Data,
SendDataType,
SendData)}
end, SendList),
- FlowCtrlMsgs = flow_control(Replies,
- Channel,
- Cache),
+ FlowCtrlMsgs = flow_control(Replies, Channel, Cache),
{{replies, Replies ++ FlowCtrlMsgs}, Connection};
_ ->
gen_fsm:reply(From, {error, closed}),
@@ -470,18 +468,31 @@ handle_msg(#ssh_msg_channel_window_adjust{recipient_channel = ChannelId,
handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type,
sender_channel = RemoteId,
initial_window_size = WindowSz,
- maximum_packet_size = PacketSz}, Connection0, server) ->
-
- try setup_session(Connection0, RemoteId,
- Type, WindowSz, PacketSz) of
- Result ->
- Result
- catch _:_ ->
+ maximum_packet_size = PacketSz},
+ #connection{options = SSHopts} = Connection0,
+ server) ->
+ MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0),
+
+ if
+ MinAcceptedPackSz =< PacketSz ->
+ try setup_session(Connection0, RemoteId,
+ Type, WindowSz, PacketSz) of
+ Result ->
+ Result
+ catch _:_ ->
+ FailMsg = channel_open_failure_msg(RemoteId,
+ ?SSH_OPEN_CONNECT_FAILED,
+ "Connection refused", "en"),
+ {{replies, [{connection_reply, FailMsg}]},
+ Connection0}
+ end;
+
+ MinAcceptedPackSz > PacketSz ->
FailMsg = channel_open_failure_msg(RemoteId,
- ?SSH_OPEN_CONNECT_FAILED,
- "Connection refused", "en"),
- {{replies, [{connection_reply, FailMsg}]},
- Connection0}
+ ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED,
+ lists:concat(["Maximum packet size below ",MinAcceptedPackSz,
+ " not supported"]), "en"),
+ {{replies, [{connection_reply, FailMsg}]}, Connection0}
end;
handle_msg(#ssh_msg_channel_open{channel_type = "session",
@@ -501,41 +512,57 @@ handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip" = Type,
initial_window_size = RWindowSz,
maximum_packet_size = RPacketSz,
data = Data},
- #connection{channel_cache = Cache} = Connection0, server) ->
+ #connection{channel_cache = Cache,
+ options = SSHopts} = Connection0, server) ->
<<?UINT32(ALen), Address:ALen/binary, ?UINT32(Port),
?UINT32(OLen), Orig:OLen/binary, ?UINT32(OrigPort)>> = Data,
- case bound_channel(Address, Port, Connection0) of
- undefined ->
+ MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0),
+
+ if
+ MinAcceptedPackSz =< RPacketSz ->
+ case bound_channel(Address, Port, Connection0) of
+ undefined ->
+ FailMsg = channel_open_failure_msg(RemoteId,
+ ?SSH_OPEN_CONNECT_FAILED,
+ "Connection refused", "en"),
+ {{replies,
+ [{connection_reply, FailMsg}]}, Connection0};
+ ChannelPid ->
+ {ChannelId, Connection1} = new_channel_id(Connection0),
+ LWindowSz = ?DEFAULT_WINDOW_SIZE,
+ LPacketSz = ?DEFAULT_PACKET_SIZE,
+ Channel = #channel{type = Type,
+ sys = "none",
+ user = ChannelPid,
+ local_id = ChannelId,
+ recv_window_size = LWindowSz,
+ recv_packet_size = LPacketSz,
+ send_window_size = RWindowSz,
+ send_packet_size = RPacketSz,
+ send_buf = queue:new()
+ },
+ ssh_channel:cache_update(Cache, Channel),
+ OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId,
+ LWindowSz, LPacketSz),
+ {OpenMsg, Connection} =
+ reply_msg(Channel, Connection1,
+ {open, Channel, {forwarded_tcpip,
+ decode_ip(Address), Port,
+ decode_ip(Orig), OrigPort}}),
+ {{replies, [{connection_reply, OpenConfMsg},
+ OpenMsg]}, Connection}
+ end;
+
+ MinAcceptedPackSz > RPacketSz ->
FailMsg = channel_open_failure_msg(RemoteId,
- ?SSH_OPEN_CONNECT_FAILED,
- "Connection refused", "en"),
- {{replies,
- [{connection_reply, FailMsg}]}, Connection0};
- ChannelPid ->
- {ChannelId, Connection1} = new_channel_id(Connection0),
- LWindowSz = ?DEFAULT_WINDOW_SIZE,
- LPacketSz = ?DEFAULT_PACKET_SIZE,
- Channel = #channel{type = Type,
- sys = "none",
- user = ChannelPid,
- local_id = ChannelId,
- recv_window_size = LWindowSz,
- recv_packet_size = LPacketSz,
- send_window_size = RWindowSz,
- send_packet_size = RPacketSz},
- ssh_channel:cache_update(Cache, Channel),
- OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId,
- LWindowSz, LPacketSz),
- {OpenMsg, Connection} =
- reply_msg(Channel, Connection1,
- {open, Channel, {forwarded_tcpip,
- decode_ip(Address), Port,
- decode_ip(Orig), OrigPort}}),
- {{replies, [{connection_reply, OpenConfMsg},
- OpenMsg]}, Connection}
+ ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED,
+ lists:concat(["Maximum packet size below ",MinAcceptedPackSz,
+ " not supported"]), "en"),
+ {{replies, [{connection_reply, FailMsg}]}, Connection0}
end;
+
handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip",
sender_channel = RemoteId},
Connection, client) ->
@@ -917,7 +944,8 @@ start_channel(Cb, Id, Args, SubSysSup, Exec) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-setup_session(#connection{channel_cache = Cache} = Connection0,
+setup_session(#connection{channel_cache = Cache
+ } = Connection0,
RemoteId,
Type, WindowSize, PacketSize) ->
{ChannelId, Connection} = new_channel_id(Connection0),
@@ -929,6 +957,7 @@ setup_session(#connection{channel_cache = Cache} = Connection0,
recv_packet_size = ?DEFAULT_PACKET_SIZE,
send_window_size = WindowSize,
send_packet_size = PacketSize,
+ send_buf = queue:new(),
remote_id = RemoteId
},
ssh_channel:cache_update(Cache, Channel),
@@ -1024,63 +1053,74 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid},
update_send_window(Channel, _, undefined,
#connection{channel_cache = Cache}) ->
- do_update_send_window(Channel, Channel#channel.send_buf, Cache);
+ do_update_send_window(Channel, Cache);
-update_send_window(Channel, DataType, Data,
+update_send_window(#channel{send_buf = SendBuffer} = Channel, DataType, Data,
#connection{channel_cache = Cache}) ->
- do_update_send_window(Channel, Channel#channel.send_buf ++ [{DataType, Data}], Cache).
-
-do_update_send_window(Channel0, Buf0, Cache) ->
- {Buf1, NewSz, Buf2} = get_window(Buf0,
- Channel0#channel.send_packet_size,
- Channel0#channel.send_window_size),
+ do_update_send_window(Channel#channel{send_buf = queue:in({DataType, Data}, SendBuffer)},
+ Cache).
- Channel = Channel0#channel{send_window_size = NewSz, send_buf = Buf2},
+do_update_send_window(Channel0, Cache) ->
+ {SendMsgs, Channel} = get_window(Channel0, []),
ssh_channel:cache_update(Cache, Channel),
- {Buf1, Channel}.
-
-get_window(Bs, PSz, WSz) ->
- get_window(Bs, PSz, WSz, []).
-
-get_window(Bs, _PSz, 0, Acc) ->
- {lists:reverse(Acc), 0, Bs};
-get_window([B0 = {DataType, Bin} | Bs], PSz, WSz, Acc) ->
- BSz = size(Bin),
- if BSz =< WSz -> %% will fit into window
- if BSz =< PSz -> %% will fit into a packet
- get_window(Bs, PSz, WSz-BSz, [B0|Acc]);
- true -> %% split into packet size
- <<Bin1:PSz/binary, Bin2/binary>> = Bin,
- get_window([setelement(2, B0, Bin2) | Bs],
- PSz, WSz-PSz,
- [{DataType, Bin1}|Acc])
+ {SendMsgs, Channel}.
+
+get_window(#channel{send_window_size = 0
+ } = Channel, Acc) ->
+ {lists:reverse(Acc), Channel};
+get_window(#channel{send_packet_size = 0
+ } = Channel, Acc) ->
+ {lists:reverse(Acc), Channel};
+get_window(#channel{send_buf = Buffer,
+ send_packet_size = PacketSize,
+ send_window_size = WindowSize0
+ } = Channel, Acc0) ->
+ case queue:out(Buffer) of
+ {{value, {_, Data} = Msg}, NewBuffer} ->
+ case handle_send_window(Msg, size(Data), PacketSize, WindowSize0, Acc0) of
+ {WindowSize, Acc, {_, <<>>}} ->
+ {lists:reverse(Acc), Channel#channel{send_window_size = WindowSize,
+ send_buf = NewBuffer}};
+ {WindowSize, Acc, Rest} ->
+ get_window(Channel#channel{send_window_size = WindowSize,
+ send_buf = queue:in_r(Rest, NewBuffer)}, Acc)
end;
- WSz =< PSz -> %% use rest of window
- <<Bin1:WSz/binary, Bin2/binary>> = Bin,
- get_window([setelement(2, B0, Bin2) | Bs],
- PSz, WSz-WSz,
- [{DataType, Bin1}|Acc]);
- true -> %% use packet size
- <<Bin1:PSz/binary, Bin2/binary>> = Bin,
- get_window([setelement(2, B0, Bin2) | Bs],
- PSz, WSz-PSz,
- [{DataType, Bin1}|Acc])
+ {empty, NewBuffer} ->
+ {[], Channel#channel{send_buf = NewBuffer}}
+ end.
+
+handle_send_window(Msg = {Type, Data}, Size, PacketSize, WindowSize, Acc) when Size =< WindowSize ->
+ case Size =< PacketSize of
+ true ->
+ {WindowSize - Size, [Msg | Acc], {Type, <<>>}};
+ false ->
+ <<Msg1:PacketSize/binary, Msg2/binary>> = Data,
+ {WindowSize - PacketSize, [{Type, Msg1} | Acc], {Type, Msg2}}
end;
-get_window([], _PSz, WSz, Acc) ->
- {lists:reverse(Acc), WSz, []}.
+handle_send_window({Type, Data}, _, PacketSize, WindowSize, Acc) when WindowSize =< PacketSize ->
+ <<Msg1:WindowSize/binary, Msg2/binary>> = Data,
+ {WindowSize - WindowSize, [{Type, Msg1} | Acc], {Type, Msg2}};
+handle_send_window({Type, Data}, _, PacketSize, WindowSize, Acc) ->
+ <<Msg1:PacketSize/binary, Msg2/binary>> = Data,
+ {WindowSize - PacketSize, [{Type, Msg1} | Acc], {Type, Msg2}}.
flow_control(Channel, Cache) ->
flow_control([window_adjusted], Channel, Cache).
-
+
flow_control([], Channel, Cache) ->
ssh_channel:cache_update(Cache, Channel),
[];
-
flow_control([_|_], #channel{flow_control = From,
- send_buf = []} = Channel, Cache) when From =/= undefined ->
- [{flow_control, Cache, Channel, From, ok}];
+ send_buf = Buffer} = Channel, Cache) when From =/= undefined ->
+ case queue:is_empty(Buffer) of
+ true ->
+ ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}),
+ [{flow_control, Cache, Channel, From, ok}];
+ false ->
+ []
+ end;
flow_control(_,_,_) ->
- [].
+ [].
pty_req(ConnectionHandler, Channel, Term, Width, Height,
PixWidth, PixHeight, PtyOpts, TimeOut) ->
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 68523aa72b..e1f2e059e8 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2015. 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
@@ -751,7 +751,9 @@ handle_sync_event({open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Dat
user = ChannelPid,
local_id = ChannelId,
recv_window_size = InitialWindowSize,
- recv_packet_size = MaxPacketSize},
+ recv_packet_size = MaxPacketSize,
+ send_buf = queue:new()
+ },
ssh_channel:cache_update(Cache, Channel),
State = add_request(true, ChannelId, From, State2),
start_timeout(ChannelId, From, Timeout),
@@ -1241,10 +1243,9 @@ event(Event, StateName, State) ->
handle_disconnect(DisconnectMsg, State);
throw:{ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} ->
handle_disconnect(DisconnectMsg, State, ErrorToDisplay);
- _:Error ->
- log_error(Error),
+ _:_ ->
handle_disconnect(#ssh_msg_disconnect{code = error_code(StateName),
- description = "Internal error",
+ description = "Invalid state",
language = "en"}, State)
end.
error_code(key_exchange) ->
diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl
index 9a91875894..30df32c4fd 100644
--- a/lib/ssh/src/ssh_info.erl
+++ b/lib/ssh/src/ssh_info.erl
@@ -27,18 +27,21 @@
-compile(export_all).
print() ->
+ print(user).
+
+print(D) ->
try supervisor:which_children(ssh_sup)
of
_ ->
- io:nl(),
- print_general(),
- io:nl(),
- underline("Client part", $=),
- print_clients(),
- io:nl(),
- underline("Server part", $=),
- print_servers(),
- io:nl(),
+ io:nl(D),
+ print_general(D),
+ io:nl(D),
+ underline(D, "Client part", $=),
+ print_clients(D),
+ io:nl(D),
+ underline(D, "Server part", $=),
+ print_servers(D),
+ io:nl(D),
%% case os:type() of
%% {unix,_} ->
%% io:nl(),
@@ -50,90 +53,95 @@ print() ->
%% catch io:format(os:cmd("netstat -tpn"));
%% _ -> ok
%% end,
- underline("Supervisors", $=),
- walk_sups(ssh_sup),
- io:nl()
+ underline(D, "Supervisors", $=),
+ walk_sups(D, ssh_sup),
+ io:nl(D)
catch
_:_ ->
- io:format("Ssh not found~n",[])
+ io:format(D,"Ssh not found~n",[])
end.
%%%================================================================
-print_general() ->
+print_general(D) ->
{_Name, Slogan, Ver} = lists:keyfind(ssh,1,application:which_applications()),
- underline(io_lib:format("~s ~s", [Slogan, Ver]), $=),
- io:format('This printout is generated ~s. ~n',[datetime()]).
+ underline(D, io_lib:format("~s ~s", [Slogan, Ver]), $=),
+ io:format(D, 'This printout is generated ~s. ~n',[datetime()]).
%%%================================================================
-print_clients() ->
+print_clients(D) ->
+ PrintClient = fun(X) -> print_client(D,X) end,
try
- lists:foreach(fun print_client/1, supervisor:which_children(sshc_sup))
+ lists:foreach(PrintClient, supervisor:which_children(sshc_sup))
catch
C:E ->
- io:format('***FAILED: ~p:~p~n',[C,E])
+ io:format(D, '***FAILED: ~p:~p~n',[C,E])
end.
-print_client({undefined,Pid,supervisor,[ssh_connection_handler]}) ->
+print_client(D, {undefined,Pid,supervisor,[ssh_connection_handler]}) ->
{{Local,Remote},_Str} = ssh_connection_handler:get_print_info(Pid),
- io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
-print_client(Other) ->
- io:format(" [[Other 1: ~p]]~n",[Other]).
+ io:format(D, " Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
+print_client(D, Other) ->
+ io:format(D, " [[Other 1: ~p]]~n",[Other]).
%%%================================================================
-print_servers() ->
+print_servers(D) ->
+ PrintServer = fun(X) -> print_server(D,X) end,
try
- lists:foreach(fun print_server/1, supervisor:which_children(sshd_sup))
+ lists:foreach(PrintServer, supervisor:which_children(sshd_sup))
catch
C:E ->
- io:format('***FAILED: ~p:~p~n',[C,E])
+ io:format(D, '***FAILED: ~p:~p~n',[C,E])
end.
-print_server({{server,ssh_system_sup,LocalHost,LocalPort},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) ->
- io:format('Local=~s (~p children)~n',[fmt_host_port({LocalHost,LocalPort}),
- ssh_acceptor:number_of_connections(Pid)]),
- lists:foreach(fun print_system_sup/1, supervisor:which_children(Pid));
-print_server(Other) ->
- io:format(" [[Other 2: ~p]]~n",[Other]).
+print_server(D, {{server,ssh_system_sup,LocalHost,LocalPort},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) ->
+ io:format(D, 'Local=~s (~p children)~n',[fmt_host_port({LocalHost,LocalPort}),
+ ssh_acceptor:number_of_connections(Pid)]),
+ PrintSystemSup = fun(X) -> print_system_sup(D,X) end,
+ lists:foreach(PrintSystemSup, supervisor:which_children(Pid));
+print_server(D, Other) ->
+ io:format(D, " [[Other 2: ~p]]~n",[Other]).
-print_system_sup({Ref,Pid,supervisor,[ssh_subsystem_sup]}) when is_reference(Ref),
+print_system_sup(D, {Ref,Pid,supervisor,[ssh_subsystem_sup]}) when is_reference(Ref),
is_pid(Pid) ->
- lists:foreach(fun print_channels/1, supervisor:which_children(Pid));
-print_system_sup({{ssh_acceptor_sup,LocalHost,LocalPort}, Pid,supervisor, [ssh_acceptor_sup]}) when is_pid(Pid) ->
- io:format(" [Acceptor for ~s]~n",[fmt_host_port({LocalHost,LocalPort})]);
-print_system_sup(Other) ->
- io:format(" [[Other 3: ~p]]~n",[Other]).
-
-print_channels({{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) ->
- lists:foreach(fun print_channel/1, supervisor:which_children(Pid));
-print_channels(Other) ->
- io:format(" [[Other 4: ~p]]~n",[Other]).
-
-
-print_channel({Ref,Pid,worker,[ssh_channel]}) when is_reference(Ref),
- is_pid(Pid) ->
+ PrintChannels = fun(X) -> print_channels(D,X) end,
+ lists:foreach(PrintChannels, supervisor:which_children(Pid));
+print_system_sup(D, {{ssh_acceptor_sup,LocalHost,LocalPort}, Pid,supervisor, [ssh_acceptor_sup]}) when is_pid(Pid) ->
+ io:format(D, " [Acceptor for ~s]~n",[fmt_host_port({LocalHost,LocalPort})]);
+print_system_sup(D, Other) ->
+ io:format(D, " [[Other 3: ~p]]~n",[Other]).
+
+print_channels(D, {{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) ->
+ PrintChannel = fun(X) -> print_channel(D,X) end,
+ lists:foreach(PrintChannel, supervisor:which_children(Pid));
+print_channels(D, Other) ->
+ io:format(D, " [[Other 4: ~p]]~n",[Other]).
+
+
+print_channel(D, {Ref,Pid,worker,[ssh_channel]}) when is_reference(Ref),
+ is_pid(Pid) ->
{{ConnManager,ChannelID}, Str} = ssh_channel:get_print_info(Pid),
{{Local,Remote},StrM} = ssh_connection_handler:get_print_info(ConnManager),
- io:format(' ch ~p: ~s ~s',[ChannelID, StrM, Str]),
- io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
-print_channel(Other) ->
- io:format(" [[Other 5: ~p]]~n",[Other]).
+ io:format(D, ' ch ~p: ~s ~s',[ChannelID, StrM, Str]),
+ io:format(D, " Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
+print_channel(D, Other) ->
+ io:format(D, " [[Other 5: ~p]]~n",[Other]).
%%%================================================================
-define(inc(N), (N+4)).
-walk_sups(StartPid) ->
- io:format("Start at ~p, ~s.~n",[StartPid,dead_or_alive(StartPid)]),
- walk_sups(children(StartPid), _Indent=?inc(0)).
+walk_sups(D, StartPid) ->
+ io:format(D, "Start at ~p, ~s.~n",[StartPid,dead_or_alive(StartPid)]),
+ walk_sups(D, children(StartPid), _Indent=?inc(0)).
-walk_sups([H={_,Pid,SupOrWorker,_}|T], Indent) ->
- indent(Indent), io:format('~200p ~p is ~s~n',[H,Pid,dead_or_alive(Pid)]),
+walk_sups(D, [H={_,Pid,SupOrWorker,_}|T], Indent) ->
+ indent(D, Indent), io:format(D, '~200p ~p is ~s~n',[H,Pid,dead_or_alive(Pid)]),
case SupOrWorker of
- supervisor -> walk_sups(children(Pid), ?inc(Indent));
+ supervisor -> walk_sups(D, children(Pid), ?inc(Indent));
_ -> ok
end,
- walk_sups(T, Indent);
-walk_sups([], _) ->
+ walk_sups(D, T, Indent);
+walk_sups(_D, [], _) ->
ok.
dead_or_alive(Name) when is_atom(Name) ->
@@ -149,7 +157,7 @@ dead_or_alive(Pid) when is_pid(Pid) ->
_ -> "alive"
end.
-indent(I) -> io:format('~*c',[I,$ ]).
+indent(D, I) -> io:format(D,'~*c',[I,$ ]).
children(Pid) ->
Parent = self(),
@@ -166,16 +174,16 @@ children(Pid) ->
end.
%%%================================================================
-underline(Str) ->
- underline(Str, $-).
+underline(D, Str) ->
+ underline(D, Str, $-).
-underline(Str, LineChar) ->
+underline(D, Str, LineChar) ->
Len = lists:flatlength(Str),
- io:format('~s~n',[Str]),
- line(Len,LineChar).
+ io:format(D, '~s~n',[Str]),
+ line(D,Len,LineChar).
-line(Len, Char) ->
- io:format('~*c~n', [Len,Char]).
+line(D, Len, Char) ->
+ io:format(D, '~*c~n', [Len,Char]).
datetime() ->
@@ -188,6 +196,6 @@ fmt_host_port({Host,Port}) -> io_lib:format('~s:~p',[Host,Port]).
-nyi() ->
- io:format('Not yet implemented~n',[]),
+nyi(D) ->
+ io:format(D,'Not yet implemented~n',[]),
nyi.
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 76fa776113..8669be570e 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -44,12 +44,34 @@
versions(client, Options)->
Vsn = proplists:get_value(vsn, Options, ?DEFAULT_CLIENT_VERSION),
- Version = format_version(Vsn),
- {Vsn, Version};
+ {Vsn, format_version(Vsn, software_version(Options))};
versions(server, Options) ->
Vsn = proplists:get_value(vsn, Options, ?DEFAULT_SERVER_VERSION),
- Version = format_version(Vsn),
- {Vsn, Version}.
+ {Vsn, format_version(Vsn, software_version(Options))}.
+
+software_version(Options) ->
+ case proplists:get_value(id_string, Options) of
+ undefined ->
+ "Erlang"++ssh_vsn();
+ {random,Nlo,Nup} ->
+ random_id(Nlo,Nup);
+ ID ->
+ ID
+ end.
+
+ssh_vsn() ->
+ try {ok,L} = application:get_all_key(ssh),
+ proplists:get_value(vsn,L,"")
+ of
+ "" -> "";
+ VSN when is_list(VSN) -> "/" ++ VSN;
+ _ -> ""
+ catch
+ _:_ -> ""
+ end.
+
+random_id(Nlo, Nup) ->
+ [crypto:rand_uniform($a,$z+1) || _<- lists:duplicate(crypto:rand_uniform(Nlo,Nup+1),x) ].
hello_version_msg(Data) ->
[Data,"\r\n"].
@@ -77,9 +99,9 @@ is_valid_mac(Mac, Data, #ssh{recv_mac = Algorithm,
yes_no(Ssh, Prompt) ->
(Ssh#ssh.io_cb):yes_no(Prompt, Ssh).
-format_version({Major,Minor}) ->
+format_version({Major,Minor}, SoftwareVersion) ->
"SSH-" ++ integer_to_list(Major) ++ "." ++
- integer_to_list(Minor) ++ "-Erlang".
+ integer_to_list(Minor) ++ "-" ++ SoftwareVersion.
handle_hello_version(Version) ->
try
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 45c03035cb..f5f8991acc 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -50,6 +50,14 @@ all() ->
double_close,
ssh_connect_timeout,
ssh_connect_arg4_timeout,
+ packet_size_zero,
+ ssh_daemon_minimal_remote_max_packet_size_option,
+ id_string_no_opt_client,
+ id_string_own_string_client,
+ id_string_random_client,
+ id_string_no_opt_server,
+ id_string_own_string_server,
+ id_string_random_server,
{group, hardening_tests}
].
@@ -757,6 +765,124 @@ ms_passed(N1={_,_,M1}, N2={_,_,M2}) ->
1000 * (Min*60 + Sec + (M2-M1)/1000000).
%%--------------------------------------------------------------------
+packet_size_zero(Config) ->
+ SystemDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+
+ {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{"vego", "morot"}]}]),
+ Conn =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false},
+ {user, "vego"},
+ {password, "morot"}]),
+
+ {ok,Chan} = ssh_connection:session_channel(Conn, 1000, _MaxPacketSize=0, 60000),
+ ok = ssh_connection:shell(Conn, Chan),
+
+ ssh:close(Conn),
+ ssh:stop_daemon(Server),
+
+ receive
+ {ssh_cm,Conn,{data,Chan,_Type,_Msg1}} = M ->
+ ct:pal("Got ~p",[M]),
+ ct:fail(doesnt_obey_max_packet_size_0)
+ after 5000 ->
+ ok
+ end.
+
+%%--------------------------------------------------------------------
+ssh_daemon_minimal_remote_max_packet_size_option(Config) ->
+ SystemDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+
+ {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{"vego", "morot"}]},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {minimal_remote_max_packet_size, 14}]),
+ Conn =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false},
+ {user, "vego"},
+ {password, "morot"}]),
+
+ %% Try the limits of the minimal_remote_max_packet_size:
+ {ok, _ChannelId} = ssh_connection:session_channel(Conn, 100, 14, infinity),
+ {open_error,_,"Maximum packet size below 14 not supported",_} =
+ ssh_connection:session_channel(Conn, 100, 13, infinity),
+
+ ssh:close(Conn),
+ ssh:stop_daemon(Server).
+
+%%--------------------------------------------------------------------
+id_string_no_opt_client(Config) ->
+ {Server, Host, Port} = fake_daemon(Config),
+ {error,_} = ssh:connect(Host, Port, []),
+ receive
+ {id,Server,"SSH-2.0-Erlang/"++Vsn} ->
+ true = expected_ssh_vsn(Vsn);
+ {id,Server,Other} ->
+ ct:fail("Unexpected id: ~s.",[Other])
+ end.
+
+%%--------------------------------------------------------------------
+id_string_own_string_client(Config) ->
+ {Server, Host, Port} = fake_daemon(Config),
+ {error,_} = ssh:connect(Host, Port, [{id_string,"Pelle"}]),
+ receive
+ {id,Server,"SSH-2.0-Pelle\r\n"} ->
+ ok;
+ {id,Server,Other} ->
+ ct:fail("Unexpected id: ~s.",[Other])
+ end.
+
+%%--------------------------------------------------------------------
+id_string_random_client(Config) ->
+ {Server, Host, Port} = fake_daemon(Config),
+ {error,_} = ssh:connect(Host, Port, [{id_string,random}]),
+ receive
+ {id,Server,Id="SSH-2.0-Erlang"++_} ->
+ ct:fail("Unexpected id: ~s.",[Id]);
+ {id,Server,Rnd="SSH-2.0-"++_} ->
+ ct:log("Got ~s.",[Rnd]);
+ {id,Server,Id} ->
+ ct:fail("Unexpected id: ~s.",[Id])
+ end.
+
+%%--------------------------------------------------------------------
+id_string_no_opt_server(Config) ->
+ {_Server, Host, Port} = std_daemon(Config, []),
+ {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]),
+ {ok,"SSH-2.0-Erlang/"++Vsn} = gen_tcp:recv(S1, 0, 2000),
+ true = expected_ssh_vsn(Vsn).
+
+%%--------------------------------------------------------------------
+id_string_own_string_server(Config) ->
+ {_Server, Host, Port} = std_daemon(Config, [{id_string,"Olle"}]),
+ {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]),
+ {ok,"SSH-2.0-Olle\r\n"} = gen_tcp:recv(S1, 0, 2000).
+
+%%--------------------------------------------------------------------
+id_string_random_server(Config) ->
+ {_Server, Host, Port} = std_daemon(Config, [{id_string,random}]),
+ {ok,S1}=gen_tcp:connect(Host,Port,[{active,false}]),
+ {ok,"SSH-2.0-"++Rnd} = gen_tcp:recv(S1, 0, 2000),
+ case Rnd of
+ "Erlang"++_ -> ct:log("Id=~p",[Rnd]),
+ {fail,got_default_id};
+ "Olle\r\n" -> {fail,got_previous_tests_value};
+ _ -> ct:log("Got ~s.",[Rnd])
+ end.
+
+%%--------------------------------------------------------------------
ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true).
ssh_connect_negtimeout_sequential(Config) -> ssh_connect_negtimeout(Config,false).
@@ -970,7 +1096,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
%% Due to timing the error message may or may not be delivered to
%% the "tcp-application" before the socket closed message is recived
-check_error("Internal error") ->
+check_error("Invalid state") ->
ok;
check_error("Connection closed") ->
ok;
@@ -1035,3 +1161,46 @@ do_shell(IO, Shell) ->
%% {'EXIT', Shell, killed} ->
%% ok
%% end.
+
+
+std_daemon(Config, ExtraOpts) ->
+ SystemDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+ {_Server, _Host, _Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {failfun, fun ssh_test_lib:failfun/2} | ExtraOpts]).
+
+expected_ssh_vsn(Str) ->
+ try
+ {ok,L} = application:get_all_key(ssh),
+ proplists:get_value(vsn,L,"")++"\r\n"
+ of
+ Str -> true;
+ "\r\n" -> true;
+ _ -> false
+ catch
+ _:_ -> true %% ssh not started so we dont't know
+ end.
+
+
+fake_daemon(_Config) ->
+ Parent = self(),
+ %% start the server
+ Server = spawn(fun() ->
+ {ok,Sl} = gen_tcp:listen(0,[]),
+ {ok,{Host,Port}} = inet:sockname(Sl),
+ Parent ! {sockname,self(),Host,Port},
+ Rsa = gen_tcp:accept(Sl),
+ ct:log("Server gen_tcp:accept got ~p",[Rsa]),
+ {ok,S} = Rsa,
+ receive
+ {tcp, S, Id} -> Parent ! {id,self(),Id}
+ end
+ end),
+ %% Get listening host and port
+ receive
+ {sockname,Server,ServerHost,ServerPort} -> {Server, ServerHost, ServerPort}
+ end.
+
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 0d90278977..b2b85a717f 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,4 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 3.2
+SSH_VSN = 3.2.2
APP_VSN = "ssh-$(SSH_VSN)"
-
diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl
index 7cfaa2c325..50dbbb82ee 100644
--- a/lib/test_server/src/erl2html2.erl
+++ b/lib/test_server/src/erl2html2.erl
@@ -117,9 +117,10 @@ parse_preprocessed_file(Epp,File,InCorrectFile) ->
parse_preprocessed_file(Epp,File,true);
{attribute,_,file,{_OtherFile,_}} ->
parse_preprocessed_file(Epp,File,false);
- {function,L,F,A,[_|C]} when InCorrectFile ->
- Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C],
- [{atom_to_list(F),A,L} | Clauses] ++
+ {function,L,F,A,Cs} when InCorrectFile ->
+ {CLs,LastCL} = find_clause_lines(Cs, []),
+ %% tl(CLs) cause we know the start line already
+ [{atom_to_list(F),A,L,LastCL} | tl(CLs)] ++
parse_preprocessed_file(Epp,File,true);
_ ->
parse_preprocessed_file(Epp,File,InCorrectFile)
@@ -146,9 +147,10 @@ parse_non_preprocessed_file(Epp, File, Location) ->
case epp_dodger:parse_form(Epp, Location) of
{ok,Tree,Location1} ->
try erl_syntax:revert(Tree) of
- {function,L,F,A,[_|C]} ->
- Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C],
- [{atom_to_list(F),A,L} | Clauses] ++
+ {function,L,F,A,Cs} ->
+ {CLs,LastCL} = find_clause_lines(Cs, []),
+ %% tl(CLs) cause we know the start line already
+ [{atom_to_list(F),A,L,LastCL} | tl(CLs)] ++
parse_non_preprocessed_file(Epp, File, Location1);
_ ->
parse_non_preprocessed_file(Epp, File, Location1)
@@ -162,22 +164,48 @@ parse_non_preprocessed_file(Epp, File, Location) ->
end.
%%%-----------------------------------------------------------------
+%%% Find the line number of the last expression in the function
+find_clause_lines([{clause,CL,_Params,_Op,Exprs}], CLs) -> % last clause
+ try tuple_to_list(lists:last(Exprs)) of
+ [_Type,ExprLine | _] ->
+ {lists:reverse([{clause,CL}|CLs]), ExprLine};
+ _ ->
+ {lists:reverse([{clause,CL}|CLs]), CL}
+ catch
+ _:_ ->
+ {lists:reverse([{clause,CL}|CLs]), CL}
+ end;
+
+find_clause_lines([{clause,CL,_Params,_Op,_Exprs} | Cs], CLs) ->
+ find_clause_lines(Cs, [{clause,CL}|CLs]).
+
+%%%-----------------------------------------------------------------
%%% Add a link target for each line and one for each function definition.
-build_html(SFd,DFd,Encoding,Functions) ->
- build_html(SFd,DFd,Encoding,file:read_line(SFd),1,Functions,false).
+build_html(SFd,DFd,Encoding,FuncsAndCs) ->
+ build_html(SFd,DFd,Encoding,file:read_line(SFd),1,FuncsAndCs,
+ false,undefined).
-build_html(SFd,DFd,Encoding,{ok,Str},L,[{F,A,L}|Functions],_IsFuncDef) ->
+%% function start line found
+build_html(SFd,DFd,Enc,{ok,Str},L0,[{F,A,L0,LastL}|FuncsAndCs],
+ _IsFuncDef,_FAndLastL) ->
FALink = test_server_ctrl:uri_encode(F++"-"++integer_to_list(A),utf8),
- file:write(DFd,["<a name=\"",to_raw_list(FALink,Encoding),"\"/>"]),
- build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,true);
-build_html(SFd,DFd,Encoding,{ok,Str},L,[{clause,L}|Functions],_IsFuncDef) ->
- build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,true);
-build_html(SFd,DFd,Encoding,{ok,Str},L,Functions,IsFuncDef) ->
+ file:write(DFd,["<a name=\"",to_raw_list(FALink,Enc),"\"/>"]),
+ build_html(SFd,DFd,Enc,{ok,Str},L0,FuncsAndCs,true,{F,LastL});
+%% line of last expression in function found
+build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,_IsFuncDef,{F,LastL}) ->
+ LastLineLink = test_server_ctrl:uri_encode(F++"-last_expr",utf8),
+ file:write(DFd,["<a name=\"",
+ to_raw_list(LastLineLink,Enc),"\"/>"]),
+ build_html(SFd,DFd,Enc,{ok,Str},LastL,FuncsAndCs,true,undefined);
+build_html(SFd,DFd,Enc,{ok,Str},L,[{clause,L}|FuncsAndCs],
+ _IsFuncDef,FAndLastL) ->
+ build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,true,FAndLastL);
+build_html(SFd,DFd,Enc,{ok,Str},L,FuncsAndCs,IsFuncDef,FAndLastL) ->
LStr = line_number(L),
Str1 = line(Str,IsFuncDef),
file:write(DFd,[LStr,Str1]),
- build_html(SFd,DFd,Encoding,file:read_line(SFd),L+1,Functions,false);
-build_html(_SFd,_DFd,_Encoding,eof,L,_Functions,_IsFuncDef) ->
+ build_html(SFd,DFd,Enc,file:read_line(SFd),L+1,FuncsAndCs,false,FAndLastL);
+build_html(_SFd,_DFd,_Enc,eof,L,_FuncsAndCs,_IsFuncDef,_FAndLastL) ->
L.
line_number(L) ->
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index 8d91778cbb..1c3352550b 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -1355,12 +1355,30 @@ get_loc(Pid) ->
Stk = [rewrite_loc_item(Loc) || Loc <- Stk0],
case get(test_server_loc) of
[{Suite,Case}] ->
- %% location info unknown, check if {Suite,Case,Line}
- %% is available in stacktrace. and if so, use stacktrace
- %% instead of current test_server_loc
+ %% Location info unknown, check if {Suite,Case,Line}
+ %% is available in stacktrace and if so, use stacktrace
+ %% instead of current test_server_loc.
+ %% If location is the last expression in a test case
+ %% function, the info is not available due to tail call
+ %% elimination. We need to check if the test case has been
+ %% called by ts_tc/3 and, if so, insert the test case info
+ %% at that position.
case [match || {S,C,_L} <- Stk, S == Suite, C == Case] of
- [match|_] -> put(test_server_loc, Stk);
- _ -> ok
+ [match|_] ->
+ put(test_server_loc, Stk);
+ _ ->
+ {PreTC,PostTC} =
+ lists:splitwith(fun({test_server,ts_tc,_}) ->
+ false;
+ (_) ->
+ true
+ end, Stk),
+ if PostTC == [] ->
+ ok;
+ true ->
+ put(test_server_loc,
+ PreTC++[{Suite,Case,last_expr} | PostTC])
+ end
end;
_ ->
put(test_server_loc, Stk)
@@ -1422,7 +1440,10 @@ lookup_config(Key,Config) ->
undefined
end.
-%% timer:tc/3
+%%
+%% IMPORTANT: get_loc/1 uses the name of this function when analysing
+%% stack traces. If the name changes, get_loc/1 must be updated!
+%%
ts_tc(M, F, A) ->
Before = erlang:now(),
Result = try
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 96e369a138..15a6fdd1de 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -61,33 +61,37 @@ timetrap(Timeout0, ReportTVal, Scale, Pid) ->
TruncTO = trunc(Timeout),
receive
after TruncTO ->
- case is_process_alive(Pid) of
- true ->
- TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
- true -> ReportTVal end,
- MFLs = test_server:get_loc(Pid),
- Mon = erlang:monitor(process, Pid),
- Trap = {timetrap_timeout,TimeToReport,MFLs},
- exit(Pid, Trap),
- receive
- {'DOWN', Mon, process, Pid, _} ->
- ok
- after 10000 ->
- %% Pid is probably trapping exits, hit it harder...
- catch error_logger:warning_msg(
- "Testcase process ~w not "
- "responding to timetrap "
- "timeout:~n"
- " ~p.~n"
- "Killing testcase...~n",
- [Pid, Trap]),
- exit(Pid, kill)
- end;
- false ->
+ kill_the_process(Pid, Timeout0, TruncTO, ReportTVal)
+ end.
+
+kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) ->
+ case is_process_alive(Pid) of
+ true ->
+ TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
+ true -> ReportTVal end,
+ MFLs = test_server:get_loc(Pid),
+ Mon = erlang:monitor(process, Pid),
+ Trap = {timetrap_timeout,TimeToReport,MFLs},
+ exit(Pid, Trap),
+ receive
+ {'DOWN', Mon, process, Pid, _} ->
ok
- end
+ after 10000 ->
+ %% Pid is probably trapping exits, hit it harder...
+ catch error_logger:warning_msg(
+ "Testcase process ~w not "
+ "responding to timetrap "
+ "timeout:~n"
+ " ~p.~n"
+ "Killing testcase...~n",
+ [Pid, Trap]),
+ exit(Pid, kill)
+ end;
+ false ->
+ ok
end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% timetrap_cancel(Handle) -> ok
%% Handle = term()
@@ -812,10 +816,19 @@ format_loc1({Mod,Func,Line}) ->
case {lists:member(no_src, get(test_server_logopts)),
lists:reverse(ModStr)} of
{false,[$E,$T,$I,$U,$S,$_|_]} ->
- io_lib:format("{~w,~w,<a href=\"~ts~ts#~w\">~w</a>}",
+ Link = if is_integer(Line) ->
+ integer_to_list(Line);
+ Line == last_expr ->
+ list_to_atom(atom_to_list(Func)++"-last_expr");
+ is_atom(Line) ->
+ atom_to_list(Line);
+ true ->
+ Line
+ end,
+ io_lib:format("{~w,~w,<a href=\"~ts~ts#~s\">~w</a>}",
[Mod,Func,
test_server_ctrl:uri_encode(downcase(ModStr)),
- ?src_listing_ext,Line,Line]);
+ ?src_listing_ext,Link,Line]);
_ ->
io_lib:format("{~w,~w,~w}",[Mod,Func,Line])
end.
diff --git a/lib/test_server/vsn.mk b/lib/test_server/vsn.mk
index 77225b4cad..2a2ed2b3b0 100644
--- a/lib/test_server/vsn.mk
+++ b/lib/test_server/vsn.mk
@@ -1 +1 @@
-TEST_SERVER_VSN = 3.8
+TEST_SERVER_VSN = 3.8.1