1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-2020. 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
23%%% Purpose:
24%%%  This module implements support for using the Erlang trace in a simple way for ssh
25%%%  debugging.
26%%%
27%%%  Begin the session with ssh_dbg:start(). This will do a dbg:start() if needed and
28%%%  then dbg:p/2 to set some flags.
29%%%
30%%%  Next select trace points to activate: for example plain text printouts of messages
31%%%  sent or received. This is switched on and off with ssh_dbg:on(TracePoint(s)) and
32%%%  ssh_dbg:off(TracePoint(s)).  For example:
33%%%
34%%%      ssh_dbg:on(messages)         -- switch on printing plain text messages
35%%%      ssh_dbg:on([alg,terminate])  -- switch on printing info about algorithm negotiation
36%%%      ssh_dbg:on()                 -- switch on all ssh debugging
37%%%
38%%%  To switch, use the off/0 or off/1 function in the same way, for example:
39%%%
40%%%      ssh_dbg:off(alg)             -- switch off algorithm negotiation tracing, but keep all other
41%%%      ssh_dbg:off()                -- switch off all ssh debugging
42%%%
43%%%  Present the trace result with some other method than the default io:format/2:
44%%%      ssh_dbg:start(fun(Format,Args) ->
45%%%                        my_special( io_lib:format(Format,Args) )
46%%%                    end)
47%%%
48
49-module(ssh_dbg).
50
51-export([start/0, start/1,
52         stop/0,
53         start_server/0,
54         start_tracer/0, start_tracer/1,
55         on/1,  on/0,
56         off/1, off/0,
57         is_on/0,
58         is_off/0,
59         go_on/0,
60         %% Circular buffer
61         cbuf_start/0, cbuf_start/1,
62         cbuf_stop_clear/0,
63         cbuf_in/1,
64         cbuf_list/0,
65         hex_dump/1, hex_dump/2,
66         fmt_cbuf_items/0, fmt_cbuf_item/1
67	]).
68
69-export([shrink_bin/1,
70         reduce_state/2, reduce_state/3,
71         wr_record/3]).
72
73-export([init/1, handle_call/3, handle_cast/2, handle_info/2]).
74
75%% Internal apply_after:
76-export([ets_delete/2]).
77
78-include("ssh.hrl").
79-include("ssh_transport.hrl").
80-include("ssh_connect.hrl").
81-include("ssh_auth.hrl").
82
83-behaviour(gen_server).
84-define(SERVER, ?MODULE).
85
86-define(CALL_TIMEOUT, 15000). % 3x the default
87
88-type trace_point() :: atom().
89-type trace_points() :: [trace_point()].
90-type stack() :: list(term()).
91
92-callback ssh_dbg_trace_points() -> trace_points().
93-callback ssh_dbg_flags(trace_point()) -> [atom()].
94-callback ssh_dbg_on(trace_point() | trace_points()) -> term().
95-callback ssh_dbg_off(trace_point() | trace_points()) -> term().
96-callback ssh_dbg_format(trace_point(), term()) -> iolist() | skip.
97-callback ssh_dbg_format(trace_point(), term(), stack()) -> {iolist() | skip, stack()}.
98
99-optional_callbacks([ssh_dbg_format/2, ssh_dbg_format/3]).  % At least one of them are to be used
100
101%%%================================================================
102
103-define(ALL_DBG_TYPES, get_all_dbg_types()).
104
105start() -> start(fun io:format/2).
106
107start(IoFmtFun) when is_function(IoFmtFun,2) ; is_function(IoFmtFun,3) ->
108    start_server(),
109    catch dbg:start(),
110    start_tracer(IoFmtFun),
111    dbg:p(all, get_all_trace_flags()),
112    ?ALL_DBG_TYPES.
113
114stop() ->
115    try
116        dbg:stop_clear(),
117        gen_server:stop(?SERVER)
118    catch
119        _:_ -> ok
120    end.
121
122start_server() ->
123    gen_server:start({local,?SERVER}, ?MODULE, [], []).
124
125
126start_tracer() -> start_tracer(fun io:format/2).
127
128start_tracer(WriteFun) when is_function(WriteFun,2) ->
129    start_tracer(fun(F,A,S) -> WriteFun(F,A), S end);
130start_tracer(WriteFun) when is_function(WriteFun,3) ->
131    start_tracer(WriteFun, undefined).
132
133
134start_tracer(WriteFun, InitAcc) when is_function(WriteFun, 3) ->
135    Handler =
136        fun(Arg, Acc0) ->
137                try_all_types_in_all_modules(gen_server:call(?SERVER, get_on, ?CALL_TIMEOUT),
138                                             Arg, WriteFun,
139                                             Acc0)
140        end,
141    dbg:tracer(process, {Handler,InitAcc}).
142
143%%%----------------------------------------------------------------
144on() -> on(?ALL_DBG_TYPES).
145on(Type) -> switch(on, Type).
146is_on() -> gen_server:call(?SERVER, get_on, ?CALL_TIMEOUT).
147
148
149off() -> off(?ALL_DBG_TYPES). % A bit overkill...
150off(Type) -> switch(off, Type).
151is_off() -> ?ALL_DBG_TYPES -- is_on().
152
153
154go_on() ->
155    IsOn = gen_server:call(?SERVER, get_on, ?CALL_TIMEOUT),
156    on(IsOn).
157
158%%%----------------------------------------------------------------
159shrink_bin(B) when is_binary(B), size(B)>256 -> {'*** SHRINKED BIN',
160						 size(B),
161						 element(1,split_binary(B,64)),
162						 '...',
163						 element(2,split_binary(B,size(B)-64))
164						};
165shrink_bin(L) when is_list(L) -> lists:map(fun shrink_bin/1, L);
166shrink_bin(T) when is_tuple(T) -> list_to_tuple(shrink_bin(tuple_to_list(T)));
167shrink_bin(X) -> X.
168
169%%%----------------------------------------------------------------
170%% Replace any occurence of {Name,...}, with "#Name{}"
171reduce_state(T, RecordExample) ->
172    Name = element(1, RecordExample),
173    Arity = size(RecordExample),
174    reduce_state(T, Name, Arity).
175
176%% Replace any occurence of {Name,...}, with "#Name{}"
177reduce_state(T, Name, Arity) when element(1,T) == Name,
178                                  size(T) == Arity ->
179    lists:concat(['#',Name,'{}']);
180reduce_state(L, Name, Arity) when is_list(L) ->
181    [reduce_state(E,Name,Arity) || E <- L];
182reduce_state(T, Name, Arity) when is_tuple(T) ->
183    list_to_tuple( reduce_state(tuple_to_list(T),Name,Arity) );
184reduce_state(X, _, _) ->
185    X.
186
187%%%================================================================
188-record(data, {
189          types_on = []
190         }).
191
192%%%----------------------------------------------------------------
193init(_) ->
194    new_table(),
195    {ok, #data{}}.
196
197
198new_table() ->
199    try
200        ets:new(?MODULE, [public, named_table]),
201        ok
202    catch
203        exit:badarg ->
204            ok
205    end.
206
207
208get_proc_stack(Pid) when is_pid(Pid) ->
209    try ets:lookup_element(?MODULE, Pid, 2)
210    catch
211        error:badarg ->
212            %% Non-existing item
213            new_proc(Pid),
214            ets:insert(?MODULE, {Pid,[]}),
215            []
216    end.
217
218
219put_proc_stack(Pid, Data) when is_pid(Pid),
220                               is_list(Data) ->
221    ets:insert(?MODULE, {Pid,Data}).
222
223
224new_proc(Pid) when is_pid(Pid) ->
225    gen_server:cast(?SERVER, {new_proc,Pid}).
226
227ets_delete(Tab, Key) ->
228    catch ets:delete(Tab, Key).
229
230%%%----------------------------------------------------------------
231handle_call({switch,on,Types}, _From, D) ->
232    NowOn = lists:usort(Types ++ D#data.types_on),
233    call_modules(on, Types),
234    {reply, {ok,NowOn}, D#data{types_on = NowOn}};
235
236handle_call({switch,off,Types}, _From, D) ->
237    StillOn = D#data.types_on -- Types,
238    call_modules(off, Types),
239    call_modules(on, StillOn),
240    {reply, {ok,StillOn}, D#data{types_on = StillOn}};
241
242handle_call(get_on, _From, D) ->
243    {reply, D#data.types_on, D};
244
245handle_call(C, _From, D) ->
246    io:format('*** Unknown call: ~p~n',[C]),
247    {reply, {error,{unknown_call,C}}, D}.
248
249
250handle_cast({new_proc,Pid}, D) ->
251    monitor(process, Pid),
252    {noreply, D};
253
254handle_cast(C, D) ->
255    io:format('*** Unknown cast: ~p~n',[C]),
256    {noreply, D}.
257
258
259handle_info({'DOWN', _MonitorRef, process, Pid, _Info}, D) ->
260    %% Universal real-time synchronization (there might be dbg msgs in the queue to the tracer):
261    timer:apply_after(20000, ?MODULE, ets_delete, [?MODULE, Pid]),
262    {noreply, D};
263
264handle_info(C, D) ->
265    io:format('*** Unknown info: ~p~n',[C]),
266    {noreply, D}.
267
268
269%%%================================================================
270
271%%%----------------------------------------------------------------
272ssh_modules_with_trace() ->
273    {ok,AllSshModules} = application:get_key(ssh, modules),
274    [M || M <- AllSshModules,
275          {behaviour,Bs} <- M:module_info(attributes),
276          lists:member(?MODULE, Bs)
277    ].
278
279%%%----------------------------------------------------------------
280get_all_trace_flags() ->
281    lists:usort(
282      lists:flatten([timestamp |  call_modules(flags, ?ALL_DBG_TYPES)]
283                   )).
284
285%%%----------------------------------------------------------------
286get_all_dbg_types() ->
287    lists:usort(
288      lists:flatten(
289        call_modules(points) )).
290
291%%%----------------------------------------------------------------
292call_modules(points) ->
293    F = fun(Mod) -> Mod:ssh_dbg_trace_points() end,
294    fold_modules(F, [], ssh_modules_with_trace()).
295
296call_modules(Cmnd, Types) when is_list(Types) ->
297    F = case Cmnd of
298            flags -> fun(Type) ->
299                             fun(Mod) -> Mod:ssh_dbg_flags(Type) end
300                     end;
301            on -> fun(Type) ->
302                          fun(Mod) -> Mod:ssh_dbg_on(Type) end
303                  end;
304            off -> fun(Type) ->
305                           fun(Mod) -> Mod:ssh_dbg_off(Type) end
306                   end
307        end,
308    lists:foldl(fun(T, Acc) ->
309                        fold_modules(F(T), Acc, ssh_modules_with_trace())
310                end, [], Types).
311
312
313
314fold_modules(F, Acc0, Modules) ->
315     lists:foldl(
316       fun(Mod, Acc) ->
317               try F(Mod) of
318                   Result -> [Result|Acc]
319               catch
320                   _:_ -> Acc
321               end
322       end, Acc0, Modules).
323
324%%%----------------------------------------------------------------
325switch(X, Type) when is_atom(Type) ->
326    switch(X, [Type]);
327
328switch(X, Types) when is_list(Types) ->
329    case whereis(?SERVER) of
330        undefined ->
331            start();
332        _ ->
333            ok
334    end,
335    case lists:usort(Types) -- ?ALL_DBG_TYPES of
336        [] ->
337            gen_server:call(?SERVER, {switch,X,Types}, ?CALL_TIMEOUT);
338        L ->
339            {error, {unknown, L}}
340    end.
341
342%%%----------------------------------------------------------------
343%%% Format of trace messages are described in reference manual for erlang:trace/4
344%%%   {call,MFA}
345%%%   {return_from,{M,F,N},Result}
346%%%   {send,Msg,To}
347%%%   {'receive',Msg}
348
349%% Pick 2nd element, the Pid
350trace_pid(T) when element(1,T)==trace
351                  ; element(1,T)==trace_ts ->
352    element(2,T).
353
354%% Pick last element, the Time Stamp, and format it
355trace_ts(T) when  element(1,T)==trace_ts ->
356    ts( element(size(T), T) ).
357
358%% Make a tuple of all elements but the 1st, 2nd and last
359trace_info(T) ->
360    case tuple_to_list(T) of
361        [trace,_Pid | Info] -> list_to_tuple(Info);
362        [trace_ts,_Pid | InfoTS] -> list_to_tuple(
363                                      lists:droplast(InfoTS))
364    end.
365
366
367try_all_types_in_all_modules(TypesOn, Arg, WriteFun, Acc0) ->
368    SshModules = ssh_modules_with_trace(),
369    TS = trace_ts(Arg),
370    PID = trace_pid(Arg),
371    INFO = trace_info(Arg),
372    Acc =
373        lists:foldl(
374          fun(Type, Acc1) ->
375                  lists:foldl(
376                    fun(SshMod,Acc) ->
377                            try
378                                %% First, call without stack
379                                SshMod:ssh_dbg_format(Type, INFO)
380                            of
381                                skip ->
382                                    %% Don't try to print this later
383                                    written;
384                                Txt when is_list(Txt) ->
385                                    write_txt(WriteFun, TS, PID, Txt)
386                            catch
387                                error:E when E==undef ; E==function_clause ; element(1,E)==case_clause ->
388                                    try
389                                        %% then, call with stack
390                                        STACK = get_proc_stack(PID),
391                                        SshMod:ssh_dbg_format(Type, INFO, STACK)
392                                    of
393                                        {skip, NewStack} ->
394                                            %% Don't try to print this later
395                                            put_proc_stack(PID, NewStack),
396                                            written;
397                                        {Txt, NewStack} when is_list(Txt) ->
398                                            put_proc_stack(PID, NewStack),
399                                            write_txt(WriteFun, TS, PID, Txt)
400                                    catch
401                                        _:_ ->
402                                            %% and finally, signal for special formatting
403                                            %% if noone else formats it
404                                            Acc
405                                    end
406                            end
407                    end, Acc1, SshModules)
408          end, Acc0, TypesOn),
409    case Acc of
410        Acc0 ->
411            %% INFO :: any()
412            WriteFun("~n~s ~p DEBUG~n~p~n", [lists:flatten(TS),PID,INFO], Acc0);
413        written ->
414            Acc0
415    end.
416
417
418
419write_txt(WriteFun, TS, PID, Txt) when is_list(Txt) ->
420    WriteFun("~n~s ~p ~ts~n",
421             [lists:flatten(TS),
422              PID,
423              lists:flatten(Txt)],
424             written % this is returned
425            ).
426
427%%%----------------------------------------------------------------
428wr_record(T, Fs, BL) when is_tuple(T) ->
429    wr_record(tuple_to_list(T), Fs, BL);
430wr_record([_Name|Values], Fields, BlackL) ->
431    W = case Fields of
432	    [] -> 0;
433	    _ -> lists:max([length(atom_to_list(F)) || F<-Fields])
434	end,
435    [io_lib:format("  ~*p: ~p~n",[W,Tag,Value]) || {Tag,Value} <- lists:zip(Fields,Values),
436                                                   not lists:member(Tag,BlackL)
437    ].
438
439%%%----------------------------------------------------------------
440ts({_,_,Usec}=Now) when is_integer(Usec) ->
441    {_Date,{HH,MM,SS}} = calendar:now_to_local_time(Now),
442    io_lib:format("~.2.0w:~.2.0w:~.2.0w.~.6.0w",[HH,MM,SS,Usec]);
443ts(_) ->
444    "-".
445
446%%%================================================================
447-define(CIRC_BUF, circ_buf).
448
449cbuf_start() ->
450    cbuf_start(20).
451
452cbuf_start(CbufMaxLen) ->
453    put(?CIRC_BUF, {CbufMaxLen,queue:new()}),
454    ok.
455
456
457cbuf_stop_clear() ->
458    case erase(?CIRC_BUF) of
459        undefined ->
460            [];
461        {_CbufMaxLen,Queue} ->
462            queue:to_list(Queue)
463    end.
464
465
466cbuf_in(Value) ->
467    case get(?CIRC_BUF) of
468        undefined ->
469            disabled;
470        {CbufMaxLen,Queue} ->
471            UpdatedQueue =
472                try queue:head(Queue) of
473                    {Value, TS0, Cnt0} ->
474                        %% Same Value as last saved in the queue
475                        queue:in_r({Value, TS0, Cnt0+1},
476                                 queue:drop(Queue)
477                                );
478                    _ ->
479                        queue:in_r({Value, erlang:timestamp(), 1},
480                                   truncate_cbuf(Queue, CbufMaxLen)
481                                )
482                catch
483                    error:empty ->
484                        queue:in_r({Value, erlang:timestamp(), 1}, Queue)
485                end,
486            put(?CIRC_BUF, {CbufMaxLen,UpdatedQueue}),
487            ok
488    end.
489
490
491cbuf_list() ->
492    case get(?CIRC_BUF) of
493        undefined ->
494            [];
495        {_CbufMaxLen,Queue} ->
496            queue:to_list(Queue)
497    end.
498
499
500truncate_cbuf(Q, CbufMaxLen) ->
501    case queue:len(Q) of
502        N when N>=CbufMaxLen ->
503            truncate_cbuf(element(2,queue:out_r(Q)), CbufMaxLen);
504        _ ->
505            Q
506    end.
507
508fmt_cbuf_items() ->
509    lists:flatten(
510      io_lib:format("Circular trace buffer. Latest item first.~n~s~n",
511                    [case get(?CIRC_BUF) of
512                         {Max,_} ->
513                             L = cbuf_list(),
514                             [io_lib:format("==== ~.*w: ~s~n",[num_digits(Max),N,fmt_cbuf_item(X)]) ||
515                                 {N,X} <- lists:zip(lists:seq(1,length(L)), L)
516                             ];
517                         _ ->
518                             io_lib:format("Not started.~n",[])
519                     end])).
520
521
522num_digits(0) -> 1;
523num_digits(N) when N>0 -> 1+trunc(math:log10(N)).
524
525
526fmt_cbuf_item({Value, TimeStamp, N}) ->
527    io_lib:format("~s~s~n~s~n",
528                  [fmt_ts(TimeStamp),
529                   [io_lib:format(" (Repeated ~p times)",[N]) || N>1],
530                   fmt_value(Value)]).
531
532
533fmt_ts(TS = {_,_,Us}) ->
534    {{YY,MM,DD},{H,M,S}} = calendar:now_to_universal_time(TS),
535    io_lib:format("~w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w.~.6.0w UTC",[YY,MM,DD,H,M,S,Us]).
536
537fmt_value(#circ_buf_entry{module = M,
538                          line = L,
539                          function = {F,A},
540                          pid = Pid,
541                          value = V}) ->
542    io_lib:format("~p:~p  ~p/~p ~p~n~s",[M,L,F,A,Pid,fmt_value(V)]);
543fmt_value(Value) ->
544    io_lib:format("~p",[Value]).
545
546%%%================================================================
547
548-record(h, {max_bytes = 65536,
549            bytes_per_line = 16,
550            address_len = 4
551           }).
552
553
554hex_dump(Data) -> hex_dump1(Data, hd_opts([])).
555
556hex_dump(X, Max) when is_integer(Max) ->
557    hex_dump(X, [{max_bytes,Max}]);
558hex_dump(X, OptList) when is_list(OptList) ->
559    hex_dump1(X, hd_opts(OptList)).
560
561hex_dump1(B, Opts) when is_binary(B) -> hex_dump1(binary_to_list(B), Opts);
562hex_dump1(L, Opts) when is_list(L), length(L) > Opts#h.max_bytes ->
563    io_lib:format("~s---- skip ~w bytes----~n", [hex_dump1(lists:sublist(L,Opts#h.max_bytes), Opts),
564                                                 length(L) - Opts#h.max_bytes
565                                                ]);
566hex_dump1(L, Opts0) when is_list(L) ->
567    Opts = Opts0#h{address_len = num_hex_digits(Opts0#h.max_bytes)},
568    Result = hex_dump(L, [{0,[],[]}], Opts),
569    [io_lib:format("~*.s | ~*s | ~s~n"
570                   "~*.c-+-~*c-+-~*c~n",
571                   [Opts#h.address_len, lists:sublist("Address",Opts#h.address_len),
572                    -3*Opts#h.bytes_per_line, lists:sublist("Hexdump",3*Opts#h.bytes_per_line),
573                    "ASCII",
574                    Opts#h.address_len, $-,
575                    3*Opts#h.bytes_per_line, $-,
576                    Opts#h.bytes_per_line, $-
577                   ]) |
578     [io_lib:format("~*.16.0b | ~s~*c | ~s~n",[Opts#h.address_len, N*Opts#h.bytes_per_line,
579                                               lists:reverse(Hexs),
580                                               3*(Opts#h.bytes_per_line-length(Hexs)), $ ,
581                                               lists:reverse(Chars)])
582      || {N,Hexs,Chars}  <- lists:reverse(Result)
583     ]
584    ].
585
586
587hd_opts(L) -> lists:foldl(fun hd_opt/2, #h{}, L).
588
589hd_opt({max_bytes,M},      O) -> O#h{max_bytes=M};
590hd_opt({bytes_per_line,M}, O) -> O#h{bytes_per_line=M}.
591
592
593num_hex_digits(N) when N<16 -> 1;
594num_hex_digits(N) -> trunc(math:ceil(math:log2(N)/4)).
595
596
597hex_dump([L|Cs], Result0, Opts) when is_list(L) ->
598    Result = hex_dump(L,Result0, Opts),
599    hex_dump(Cs, Result, Opts);
600
601hex_dump(Cs, [{N0,_,Chars}|_]=Lines, Opts) when length(Chars) == Opts#h.bytes_per_line ->
602    hex_dump(Cs, [{N0+1,[],[]}|Lines], Opts);
603
604hex_dump([C|Cs], [{N,Hexs,Chars}|Lines], Opts) ->
605    Asc = if
606              16#20 =< C,C =< 16#7E -> C;
607              true -> $.
608          end,
609    Hex = io_lib:format("~2.16.0b ", [C]),
610    hex_dump(Cs, [{N, [Hex|Hexs], [Asc|Chars]} | Lines], Opts);
611
612hex_dump([], Result, _) ->
613    Result.
614
615
616
617