1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2017-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-module(logger_formatter).
21
22-export([format/2]).
23-export([check_config/1]).
24
25-include("logger_internal.hrl").
26
27%%%-----------------------------------------------------------------
28%%% Types
29-type config() :: #{chars_limit     => pos_integer() | unlimited,
30                    depth           => pos_integer() | unlimited,
31                    legacy_header   => boolean(),
32                    max_size        => pos_integer() | unlimited,
33                    report_cb       => logger:report_cb(),
34                    single_line     => boolean(),
35                    template        => template(),
36                    time_designator => byte(),
37                    time_offset     => integer() | [byte()]}.
38-type template() :: [metakey() | {metakey(),template(),template()} | unicode:chardata()].
39-type metakey() :: atom() | [atom()].
40
41%%%-----------------------------------------------------------------
42%%% API
43-spec format(LogEvent,Config) -> unicode:chardata() when
44      LogEvent :: logger:log_event(),
45      Config :: config().
46format(#{level:=Level,msg:=Msg0,meta:=Meta},Config0)
47  when is_map(Config0) ->
48    Config = add_default_config(Config0),
49    Meta1 = maybe_add_legacy_header(Level,Meta,Config),
50    Template = maps:get(template,Config),
51    {BT,AT0} = lists:splitwith(fun(msg) -> false; (_) -> true end, Template),
52    {DoMsg,AT} =
53        case AT0 of
54            [msg|Rest] -> {true,Rest};
55            _ ->{false,AT0}
56        end,
57    B = do_format(Level,Meta1,BT,Config),
58    A = do_format(Level,Meta1,AT,Config),
59    MsgStr =
60        if DoMsg ->
61                Config1 =
62                    case maps:get(chars_limit,Config) of
63                        unlimited ->
64                            Config;
65                        Size0 ->
66                            Size =
67                                case Size0 - io_lib:chars_length([B,A]) of
68                                    S when S>=0 -> S;
69                                    _ -> 0
70                                end,
71                            Config#{chars_limit=>Size}
72                    end,
73                MsgStr0 = format_msg(Msg0,Meta1,Config1),
74                case maps:get(single_line,Config) of
75                    true ->
76                        %% Trim leading and trailing whitespaces, and replace
77                        %% newlines with ", "
78                        T = lists:reverse(
79                              trim(
80                                lists:reverse(
81                                  trim(MsgStr0,false)),true)),
82                        re:replace(T,",?\r?\n\s*",", ",
83                                   [{return,list},global,unicode]);
84                    _false ->
85                        MsgStr0
86                end;
87           true ->
88                ""
89        end,
90    truncate(B,MsgStr,A,maps:get(max_size,Config)).
91
92trim([H|T],Rev) when H==$\s; H==$\r; H==$\n ->
93    trim(T,Rev);
94trim([H|T],false) when is_list(H) ->
95    case trim(H,false) of
96        [] ->
97            trim(T,false);
98        TrimmedH ->
99            [TrimmedH|T]
100    end;
101trim([H|T],true) when is_list(H) ->
102    case trim(lists:reverse(H),true) of
103        [] ->
104            trim(T,true);
105        TrimmedH ->
106            [lists:reverse(TrimmedH)|T]
107    end;
108trim(String,_) ->
109    String.
110
111do_format(Level,Data,[level|Format],Config) ->
112    [to_string(level,Level,Config)|do_format(Level,Data,Format,Config)];
113do_format(Level,Data,[{Key,IfExist,Else}|Format],Config) ->
114    String =
115        case value(Key,Data) of
116            {ok,Value} -> do_format(Level,Data#{Key=>Value},IfExist,Config);
117            error -> do_format(Level,Data,Else,Config)
118        end,
119    [String|do_format(Level,Data,Format,Config)];
120do_format(Level,Data,[Key|Format],Config)
121  when is_atom(Key) orelse
122       (is_list(Key) andalso is_atom(hd(Key))) ->
123    String =
124        case value(Key,Data) of
125            {ok,Value} -> to_string(Key,Value,Config);
126            error -> ""
127        end,
128    [String|do_format(Level,Data,Format,Config)];
129do_format(Level,Data,[Str|Format],Config) ->
130    [Str|do_format(Level,Data,Format,Config)];
131do_format(_Level,_Data,[],_Config) ->
132    [].
133
134value(Key,Meta) when is_map_key(Key,Meta) ->
135    {ok,maps:get(Key,Meta)};
136value([Key|Keys],Meta) when is_map_key(Key,Meta) ->
137    value(Keys,maps:get(Key,Meta));
138value([],Value) ->
139    {ok,Value};
140value(_,_) ->
141    error.
142
143to_string(time,Time,Config) ->
144    format_time(Time,Config);
145to_string(mfa,MFA,Config) ->
146    format_mfa(MFA,Config);
147to_string(_,Value,Config) ->
148    to_string(Value,Config).
149
150to_string(X,_) when is_atom(X) ->
151    atom_to_list(X);
152to_string(X,_) when is_integer(X) ->
153    integer_to_list(X);
154to_string(X,_) when is_pid(X) ->
155    pid_to_list(X);
156to_string(X,_) when is_reference(X) ->
157    ref_to_list(X);
158to_string(X,Config) when is_list(X) ->
159    case printable_list(lists:flatten(X)) of
160        true -> X;
161        _ -> io_lib:format(p(Config),[X])
162    end;
163to_string(X,Config) ->
164    io_lib:format(p(Config),[X]).
165
166printable_list([]) ->
167    false;
168printable_list(X) ->
169    io_lib:printable_list(X).
170
171format_msg({string,Chardata},Meta,Config) ->
172    format_msg({"~ts",[Chardata]},Meta,Config);
173format_msg({report,_}=Msg,Meta,#{report_cb:=Fun}=Config)
174  when is_function(Fun,1); is_function(Fun,2) ->
175    format_msg(Msg,Meta#{report_cb=>Fun},maps:remove(report_cb,Config));
176format_msg({report,Report},#{report_cb:=Fun}=Meta,Config) when is_function(Fun,1) ->
177    try Fun(Report) of
178        {Format,Args} when is_list(Format), is_list(Args) ->
179            format_msg({Format,Args},maps:remove(report_cb,Meta),Config);
180        Other ->
181            P = p(Config),
182            format_msg({"REPORT_CB/1 ERROR: "++P++"; Returned: "++P,
183                        [Report,Other]},Meta,Config)
184    catch C:R:S ->
185            P = p(Config),
186            format_msg({"REPORT_CB/1 CRASH: "++P++"; Reason: "++P,
187                        [Report,{C,R,logger:filter_stacktrace(?MODULE,S)}]},
188                       Meta,Config)
189    end;
190format_msg({report,Report},#{report_cb:=Fun}=Meta,Config) when is_function(Fun,2) ->
191    try Fun(Report,maps:with([depth,chars_limit,single_line],Config)) of
192        Chardata when ?IS_STRING(Chardata) ->
193            try chardata_to_list(Chardata) % already size limited by report_cb
194            catch _:_ ->
195                    P = p(Config),
196                    format_msg({"REPORT_CB/2 ERROR: "++P++"; Returned: "++P,
197                                [Report,Chardata]},Meta,Config)
198            end;
199        Other ->
200            P = p(Config),
201            format_msg({"REPORT_CB/2 ERROR: "++P++"; Returned: "++P,
202                        [Report,Other]},Meta,Config)
203    catch C:R:S ->
204            P = p(Config),
205            format_msg({"REPORT_CB/2 CRASH: "++P++"; Reason: "++P,
206                        [Report,{C,R,logger:filter_stacktrace(?MODULE,S)}]},
207                       Meta,Config)
208    end;
209format_msg({report,Report},Meta,Config) ->
210    format_msg({report,Report},
211               Meta#{report_cb=>fun logger:format_report/1},
212               Config);
213format_msg(Msg,_Meta,#{depth:=Depth,chars_limit:=CharsLimit,
214                       single_line:=Single}) ->
215    Opts = chars_limit_to_opts(CharsLimit),
216    format_msg(Msg, Depth, Opts, Single).
217
218chars_limit_to_opts(unlimited) -> [];
219chars_limit_to_opts(CharsLimit) -> [{chars_limit,CharsLimit}].
220
221format_msg({Format0,Args},Depth,Opts,Single) ->
222    try
223        Format1 = io_lib:scan_format(Format0, Args),
224        Format = reformat(Format1, Depth, Single),
225        io_lib:build_text(Format,Opts)
226    catch C:R:S ->
227            P = p(Single),
228            FormatError = "FORMAT ERROR: "++P++" - "++P,
229            case Format0 of
230                FormatError ->
231                    %% already been here - avoid failing cyclically
232                    erlang:raise(C,R,S);
233                _ ->
234                    format_msg({FormatError,[Format0,Args]},Depth,Opts,Single)
235            end
236    end.
237
238reformat(Format,unlimited,false) ->
239    Format;
240reformat([#{control_char:=C}=M|T], Depth, true) when C =:= $p ->
241    [limit_depth(M#{width => 0}, Depth)|reformat(T, Depth, true)];
242reformat([#{control_char:=C}=M|T], Depth, true) when C =:= $P ->
243    [M#{width => 0}|reformat(T, Depth, true)];
244reformat([#{control_char:=C}=M|T], Depth, Single) when C =:= $p; C =:= $w ->
245    [limit_depth(M, Depth)|reformat(T, Depth, Single)];
246reformat([H|T], Depth, Single) ->
247    [H|reformat(T, Depth, Single)];
248reformat([], _, _) ->
249    [].
250
251limit_depth(M0, unlimited) ->
252    M0;
253limit_depth(#{control_char:=C0, args:=Args}=M0, Depth) ->
254    C = C0 - ($a - $A),				%To uppercase.
255    M0#{control_char:=C,args:=Args++[Depth]}.
256
257chardata_to_list(Chardata) ->
258    case unicode:characters_to_list(Chardata,unicode) of
259        List when is_list(List) ->
260            List;
261        Error ->
262            throw(Error)
263    end.
264
265truncate(B,Msg,A,unlimited) ->
266    [B,Msg,A];
267truncate(B,Msg,A,Size) ->
268    String = [B,Msg,A],
269    Length = io_lib:chars_length(String),
270    if Length>Size ->
271            {Last,FlatString} =
272                case A of
273                    [] ->
274                        case Msg of
275                            [] ->
276                                {get_last(B),lists:flatten(B)};
277                            _ ->
278                                {get_last(Msg),lists:flatten([B,Msg])}
279                        end;
280                    _ ->
281                        {get_last(A),lists:flatten(String)}
282                end,
283            case Last of
284                $\n->
285                    lists:sublist(FlatString,1,Size-4)++"...\n";
286                _ ->
287                    lists:sublist(FlatString,1,Size-3)++"..."
288            end;
289       true ->
290            String
291    end.
292
293get_last(L) ->
294    get_first(lists:reverse(L)).
295
296get_first([]) ->
297    error;
298get_first([C|_]) when is_integer(C) ->
299    C;
300get_first([L|Rest]) when is_list(L) ->
301    case get_last(L) of
302        error -> get_first(Rest);
303        First -> First
304    end.
305
306%% SysTime is the system time in microseconds
307format_time(SysTime,#{time_offset:=Offset,time_designator:=Des})
308  when is_integer(SysTime) ->
309    calendar:system_time_to_rfc3339(SysTime,[{unit,microsecond},
310                                             {offset,Offset},
311                                             {time_designator,Des}]).
312
313%% SysTime is the system time in microseconds
314timestamp_to_datetimemicro(SysTime,Config) when is_integer(SysTime) ->
315    Micro = SysTime rem 1000000,
316    Sec = SysTime div 1000000,
317    UniversalTime =  erlang:posixtime_to_universaltime(Sec),
318    {{Date,Time},UtcStr} =
319        case offset_to_utc(maps:get(time_offset,Config)) of
320            true -> {UniversalTime,"UTC "};
321            _ -> {erlang:universaltime_to_localtime(UniversalTime),""}
322        end,
323    {Date,Time,Micro,UtcStr}.
324
325format_mfa({M,F,A},_) when is_atom(M), is_atom(F), is_integer(A) ->
326    io_lib:fwrite("~tw:~tw/~w", [M, F, A]);
327format_mfa({M,F,A},Config) when is_atom(M), is_atom(F), is_list(A) ->
328    format_mfa({M,F,length(A)},Config);
329format_mfa(MFA,Config) ->
330    to_string(MFA,Config).
331
332maybe_add_legacy_header(Level,
333                        #{time:=Timestamp}=Meta,
334                        #{legacy_header:=true}=Config) ->
335    #{title:=Title}=MyMeta = add_legacy_title(Level,Meta,Config),
336    {{Y,Mo,D},{H,Mi,S},Micro,UtcStr} =
337        timestamp_to_datetimemicro(Timestamp,Config),
338    Header =
339        io_lib:format("=~ts==== ~w-~s-~4w::~2..0w:~2..0w:~2..0w.~6..0w ~s===",
340                      [Title,D,month(Mo),Y,H,Mi,S,Micro,UtcStr]),
341    Meta#{?MODULE=>MyMeta#{header=>Header}};
342maybe_add_legacy_header(_,Meta,_) ->
343    Meta.
344
345add_legacy_title(_Level,#{?MODULE:=#{title:=_}=MyMeta},_) ->
346    MyMeta;
347add_legacy_title(Level,Meta,Config) ->
348    case maps:get(?MODULE,Meta,#{}) of
349        #{title:=_}=MyMeta ->
350            MyMeta;
351        MyMeta ->
352            TitleLevel =
353                case (Level=:=notice andalso maps:find(error_logger,Meta)) of
354                    {ok,_} ->
355                        maps:get(error_logger_notice_header,Config);
356                    _ ->
357                        Level
358                end,
359            Title = string:uppercase(atom_to_list(TitleLevel)) ++ " REPORT",
360            MyMeta#{title=>Title}
361    end.
362
363month(1) -> "Jan";
364month(2) -> "Feb";
365month(3) -> "Mar";
366month(4) -> "Apr";
367month(5) -> "May";
368month(6) -> "Jun";
369month(7) -> "Jul";
370month(8) -> "Aug";
371month(9) -> "Sep";
372month(10) -> "Oct";
373month(11) -> "Nov";
374month(12) -> "Dec".
375
376%% Ensure that all valid configuration parameters exist in the final
377%% configuration map
378add_default_config(Config0) ->
379    Default =
380        #{chars_limit=>unlimited,
381          error_logger_notice_header=>info,
382          legacy_header=>false,
383          single_line=>true,
384          time_designator=>$T},
385    MaxSize = get_max_size(maps:get(max_size,Config0,undefined)),
386    Depth = get_depth(maps:get(depth,Config0,undefined)),
387    Offset = get_offset(maps:get(time_offset,Config0,undefined)),
388    add_default_template(maps:merge(Default,Config0#{max_size=>MaxSize,
389                                                     depth=>Depth,
390                                                     time_offset=>Offset})).
391
392add_default_template(#{template:=_}=Config) ->
393    Config;
394add_default_template(Config) ->
395    Config#{template=>default_template(Config)}.
396
397default_template(#{legacy_header:=true}) ->
398    ?DEFAULT_FORMAT_TEMPLATE_HEADER;
399default_template(#{single_line:=true}) ->
400    ?DEFAULT_FORMAT_TEMPLATE_SINGLE;
401default_template(_) ->
402    ?DEFAULT_FORMAT_TEMPLATE.
403
404get_max_size(undefined) ->
405    unlimited;
406get_max_size(S) ->
407    max(10,S).
408
409get_depth(undefined) ->
410    error_logger:get_format_depth();
411get_depth(S) ->
412    max(5,S).
413
414get_offset(undefined) ->
415    utc_to_offset(get_utc_config());
416get_offset(Offset) ->
417    Offset.
418
419utc_to_offset(true) ->
420    "Z";
421utc_to_offset(false) ->
422    "".
423
424get_utc_config() ->
425    %% SASL utc_log overrides stdlib config - in order to have uniform
426    %% timestamps in log messages
427    case application:get_env(sasl, utc_log) of
428        {ok, Val} when is_boolean(Val) -> Val;
429        _ ->
430            case application:get_env(stdlib, utc_log) of
431                {ok, Val} when is_boolean(Val) -> Val;
432                _ -> false
433            end
434    end.
435
436offset_to_utc(Z) when Z=:=0; Z=:="z"; Z=:="Z" ->
437    true;
438offset_to_utc([$+|Tz]) ->
439    case io_lib:fread("~d:~d", Tz) of
440        {ok, [0, 0], []} ->
441            true;
442        _ ->
443            false
444    end;
445offset_to_utc(_) ->
446    false.
447
448-spec check_config(Config) -> ok | {error,term()} when
449      Config :: config().
450check_config(Config) when is_map(Config) ->
451    do_check_config(maps:to_list(Config));
452check_config(Config) ->
453    {error,{invalid_formatter_config,?MODULE,Config}}.
454
455do_check_config([{Type,L}|Config]) when Type == chars_limit;
456                                        Type == depth;
457                                        Type == max_size ->
458    case check_limit(L) of
459        ok -> do_check_config(Config);
460        error -> {error,{invalid_formatter_config,?MODULE,{Type,L}}}
461    end;
462do_check_config([{single_line,SL}|Config]) when is_boolean(SL) ->
463    do_check_config(Config);
464do_check_config([{legacy_header,LH}|Config]) when is_boolean(LH) ->
465    do_check_config(Config);
466do_check_config([{error_logger_notice_header,ELNH}|Config]) when ELNH == info;
467                                                                 ELNH == notice ->
468    do_check_config(Config);
469do_check_config([{report_cb,RCB}|Config]) when is_function(RCB,1);
470                                               is_function(RCB,2) ->
471    do_check_config(Config);
472do_check_config([{template,T}|Config]) ->
473    case check_template(T) of
474        ok -> do_check_config(Config);
475        error -> {error,{invalid_formatter_template,?MODULE,T}}
476    end;
477do_check_config([{time_offset,Offset}|Config]) ->
478    case check_offset(Offset) of
479        ok ->
480            do_check_config(Config);
481        error ->
482            {error,{invalid_formatter_config,?MODULE,{time_offset,Offset}}}
483    end;
484do_check_config([{time_designator,Char}|Config]) when Char>=0, Char=<255 ->
485    case io_lib:printable_latin1_list([Char]) of
486        true ->
487            do_check_config(Config);
488        false ->
489            {error,{invalid_formatter_config,?MODULE,{time_designator,Char}}}
490    end;
491do_check_config([C|_]) ->
492    {error,{invalid_formatter_config,?MODULE,C}};
493do_check_config([]) ->
494    ok.
495
496check_limit(L) when is_integer(L), L>0 ->
497    ok;
498check_limit(unlimited) ->
499    ok;
500check_limit(_) ->
501    error.
502
503check_template([Key|T]) when is_atom(Key) ->
504    check_template(T);
505check_template([Key|T]) when is_list(Key), is_atom(hd(Key)) ->
506    case lists:all(fun(X) when is_atom(X) -> true;
507                      (_) -> false
508                   end,
509                   Key) of
510        true ->
511            check_template(T);
512        false ->
513            error
514    end;
515check_template([{Key,IfExist,Else}|T])
516  when is_atom(Key) orelse
517       (is_list(Key) andalso is_atom(hd(Key))) ->
518    case check_template(IfExist) of
519        ok ->
520            case check_template(Else) of
521                ok ->
522                    check_template(T);
523                error ->
524                    error
525            end;
526        error ->
527            error
528    end;
529check_template([Str|T]) when is_list(Str) ->
530    case io_lib:printable_unicode_list(Str) of
531        true -> check_template(T);
532        false -> error
533    end;
534check_template([Bin|T]) when is_binary(Bin) ->
535    case unicode:characters_to_list(Bin) of
536        Str when is_list(Str) -> check_template([Str|T]);
537        _Error -> error
538    end;
539check_template([]) ->
540    ok;
541check_template(_) ->
542    error.
543
544check_offset(I) when is_integer(I) ->
545    ok;
546check_offset(Tz) when Tz=:=""; Tz=:="Z"; Tz=:="z" ->
547    ok;
548check_offset([Sign|Tz]) when Sign=:=$+; Sign=:=$- ->
549    check_timezone(Tz);
550check_offset(_) ->
551    error.
552
553check_timezone(Tz) ->
554    try io_lib:fread("~d:~d", Tz) of
555        {ok, [_, _], []} ->
556            ok;
557        _ ->
558            error
559    catch _:_ ->
560            error
561    end.
562
563p(#{single_line:=Single}) ->
564    p(Single);
565p(true) ->
566    "~0tp";
567p(false) ->
568    "~tp".
569