1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2018. 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%%% Purpose: Test NT specific utilities
21-module(nt_SUITE).
22
23-include_lib("common_test/include/ct.hrl").
24-include_lib("kernel/include/file.hrl").
25
26-export([all/0, suite/0,
27         init_per_testcase/2, end_per_testcase/2,
28         nt/1,handle_eventlog/2,
29         middleman/1,service_basic/1, service_env/1, user_env/1, synced/1,
30         service_prio/1,
31         logout/1, debug/1, restart/1, restart_always/1,stopaction/1,
32         shutdown_io/0,do_shutdown_io/0]).
33
34-define(TEST_SERVICES, [1,2,3,4,5,6,7,8,9,10,11]).
35
36suite() ->
37    [{ct_hooks,[ts_install_cth]},
38     {timetrap, {minutes, 3}}].
39
40all() ->
41    case {os:type(), os:version()} of
42	{{win32, nt}, Vsn} when Vsn =< {6,1,999999} ->
43	    [nt, service_basic, service_env, user_env, synced,
44	     service_prio, logout, debug, restart, restart_always,
45	     stopaction];
46	_ -> [nt]
47    end.
48
49init_per_testcase(_Func, Config) ->
50    Config.
51
52end_per_testcase(_Func, _Config) ->
53    lists:foreach(fun(X) ->
54                          catch remove_service("test_service_" ++ integer_to_list(X))
55                  end, ?TEST_SERVICES),
56    ok.
57
58erlsrv() ->
59    "\"" ++ os:find_executable(erlsrv) ++ "\"".
60
61
62recv_prog_output(Port) ->
63    receive
64        {Port, {data, {eol,Data}}} ->
65            %%io:format("Got data: ~s~n", [Data]),
66            [ Data | recv_prog_output(Port)];
67        _X ->
68            %%io:format("Got data: ~p~n", [_X]),
69            Port ! {self(), close},
70            receive
71                _ ->
72                    []
73            end
74    end.
75
76%%% X == parameters to erlsrv
77%%% returns command output without stderr
78do_command(X) ->
79    %%io:format("Command: ~s~n", [erlsrv() ++ " " ++ X]),
80    Port = open_port({spawn, erlsrv() ++ " " ++ X}, [stream, {line, 100}, eof, in]),
81    Res = recv_prog_output(Port),
82    case Res of
83        [] ->
84            failed;
85        _Y ->
86            %%io:format("~p~n",[_Y]),
87            ok
88    end.
89
90
91create_service(Name) ->
92    ok = do_command("add " ++ Name).
93
94start_service(Name) ->
95    ok = do_command("start " ++ Name).
96
97stop_service(Name) ->
98    ok = do_command("stop " ++ Name).
99
100remove_service(Name) ->
101    ok = do_command("remove " ++ Name).
102do_wait_for_it(_,0) ->
103    false;
104do_wait_for_it(FullName,N) ->
105    case net_adm:ping(FullName) of
106        pong ->
107            true;
108        _ ->
109            receive
110            after 1000 ->
111                      do_wait_for_it(FullName,N-1)
112            end
113    end.
114
115wait_for_node(Name) ->
116    FullName = make_full_name(Name),
117    do_wait_for_it(FullName,30).
118
119make_full_name(Name) ->
120    [_,Suffix] = string:lexemes(atom_to_list(node()),"@"),
121    list_to_atom(Name ++ "@" ++ Suffix).
122
123
124%%% The following tests are only run on NT:
125
126%% Check some basic (cosmetic) service parameters
127service_basic(Config) when is_list(Config) ->
128    Name = "test_service_20",
129    IntName = Name++"_internal",
130    Service = [{servicename,Name},
131               {args, ["-setcookie", atom_to_list(erlang:get_cookie())]},
132               {internalservicename,IntName},
133               {comment,"Epic comment"}],
134    ok = erlsrv:store_service(Service),
135    start_service(Name),
136    true = wait_for_node(Name),
137    S2 = erlsrv:get_service(Name),
138    {value,{comment,"Epic comment"}} = lists:keysearch(comment,1,S2),
139    {value,{internalservicename,IntName}} =
140    lists:keysearch(internalservicename,1,S2),
141    S3 = lists:keyreplace(comment,1,S2,{comment,"Basic comment"}),
142    S4 = lists:keyreplace(internalservicename,1,S3,
143                          {internalservicename,"WillNotHappen"}),
144    ok = erlsrv:store_service(S4),
145    S5 = erlsrv:get_service(Name),
146    {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S5),
147    {value,{internalservicename,IntName}} =
148    lists:keysearch(internalservicename,1,S5),
149    NewName = "test_service_21",
150    S6 = erlsrv:new_service(NewName,S5,[]), % should remove
151    % internalservicename
152    ok = erlsrv:store_service(S6),
153    S7 = erlsrv:get_service(NewName),
154    {value,{comment,"Basic comment"}} = lists:keysearch(comment,1,S7),
155    {value,{internalservicename,[$t,$e,$s,$t | _]}} =
156    lists:keysearch(internalservicename,1,S7),
157    remove_service(Name),
158    remove_service(NewName),
159    ok.
160
161%% Check that service name and executable is in the environment of the
162%% erlang process created by erlsrv.
163service_env(Config) when is_list(Config) ->
164    Name = "test_service_2",
165    Service = [{servicename,Name},
166               {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}],
167    ok = erlsrv:store_service(Service),
168    start_service(Name),
169    true = wait_for_node(Name),
170    Name = rpc:call(make_full_name(Name),os,getenv,
171                    ["ERLSRV_SERVICE_NAME"]),
172    "erlsrv.exe" = filename:basename(
173                     hd(
174                       string:lexemes(
175                         rpc:call(make_full_name(Name),
176                                  os,
177                                  getenv,
178                                  ["ERLSRV_EXECUTABLE"]),
179                         "\""))),
180    remove_service(Name),
181    ok.
182
183%% Check that the user defined environment is ADDED to the service's
184%% normal dito.
185user_env(Config) when is_list(Config) ->
186    Name = "test_service_3",
187    Service = [{servicename,Name},{env,[{"HUBBA","BUBBA"}]},
188               {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}],
189    ok = erlsrv:store_service(Service),
190    start_service(Name),
191    true = wait_for_node(Name),
192    true = rpc:call(make_full_name(Name),os,getenv,
193                    ["SystemDrive"]) =/= false,
194    "BUBBA" = rpc:call(make_full_name(Name),os,getenv,["HUBBA"]),
195    remove_service(Name),
196    ok.
197
198%% Check that services are stopped and started syncronous and that
199%% failed stopactions kill the erlang machine anyway.
200synced(Config) when is_list(Config) ->
201    Name0 = "test_service_4",
202    Service0 = [{servicename,Name0},
203                {machine, "N:\\nickeNyfikenPaSjukhus"}],
204    ok = erlsrv:store_service(Service0),
205    true = (catch start_service(Name0)) =/= ok,
206    remove_service(Name0),
207    Name = "test_service_5",
208    Service = [{servicename,Name},
209               {stopaction,"erlang:info(garbage_collection)."},
210               {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}],
211    ok = erlsrv:store_service(Service),
212    start_service(Name),
213    true = wait_for_node(Name),
214    T1 = calendar:datetime_to_gregorian_seconds(
215           calendar:universal_time()),
216    stop_service(Name),
217    Diff1 = calendar:datetime_to_gregorian_seconds(
218              calendar:universal_time()) - T1,
219    true = Diff1 > 30,
220    start_service(Name),
221    true = wait_for_node(Name),
222    T2 = calendar:datetime_to_gregorian_seconds(
223           calendar:universal_time()),
224    remove_service(Name),
225    Diff2 = calendar:datetime_to_gregorian_seconds(
226              calendar:universal_time()) - T2,
227    true = Diff2 > 30,
228    ok.
229
230%% Check that a service with higher prio create port programs with
231%% higher prio.
232service_prio(Config) when is_list(Config) ->
233    Name = "test_service_6",
234    Service = [{servicename,Name},{prio,"high"},
235               {env, [{"HEART_COMMAND","echo off"}]},
236               {args, ["-setcookie", atom_to_list(erlang:get_cookie()),
237                       "-heart"]}],
238    ok = erlsrv:store_service(Service),
239    {ok, OldProcs} = get_current_procs(Config),
240    start_service(Name),
241    {ok, NewProcs} = get_current_procs(Config),
242    timer:sleep(2000),
243    {ok, NewProcs2} = get_current_procs(Config),
244    remove_service(Name),
245    Diff = arrived_procs(OldProcs,NewProcs),
246    io:format("NewProcs ~p~n after sleep~n ~p~n",[Diff, arrived_procs(OldProcs,NewProcs2)]),
247    %% Not really correct, could fail if another heart is
248    %% started at the same time...
249    {value, {"heart.exe",_,"high"}} = lists:keysearch("heart.exe",1,Diff),
250    ok.
251
252%% Check that logout does not kill services
253logout(Config) when is_list(Config) ->
254    {comment, "Have to be run manually by registering a service with " ++
255     "heart, logout and log in again and then examine that the heart " ++
256     "process id is not changed."}.
257
258%% Check the debug options to erlsrv.
259debug(Config) when is_list(Config) ->
260    Name0 = "test_service_7",
261
262    %% We used to set the privdir as temporary directory, but for some
263    %% reason we don't seem to have write access to that directory,
264    %% so we'll use the directory specified in the next line.
265    TempDir = "C:/TEMP",
266    Service0 = [{servicename,Name0},
267                {workdir,filename:nativename(TempDir)},
268                {debugtype,"reuse"},
269                {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}],
270    ok = erlsrv:store_service(Service0),
271    T1 = calendar:datetime_to_gregorian_seconds(
272           calendar:local_time()),
273    %% sleep a little
274    receive after 2000 -> ok end,
275    start_service(Name0),
276    true = wait_for_node(Name0),
277    LF = filename:join(TempDir, Name0++".debug"),
278    {ok,Info0} = file:read_file_info(LF),
279    T2 = calendar:datetime_to_gregorian_seconds(
280           Info0#file_info.mtime),
281    true = T2 > T1,
282    remove_service(Name0),
283    file:delete(LF),
284    Name1 = "test_service_8",
285    Service1 = [{servicename,Name1},
286                {workdir, filename:nativename(TempDir)},
287                {debugtype,"new"},
288                {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}],
289    ok = erlsrv:store_service(Service1),
290    T3 = calendar:datetime_to_gregorian_seconds(
291           calendar:local_time()),
292    %% sleep a little
293    receive after 2000 -> ok end,
294    NF = next_logfile(TempDir, Name1),
295    start_service(Name1),
296    true = wait_for_node(Name1),
297    {ok,Info1} = file:read_file_info(NF),
298    T4 = calendar:datetime_to_gregorian_seconds(
299           Info1#file_info.mtime),
300    true = T4 > T3,
301    remove_service(Name1),
302    file:delete(NF),
303    ok.
304
305%% Check the restart options to erlsrv
306restart(Config) when is_list(Config) ->
307    Name = "test_service_9",
308    Service = [{servicename,Name},
309               {workdir, filename:nativename(logdir(Config))},
310               {onfail,"restart"},
311               {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}],
312    ok = erlsrv:store_service(Service),
313    start_service(Name),
314    true = wait_for_node(Name),
315    receive after 20000 -> ok end,
316    rpc:call(make_full_name(Name),erlang,halt,[]),
317    receive after 1000 -> ok end,
318    true = wait_for_node(Name),
319    rpc:call(make_full_name(Name),erlang,halt,[]),
320    receive after 1000 -> ok end,
321    false = wait_for_node(Name),
322    remove_service(Name),
323    ok.
324
325%% Check the restart options to erlsrv
326restart_always(Config) when is_list(Config) ->
327    Name = "test_service_10",
328    Service = [{servicename,Name},
329               {workdir, filename:nativename(logdir(Config))},
330               {onfail,"restart_always"},
331               {args, ["-setcookie", atom_to_list(erlang:get_cookie())]}],
332    ok = erlsrv:store_service(Service),
333    start_service(Name),
334    true = wait_for_node(Name),
335    rpc:call(make_full_name(Name),erlang,halt,[]),
336    receive after 1000 -> ok end,
337    true = wait_for_node(Name),
338    rpc:call(make_full_name(Name),erlang,halt,[]),
339    receive after 1000 -> ok end,
340    true = wait_for_node(Name),
341    remove_service(Name),
342    ok.
343
344%% Check that stopaction does not hang output while shutting down
345stopaction(Config) when is_list(Config) ->
346    Name = "test_service_11",
347    %% Icky, I prepend the first element in the codepath, cause
348    %% I "suppose" it's the one to where I am.
349    Service = [{servicename,Name},
350               {stopaction,atom_to_list(?MODULE) ++ ":shutdown_io()."},
351               {args, ["-setcookie", atom_to_list(erlang:get_cookie()),
352                       "-pa", hd(code:get_path())]}],
353    ok = erlsrv:store_service(Service),
354    start_service(Name),
355    true = wait_for_node(Name),
356    T1 = calendar:datetime_to_gregorian_seconds(
357           calendar:universal_time()),
358    stop_service(Name),
359    Diff1 = calendar:datetime_to_gregorian_seconds(
360              calendar:universal_time()) - T1,
361    true = Diff1 < 30,
362    remove_service(Name),
363    ok.
364
365
366%%% This test is run on all platforms, but just gives a comment on
367%%% other platforms than NT.
368
369nt(Config) when is_list(Config) ->
370    case {os:type(), os:version()} of
371	{{win32, nt}, Vsn} when Vsn =< {6,1,999999} ->
372	    nt_run();
373	{{win32, nt},  _} ->
374	    {skipped, "This test case requires admin privileges on Win 8 and later."};
375	_ ->
376	    {skipped, "This test case is intended for Win NT only."}
377    end.
378
379
380nt_run() ->
381    start_all(),
382    create_service("test_service_1"),
383    R = start_look_for_single("System","ErlSrv","Informational",
384                              ".*test_service_1.*started.*"),
385    start_service("test_service_1"),
386    Res = look_for_single(R),
387    io:format("Result from eventlog: ~p~n",
388              [Res]),
389    remove_service("test_service_1"),
390    stop_all(),
391    ok.
392
393start_all() ->
394    Pid1 = spawn_link(?MODULE,middleman,[[]]),
395    register(?MODULE,Pid1),
396    _Pid2 = nteventlog:start("log_testing",
397                             {?MODULE,handle_eventlog,[Pid1]}).
398
399stop_all() ->
400    ?MODULE ! stop,
401    nteventlog:stop().
402
403start_look_for_single(Cat,Fac,Sev,MessRE) ->
404    Ref = make_ref(),
405    ?MODULE ! {lookfor, {self(), Ref, {Cat,Fac,Sev,MessRE}}},
406    Ref.
407
408look_for_single(Ref) ->
409    receive
410        {Ref,Time,Mes} ->
411            {Time,Mes}
412    after 60000 ->
413              timeout
414    end.
415
416
417%%% Mes = {Time,Category,Facility,Severity,Message}
418handle_eventlog(Mes,Pid) ->
419    Pid ! Mes.
420
421%%% Waitfor = [{Pid, Ref, {Category,Facility,Severity,MessageRE}} ...]
422middleman(Waitfor) ->
423    receive
424        {Time,Category,Facility,Severity,Message} ->
425            io:format("Middleman got ~s...", [Message]),
426            case match_event({Time,Category,Facility,Severity,Message},
427                             Waitfor) of
428                {ok, {Pid,Ref,Time,Mes}, Rest} ->
429                    io:format("matched~n"),
430                    Pid ! {Ref,Time,Mes},
431                    middleman(Rest);
432                _ ->
433                    io:format("no match~n"),
434                    middleman(Waitfor)
435            end;
436        {lookfor, X} ->
437            io:format("Middleman told to look for ~p~n", [X]),
438            middleman([X|Waitfor]);
439        stop ->
440            stopped;
441        _ ->
442            middleman(Waitfor)
443    end.
444
445
446%%% Matches events, not tail recursive.
447match_event(_X, []) ->
448    nomatch;
449match_event({Time,Cat,Fac,Sev,Mes},[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Tail]) ->
450    case re:run(Mes,MesRE,[{capture,none}]) of
451        match ->
452            %%io:format("Match!~n"),
453            {ok,{Pid,Ref,Time,Mes},Tail};
454        nomatch ->
455            %%io:format("No match~n"),
456            case match_event({Time,Cat,Fac,Sev,Mes},Tail) of
457                {ok,X,Rest} ->
458                    {ok,X,[{Pid,Ref,{Cat,Fac,Sev,MesRE}} | Rest]};
459                X ->
460                    X
461            end
462    end;
463match_event(X,[Y | T]) ->
464    %%io:format("X == ~p, Y == ~p~n",[X,Y]),
465    case match_event(X,T) of
466        {ok,Z,R} ->
467            {ok,Z,[Y|R]};
468        XX ->
469            XX
470    end.
471
472arrived_procs(_,[]) ->
473    [];
474arrived_procs(OldProcs,[{Executable, Pid, Priority} | TNewProcs]) ->
475    case lists:keysearch(Pid,2,OldProcs) of
476        {value, _} ->
477            arrived_procs(OldProcs, TNewProcs);
478        false ->
479            [{Executable, Pid, Priority} | arrived_procs(OldProcs, TNewProcs)]
480    end.
481
482
483get_current_procs(Config) ->
484    P = open_port({spawn,nt_info(Config) ++ " -E"},
485                  [{line,10000}]),
486    L = receive
487            {P,{data,{eol,D}}} ->
488                D;
489            _ -> "error. "
490        end,
491    P ! {self(), close},
492    receive
493        {P, closed} -> ok
494    end,
495    {done,{ok,Tok,_},_} = erl_scan:tokens([],L,0),
496    erl_parse:parse_term(Tok).
497
498nt_info(Config) when is_list(Config) ->
499    "\"" ++ filename:join(proplists:get_value(data_dir, Config), "nt_info") ++ "\"".
500
501
502logdir(Config) ->
503    proplists:get_value(priv_dir, Config).
504
505look_for_next(Template,L,N) ->
506    FN = Template ++ integer_to_list(N),
507    case lists:member(FN,L) of
508        true ->
509            look_for_next(Template,L,N+1);
510        false ->
511            FN
512    end.
513
514next_logfile(LD, Servicename) ->
515    {ok, Files} = file:list_dir(LD),
516    Ftmpl = Servicename ++ ".debug.",
517    filename:join(LD,look_for_next(Ftmpl,Files,1)).
518
519%%% Functions run by the service
520
521do_shutdown_io() ->
522    receive
523    after 2000 ->
524              io:format("IO in shutting down...~n"),
525              erlang:halt()
526    end.
527
528shutdown_io() ->
529    spawn(?MODULE,do_shutdown_io,[]).
530