1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2012-2017. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20%% This module implements group leader processes for test cases.
21%% Each group leader process handles output to the minor log file for
22%% a test case, and calls test_server_io to handle output to the common
23%% log files. The group leader processes are created and destroyed
24%% through the test_server_io module/process.
25
26-module(test_server_gl).
27-export([start_link/1,stop/1,set_minor_fd/3,unset_minor_fd/1,
28	 get_tc_supervisor/1,print/4,set_props/2]).
29
30-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]).
31
32-record(st, {tc_supervisor :: 'none'|pid(),    %Test case supervisor
33	     tc :: mfa() | 'undefined',	       %Current test case MFA
34	     minor :: 'none'|pid(),	       %Minor fd
35	     minor_monitor,		       %Monitor ref for minor fd
36             tsio_monitor,                     %Monitor red for controlling proc
37	     capture :: 'none'|pid(),	       %Capture output
38	     reject_io :: boolean(),	       %Reject I/O requests...
39	     permit_io,			       %... and exceptions
40	     auto_nl=true :: boolean(),	       %Automatically add NL
41	     levels,			       %{Stdout,Major,Minor}
42	     escape_chars=true		       %Switch escaping HTML on/off
43	    }).
44
45%% start_link()
46%%  Start a new group leader process. Only to be called by
47%%  the test_server_io process.
48
49start_link(TSIO) ->
50    case gen_server:start_link(?MODULE, [TSIO], []) of
51	{ok,Pid} ->
52	    {ok,Pid};
53	Other ->
54	    Other
55    end.
56
57
58%% stop(Pid)
59%%  Stop a group leader process. Only to be called by
60%%  the test_server_io process.
61
62stop(GL) ->
63    gen_server:cast(GL, stop).
64
65
66%% set_minor_fd(GL, Fd, MFA)
67%%  GL = Pid for the group leader process
68%%  Fd = file descriptor for the minor log file
69%%  MFA = {M,F,A} for the test case owning the minor log file
70%%
71%%  Register the file descriptor for the minor log file. Subsequent
72%%  IO directed to the minor log file will be written to this file.
73%%  Also register the currently executing process at the testcase
74%%  supervisor corresponding to this group leader process.
75
76set_minor_fd(GL, Fd, MFA) ->
77    req(GL, {set_minor_fd,Fd,MFA,self()}).
78
79
80%% unset_minor_fd(GL, Fd, MFA)
81%%  GL = Pid for the group leader process
82%%
83%%  Unregister the file descriptor for minor log file (typically
84%%  because the test case has ended the minor log file is about
85%%  to be closed). Subsequent IO (for example, by a process spawned
86%%  by the testcase process) will go to the unexpected_io log file.
87
88unset_minor_fd(GL) ->
89    req(GL, unset_minor_fd).
90
91
92%% get_tc_supervisor(GL)
93%%  GL = Pid for the group leader process
94%%
95%%  Return the Pid for the process that supervises the test case
96%%  that has this group leader.
97
98get_tc_supervisor(GL) ->
99    req(GL, get_tc_supervisor).
100
101
102%% print(GL, Detail, Format, Args) -> ok
103%%  GL = Pid for the group leader process
104%%  Detail = integer() | minor | major | html | stdout
105%%  Msg = iodata()
106%%  Printer = internal | pid()
107%%
108%%  Print a message to one of the log files. If Detail is an integer,
109%%  it will be compared to the levels (set by set_props/2) to
110%%  determine which log file(s) that are to receive the output. If
111%%  Detail is an atom, the value of the atom will directly determine
112%%  which log file to use.  IO to the minor log file will be handled
113%%  directly by this group leader process (printing to the file set by
114%%  set_minor_fd/3), and all other IO will be handled by calling
115%%  test_server_io:print/3.
116
117print(GL, Detail, Msg, Printer) ->
118    req(GL, {print,Detail,Msg,Printer}).
119
120
121%% set_props(GL, [PropertyTuple])
122%%  GL = Pid for the group leader process
123%%  PropertyTuple = {levels,{Show,Major,Minor}} |
124%%                  {auto_nl,boolean()} |
125%%                  {reject_io_reqs,boolean()}
126%%
127%%  Set properties for this group leader process.
128
129set_props(GL, PropList) ->
130    req(GL, {set_props,PropList}).
131
132%%% Internal functions.
133
134init([TSIO]) ->
135    ct_util:mark_process(group_leader),
136    EscChars = case application:get_env(test_server, esc_chars) of
137		   {ok,ECBool} -> ECBool;
138		   _           -> true
139	       end,
140    Ref = erlang:monitor(process, TSIO),
141    {ok,#st{tc_supervisor=none,
142	    minor=none,
143	    minor_monitor=none,
144            tsio_monitor=Ref,
145	    capture=none,
146	    reject_io=false,
147	    permit_io=gb_sets:empty(),
148	    auto_nl=true,
149	    levels={1,19,10},
150	    escape_chars=EscChars
151	   }}.
152
153req(GL, Req) ->
154    gen_server:call(GL, Req, infinity).
155
156handle_call(get_tc_supervisor, _From, #st{tc_supervisor=Pid}=St) ->
157    {reply,Pid,St};
158handle_call({set_minor_fd,Fd,MFA,Supervisor}, _From, St) ->
159    Ref = erlang:monitor(process, Fd),
160    {reply,ok,St#st{tc=MFA,minor=Fd,minor_monitor=Ref,
161		    tc_supervisor=Supervisor}};
162handle_call(unset_minor_fd, _From, St) ->
163    {reply,ok,St#st{minor=none,tc_supervisor=none}};
164handle_call({set_props,PropList}, _From, St) ->
165    {reply,ok,do_set_props(PropList, St)};
166handle_call({print,Detail,Msg,Printer}, {From,_}, St) ->
167    output(Detail, Msg, Printer, From, St),
168    {reply,ok,St}.
169
170handle_cast(stop, St) ->
171    {stop,normal,St}.
172
173handle_info({'DOWN',Ref,process,_,Reason}=D, #st{minor_monitor=Ref}=St) ->
174    case Reason of
175	normal -> ok;
176	_ ->
177	    Data = io_lib:format("=== WARNING === TC: ~tw\n"
178				 "Got down from minor Fd ~w: ~tw\n\n",
179				 [St#st.tc,St#st.minor,D]),
180	    test_server_io:print_unexpected(Data)
181    end,
182    {noreply,St#st{minor=none,minor_monitor=none}};
183handle_info({'DOWN',Ref,process,_,_}, #st{tsio_monitor=Ref}=St) ->
184    %% controlling process (test_server_io) terminated, we're done
185    {stop,normal,St};
186handle_info({permit_io,Pid}, #st{permit_io=P}=St) ->
187    {noreply,St#st{permit_io=gb_sets:add(Pid, P)}};
188handle_info({capture,Cap0}, St) ->
189    Cap = case Cap0 of
190	      false -> none;
191	      Pid when is_pid(Cap0) -> Pid
192	  end,
193    {noreply,St#st{capture=Cap}};
194handle_info({io_request,From,ReplyAs,Req}=IoReq, St) ->
195    _ = try io_req(Req, From, St) of
196	passthrough ->
197	    group_leader() ! IoReq;
198	{EscapeHtml,Data} ->
199	    case is_io_permitted(From, St) of
200		false ->
201		    ok;
202		true ->
203		    case St of
204			#st{capture=none} ->
205			    ok;
206			#st{capture=CapturePid} ->
207			    CapturePid ! {captured,Data},
208			    ok
209		    end,
210		    case EscapeHtml andalso St#st.escape_chars of
211			true ->
212			    output(minor, test_server_ctrl:escape_chars(Data),
213				   From, From, St);
214			false ->
215			    output(minor, Data, From, From, St)
216		    end
217	    end,
218	    From ! {io_reply,ReplyAs,ok}
219    catch
220	_:_ ->
221	    From ! {io_reply,ReplyAs,{error,arguments}}
222    end,
223    {noreply,St};
224handle_info({structured_io,ClientPid,{Detail,Str}}, St) ->
225    output(Detail, Str, ClientPid, ClientPid, St),
226    {noreply,St};
227handle_info({printout,Detail,["$tc_html",Format],Args}, St) ->
228    Str = io_lib:format(Format, Args),
229    output(Detail, ["$tc_html",Str], internal, none, St),
230    {noreply,St};
231handle_info({printout,Detail,Fun}, St) when is_function(Fun)->
232    output(Detail, Fun, internal, none, St),
233    {noreply,St};
234handle_info({printout,Detail,Format,Args}, St) ->
235    Str = io_lib:format(Format, Args),
236    if not St#st.escape_chars ->
237	    output(Detail, ["$tc_html",Str], internal, none, St);
238       true ->
239	    output(Detail, Str, internal, none, St)
240    end,
241    {noreply,St};
242handle_info(Msg, #st{tc_supervisor=Pid}=St) when is_pid(Pid) ->
243    %% The process overseeing the testcase process also used to be
244    %% the group leader; thus, it is widely expected that it can be
245    %% reached by sending a message to the group leader. Therefore
246    %% we'll need to forward any non-recognized messaged to the test
247    %% case supervisor.
248    Pid ! Msg,
249    {noreply,St};
250handle_info(_Msg, #st{}=St) ->
251    %% There is no known supervisor process. Ignore this message.
252    {noreply,St}.
253
254terminate(_, _) ->
255    ok.
256
257do_set_props([{levels,Levels}|Ps], St) ->
258    do_set_props(Ps, St#st{levels=Levels});
259do_set_props([{auto_nl,AutoNL}|Ps], St) ->
260    do_set_props(Ps, St#st{auto_nl=AutoNL});
261do_set_props([{reject_io_reqs,Bool}|Ps], St) ->
262    do_set_props(Ps, St#st{reject_io=Bool});
263do_set_props([], St) -> St.
264
265io_req({put_chars,Enc,Str}, _, _) when Enc =:= latin1; Enc =:= unicode  ->
266    case Str of
267	["$tc_html",Str0] ->
268	    {false,unicode:characters_to_list(Str0, Enc)};
269	_ ->
270	    {true,unicode:characters_to_list(Str, Enc)}
271    end;
272io_req({put_chars,Encoding,Mod,Func,[Format,Args]}, _, _) ->
273    case Format of
274	["$tc_html",Format0] ->
275	    Str = Mod:Func(Format0, Args),
276	    {false,unicode:characters_to_list(Str, Encoding)};
277	_ ->
278	    Str = Mod:Func(Format, Args),
279	    {true,unicode:characters_to_list(Str, Encoding)}
280    end;
281io_req(_, _, _) -> passthrough.
282
283output(Level, StrOrFun, Sender, From, St) when is_integer(Level) ->
284    case selected_by_level(Level, stdout, St) of
285	true when hd(StrOrFun) == "$tc_html" ->
286	    output(stdout, tl(StrOrFun), Sender, From, St);
287	true when is_function(StrOrFun) ->
288	    output(stdout, StrOrFun(stdout), Sender, From, St);
289	true ->
290	    output(stdout, StrOrFun, Sender, From, St);
291	false ->
292	    ok
293    end,
294    case selected_by_level(Level, major, St) of
295	true when hd(StrOrFun) == "$tc_html" ->
296	    output(major, tl(StrOrFun), Sender, From, St);
297	true when is_function(StrOrFun) ->
298	    output(major, StrOrFun(major), Sender, From, St);
299	true ->
300	    output(major, StrOrFun, Sender, From, St);
301	false ->
302	    ok
303    end,
304    case selected_by_level(Level, minor, St) of
305	true when hd(StrOrFun) == "$tc_html" ->
306	    output(minor, tl(StrOrFun), Sender, From, St);
307	true when is_function(StrOrFun) ->
308	    output(minor, StrOrFun(minor), Sender, From, St);
309	true ->
310	    output(minor, test_server_ctrl:escape_chars(StrOrFun),
311		   Sender, From, St);
312	false ->
313	    ok
314    end;
315output(stdout, Str, _Sender, From, St) ->
316    output_to_file(stdout, Str, From, St);
317output(html, Str, _Sender, From, St) ->
318    output_to_file(html, Str, From, St);
319output(Level, Str, Sender, From, St) when is_atom(Level) ->
320    output_to_file(Level, dress_output(Str, Sender, St), From, St).
321
322output_to_file(minor, Data0, From, #st{tc={M,F,A},minor=none}) ->
323    Data = [io_lib:format("=== ~w:~tw/~w\n", [M,F,A]),Data0],
324    test_server_io:print(From, unexpected_io, Data),
325    ok;
326output_to_file(minor, Data, From, #st{tc=TC,minor=Fd}) ->
327    try
328	io:put_chars(Fd, Data)
329    catch
330	Type:Reason ->
331	    Data1 =
332		[io_lib:format("=== ERROR === TC: ~tw\n"
333			       "Failed to write to minor Fd: ~w\n"
334			       "Type: ~w\n"
335			       "Reason: ~tw\n",
336			       [TC,Fd,Type,Reason]),
337		 Data,"\n"],
338	    test_server_io:print(From, unexpected_io, Data1)
339    end;
340output_to_file(Detail, Data, From, _) ->
341    test_server_io:print(From, Detail, Data).
342
343is_io_permitted(From, #st{reject_io=true,permit_io=P}) ->
344    gb_sets:is_member(From, P);
345is_io_permitted(_, #st{reject_io=false}) -> true.
346
347selected_by_level(Level, stdout, #st{levels={Stdout,_,_}}) ->
348    Level =< Stdout;
349selected_by_level(Level, major, #st{levels={_,Major,_}}) ->
350    Level =< Major;
351selected_by_level(Level, minor, #st{levels={_,_,Minor}}) ->
352    Level >= Minor.
353
354dress_output([$=|_]=Str, internal, _) ->
355    [Str,$\n];
356dress_output(Str, internal, _) ->
357    ["=== ",Str,$\n];
358dress_output(Str, _, #st{auto_nl=AutoNL}) ->
359    case AutoNL of
360	true -> [Str,$\n];
361	false -> Str
362    end.
363