1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2003-2021. 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
21%%---------------------------------------------------------------
22%% Basic negotiated options with Telnet (RFC 854)
23%%
24%% Side A request: I WILL set option Opt.
25%% Side B answer:  DO go ahead, or no, DON'T set it.
26%%
27%% Side A request: Please DO set this option.
28%% Side B answer:  Ok I WILL, or no, I WON'T set it.
29%%
30%% "Enable option" requests may be rejected.
31%% "Disable option" requests must not.
32%%---------------------------------------------------------------
33
34-module(ct_telnet_client).
35
36%%-define(debug, true).
37
38-export([open/2, open/3, open/4, open/5, open/6, close/1]).
39-export([send_data/2, send_data/3, get_data/1]).
40
41-define(TELNET_PORT, 23).
42-define(OPEN_TIMEOUT,10000).
43-define(IDLE_TIMEOUT,8000).
44
45%% telnet control characters
46-define(SE,	240).
47-define(NOP,	241).
48-define(DM,	242).
49-define(BRK,	243).
50-define(IP,	244).
51-define(AO,	245).
52-define(AYT,	246).
53-define(EC,	247).
54-define(EL,	248).
55-define(GA,	249).
56-define(SB,	250).
57-define(WILL,	251).
58-define(WONT,	252).
59-define(DO,	253).
60-define(DONT,	254).
61-define(IAC,	255).
62
63%% telnet options
64-define(BINARY,            0).
65-define(ECHO,	           1).
66-define(SUPPRESS_GO_AHEAD, 3).
67-define(TERMINAL_TYPE,     24).
68-define(WINDOW_SIZE,       31).
69
70-record(state,{conn_name, get_data, keep_alive=true, log_pos=1}).
71
72open(Server, ConnName) ->
73    open(Server, ?TELNET_PORT, ?OPEN_TIMEOUT, true, false, ConnName).
74
75open(Server, Port, ConnName) ->
76    open(Server, Port, ?OPEN_TIMEOUT, true, false, ConnName).
77
78open(Server, Port, Timeout, ConnName) ->
79    open(Server, Port, Timeout, true, false, ConnName).
80
81open(Server, Port, Timeout, KeepAlive, ConnName) ->
82    open(Server, Port, Timeout, KeepAlive, false, ConnName).
83
84open(Server, Port, Timeout, KeepAlive, NoDelay, ConnName) ->
85    Self = self(),
86    {Pid, MRef} = spawn_monitor(fun() ->
87                                        init(Self, Server, Port, Timeout,
88                                             KeepAlive, NoDelay, ConnName)
89                                end),
90    receive
91        {Result, Pid} ->
92            demonitor(MRef, [flush]),
93            if Result == open -> {ok, Pid}; true -> Result end;
94        {'DOWN', MRef, process, _, _} = T ->
95            {error, T}
96    end.
97
98close(Pid) ->
99    Pid ! {close,self()},
100    receive closed -> ok
101    after 5000 -> ok
102    end.
103
104send_data(Pid, Data) ->
105    send_data(Pid, Data, "\n").
106send_data(Pid, Data, true) ->
107    send_data(Pid, Data, "\n");
108send_data(Pid, Data, Newline) when is_list(Newline) ->
109    send_data(Pid, Data++Newline, false);
110send_data(Pid, Data, false) ->
111    Pid ! {send_data, Data},
112    ok.
113
114get_data(Pid) ->
115    MRef = monitor(process, Pid),
116    Pid ! {get_data, self()},
117    receive
118        {data, Data} ->
119            demonitor(MRef, [flush]),
120            {ok, Data};
121        {'DOWN', MRef, process, _, _} = T ->
122            {error, T}
123    end.
124
125%%%-----------------------------------------------------------------
126%%% Internal functions
127init(Parent, Server, Port, Timeout, KeepAlive, NoDelay, ConnName) ->
128    ct_util:mark_process(),
129    case gen_tcp:connect(Server, Port, [list,{packet,0},{nodelay,NoDelay}], Timeout) of
130	{ok,Sock} ->
131	    dbg("~tp connected to: ~tp (port: ~w, keep_alive: ~w)\n",
132		[ConnName,Server,Port,KeepAlive]),
133	    send([?IAC,?DO,?SUPPRESS_GO_AHEAD], Sock, ConnName),
134	    Parent ! {open,self()},
135	    loop(#state{conn_name=ConnName, get_data=10, keep_alive=KeepAlive},
136		 Sock, []),
137	    gen_tcp:close(Sock);
138        Error ->
139	    Parent ! {Error,self()}
140    end.
141
142loop(State, Sock, Acc) ->
143    receive
144	{tcp_closed,_} ->
145	    dbg("Connection closed\n", []),
146	    Data = lists:reverse(lists:append(Acc)),
147	    dbg("Printing queued messages: ~tp",[Data]),
148	    ct_telnet:log(State#state.conn_name,
149			  general_io, "~ts",
150			  [lists:sublist(Data,
151					 State#state.log_pos,
152					 length(Data))]),
153	    receive
154		{get_data,Pid} ->
155		    Pid ! closed
156	    after 100 ->
157		    ok
158	    end;
159	{tcp,_,Msg0} ->
160	    dbg("rcv tcp msg: ~tp~n",[Msg0]),
161	    Msg = check_msg(Sock,Msg0,[]),
162	    loop(State, Sock, [Msg | Acc]);
163	{send_data,Data} ->
164	    send(Data, Sock, State#state.conn_name),
165	    loop(State, Sock, Acc);
166	{get_data,Pid} ->
167	    NewState =
168		case Acc of
169		    [] ->
170			dbg("get_data nodata\n",[]),
171			erlang:send_after(100,self(),{get_data_delayed,Pid}),
172			if State#state.keep_alive == true ->
173				State#state{get_data=State#state.get_data - 1};
174			   State#state.keep_alive == false ->
175				State
176			end;
177		    _ ->
178			Data = lists:reverse(lists:append(Acc)),
179			Len = length(Data),
180			dbg("get_data ~tp\n",[Data]),
181			ct_telnet:log(State#state.conn_name,
182				      general_io, "~ts",
183				      [lists:sublist(Data,
184						     State#state.log_pos,
185						     Len)]),
186			Pid ! {data,Data},
187			State#state{log_pos = 1}
188		end,
189	    loop(NewState, Sock, []);
190	{get_data_delayed,Pid} ->
191	    NewState =
192		case State of
193		    #state{keep_alive = true, get_data = 0} ->
194			dbg("sending NOP\n",[]),
195			if Acc == [] -> send([?IAC,?NOP], Sock,
196					     State#state.conn_name);
197			   true -> ok
198			end,
199			State#state{get_data=10};
200		    _ ->
201			State
202		end,
203	    {NewAcc,Pos} =
204		case erlang:is_process_alive(Pid) of
205		    true when Acc /= [] ->
206			Data = lists:reverse(lists:append(Acc)),
207			Len = length(Data),
208			dbg("get_data_delayed ~tp\n",[Data]),
209			ct_telnet:log(State#state.conn_name,
210				      general_io, "~ts",
211				      [lists:sublist(Data,
212						     State#state.log_pos,
213						     Len)]),
214			Pid ! {data,Data},
215			{[],1};
216		    true when Acc == [] ->
217			dbg("get_data_delayed nodata\n",[]),
218			Pid ! {data,[]},
219			{[],1};
220		    false ->
221			{Acc,NewState#state.log_pos}
222		end,
223	    loop(NewState#state{log_pos=Pos}, Sock, NewAcc);
224	{close,Pid} ->
225	    dbg("Closing connection\n", []),
226	    if Acc == [] ->
227		    ok;
228	       true ->
229		    Data = lists:reverse(lists:append(Acc)),
230		    dbg("Printing queued messages: ~tp",[Data]),
231		    ct_telnet:log(State#state.conn_name,
232				  general_io, "~ts",
233				  [lists:sublist(Data,
234						 State#state.log_pos,
235						 length(Data))])
236	    end,
237	    gen_tcp:close(Sock),
238	    Pid ! closed
239    after wait(State#state.keep_alive,?IDLE_TIMEOUT) ->
240	    dbg("idle timeout\n",[]),
241	    Data = lists:reverse(lists:append(Acc)),
242	    case Data of
243		[] ->
244		    dbg("sending NOP\n",[]),
245		    send([?IAC,?NOP], Sock, State#state.conn_name),
246		    loop(State, Sock, Acc);
247		_ when State#state.log_pos == length(Data)+1 ->
248		    loop(State, Sock, Acc);
249		_ ->
250		    dbg("idle timeout, printing ~tp\n",[Data]),
251		    Len = length(Data),
252		    ct_telnet:log(State#state.conn_name,
253				  general_io, "~ts",
254				  [lists:sublist(Data,
255						 State#state.log_pos,
256						 Len)]),
257		    loop(State#state{log_pos = Len+1}, Sock, Acc)
258	    end
259    end.
260
261wait(true, Time) -> Time;
262wait(false, _) -> infinity.
263
264send(Data, Sock, ConnName) ->
265    case Data of
266	[?IAC|_] = Cmd ->
267	    cmd_dbg("Sending",Cmd),
268	    try io_lib:format("[~w] ~w", [?MODULE,Data]) of
269		Str ->
270		    ct_telnet:log(ConnName, general_io, Str, [])
271	    catch
272		_:_ -> ok
273	    end;
274	_ ->
275	    dbg("Sending: ~tp\n", [Data]),
276	    try io_lib:format("[~w] ~ts", [?MODULE,Data]) of
277		Str ->
278		    ct_telnet:log(ConnName, general_io, Str, [])
279	    catch
280		_:_ -> ok
281	    end
282    end,
283    ok = gen_tcp:send(Sock, Data),
284    ok.
285
286%% [IAC,IAC] = buffer data value 255
287check_msg(Sock, [?IAC,?IAC | T], Acc) ->
288    check_msg(Sock, T, [?IAC|Acc]);
289
290%% respond to a command
291check_msg(Sock, [?IAC | Cs], Acc) ->
292    case get_cmd(Cs) of
293	{Cmd,Cs1} ->
294	    cmd_dbg("Got",Cmd),
295	    ok = respond_cmd(Cmd, Sock),
296	    check_msg(Sock, Cs1, Acc);
297	error ->
298	    Acc
299    end;
300
301%% buffer a data value
302check_msg(Sock, [H|T], Acc) ->
303    check_msg(Sock, T, [H|Acc]);
304
305check_msg(_Sock, [], Acc) ->
306    Acc.
307
308
309%% Positive responses (WILL and DO).
310
311respond_cmd([?WILL,?ECHO], Sock) ->
312    R = [?IAC,?DO,?ECHO],
313    cmd_dbg("Responding",R),
314    gen_tcp:send(Sock, R);
315
316respond_cmd([?DO,?ECHO], Sock) ->
317    R = [?IAC,?WILL,?ECHO],
318    cmd_dbg("Responding",R),
319    gen_tcp:send(Sock, R);
320
321%% Answers from server
322
323respond_cmd([?WILL,?SUPPRESS_GO_AHEAD], _Sock) ->
324    dbg("Server will suppress-go-ahead\n", []);
325
326respond_cmd([?WONT,?SUPPRESS_GO_AHEAD], _Sock) ->
327    dbg("Warning! Server won't suppress-go-ahead\n", []);
328
329respond_cmd([?DONT | _Opt], _Sock) ->		% server ack?
330    ok;
331respond_cmd([?WONT | _Opt], _Sock) ->		% server ack?
332    ok;
333
334%% Negative responses (WON'T and DON'T). These are default!
335
336respond_cmd([?WILL,Opt], Sock) ->
337    R = [?IAC,?DONT,Opt],
338    cmd_dbg("Responding",R),
339    gen_tcp:send(Sock, R);
340
341respond_cmd([?DO | Opt], Sock) ->
342    R = [?IAC,?WONT | Opt],
343    cmd_dbg("Responding",R),
344    gen_tcp:send(Sock, R);
345
346%% Commands without options (which we ignore)
347
348respond_cmd(?NOP, _Sock) ->
349    ok;
350
351%% Unexpected messages.
352
353respond_cmd([Cmd | Opt], _Sock) when Cmd >= 240, Cmd =< 255 ->
354    dbg("Received cmd: ~w. Ignored!\n", [[Cmd | Opt]]);
355
356respond_cmd([Cmd | Opt], _Sock)  ->
357    dbg("WARNING: Received unknown cmd: ~w. Ignored!\n", [[Cmd | Opt]]).
358
359
360get_cmd([Cmd | Rest]) when Cmd == ?SB ->
361    get_subcmd(Rest, []);
362
363get_cmd([Cmd | Rest]) when Cmd >= 240, Cmd =< 249 ->
364    {?NOP, Rest};
365
366get_cmd([Cmd,Opt | Rest]) when Cmd >= 251, Cmd =< 254 ->
367    {[Cmd,Opt], Rest};
368
369get_cmd(_Other) ->
370    error.
371
372get_subcmd([?SE | Rest], Acc) ->
373    {[?SE | lists:reverse(Acc)], Rest};
374
375get_subcmd([Opt | Rest], Acc) ->
376    get_subcmd(Rest, [Opt | Acc]).
377
378-ifdef(debug).
379dbg(Str,Args) ->
380    TS = timestamp(),
381    io:format("[~p ct_telnet_client, ~s]\n" ++ Str,[self(),TS|Args]).
382
383cmd_dbg(Prefix,Cmd) ->
384    case Cmd of
385	[?IAC|Cmd1] ->
386	    cmd_dbg(Prefix,Cmd1);
387	[Ctrl|Opts] ->
388	    CtrlStr =
389		case Ctrl of
390		    ?DO ->   "DO";
391		    ?DONT -> "DONT";
392		    ?WILL -> "WILL";
393		    ?WONT -> "WONT";
394		    ?NOP ->  "NOP";
395		    _ ->     "CMD"
396		end,
397	    Opts1 =
398		case Opts of
399		    [Opt] -> Opt;
400		    _ -> Opts
401		end,
402	    dbg("~ts: ~ts(~w): ~w\n", [Prefix,CtrlStr,Ctrl,Opts1]);
403	Any  ->
404	    dbg("Unexpected in cmd_dbg:~n~w~n",[Any])
405    end.
406
407timestamp() ->
408    {MS,S,US} = os:timestamp(),
409    {{Year,Month,Day}, {Hour,Min,Sec}} =
410        calendar:now_to_local_time({MS,S,US}),
411    MilliSec = trunc(US/1000),
412    lists:flatten(io_lib:format("~4.10.0B-~2.10.0B-~2.10.0B "
413                                "~2.10.0B:~2.10.0B:~2.10.0B.~3.10.0B",
414                                [Year,Month,Day,Hour,Min,Sec,MilliSec])).
415-else.
416dbg(_Str,_Args) ->
417    ok.
418
419cmd_dbg(_Prefix,_Cmd) ->
420    ok.
421-endif.
422