1# --
2# Copyright (C) 2001-2020 OTRS AG, https://otrs.com/
3# --
4# This software comes with ABSOLUTELY NO WARRANTY. For details, see
5# the enclosed file COPYING for license information (GPL). If you
6# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt.
7# --
8
9package Kernel::System::Log;
10## nofilter(TidyAll::Plugin::OTRS::Perl::PODSpelling)
11## nofilter(TidyAll::Plugin::OTRS::Perl::Time)
12## nofilter(TidyAll::Plugin::OTRS::Perl::Dumper)
13## nofilter(TidyAll::Plugin::OTRS::Perl::Require)
14
15use strict;
16use warnings;
17
18use Carp ();
19
20our @ObjectDependencies = (
21    'Kernel::Config',
22    'Kernel::System::Encode',
23);
24
25=head1 NAME
26
27Kernel::System::Log - global log interface
28
29=head1 DESCRIPTION
30
31All log functions.
32
33=head1 PUBLIC INTERFACE
34
35=head2 new()
36
37create a log object. Do not use it directly, instead use:
38
39    use Kernel::System::ObjectManager;
40    local $Kernel::OM = Kernel::System::ObjectManager->new(
41        'Kernel::System::Log' => {
42            LogPrefix => 'InstallScriptX',  # not required, but highly recommend
43        },
44    );
45    my $LogObject = $Kernel::OM->Get('Kernel::System::Log');
46
47=cut
48
49my %LogLevel = (
50    error  => 16,
51    notice => 8,
52    info   => 4,
53    debug  => 2,
54);
55
56sub new {
57    my ( $Type, %Param ) = @_;
58
59    # allocate new hash for object
60    my $Self = {};
61    bless( $Self, $Type );
62
63    if ( !$Kernel::OM ) {
64        Carp::confess('$Kernel::OM is not defined, please initialize your object manager');
65    }
66
67    my $ConfigObject = $Kernel::OM->Get('Kernel::Config');
68    $Self->{ProductVersion} = $ConfigObject->Get('Product') . ' ';
69    $Self->{ProductVersion} .= $ConfigObject->Get('Version');
70
71    # get system id
72    my $SystemID = $ConfigObject->Get('SystemID');
73
74    # check log prefix
75    $Self->{LogPrefix} = $Param{LogPrefix} || '?LogPrefix?';
76    $Self->{LogPrefix} .= '-' . $SystemID;
77
78    # configured log level (debug by default)
79    $Self->{MinimumLevel}    = $ConfigObject->Get('MinimumLogLevel') || 'debug';
80    $Self->{MinimumLevel}    = lc $Self->{MinimumLevel};
81    $Self->{MinimumLevelNum} = $LogLevel{ $Self->{MinimumLevel} };
82
83    # load log backend
84    my $GenericModule = $ConfigObject->Get('LogModule') || 'Kernel::System::Log::SysLog';
85    if ( !eval "require $GenericModule" ) {    ## no critic
86        die "Can't load log backend module $GenericModule! $@";
87    }
88
89    # create backend handle
90    $Self->{Backend} = $GenericModule->new(
91        %Param,
92    );
93
94    return $Self if !eval "require IPC::SysV";    ## no critic
95
96    # Setup IPC for shared access to the last log entries.
97    $Self->{IPCKey} = '444423' . $SystemID;       # This name is used to identify the shared memory segment.
98    $Self->{IPCSize} = $ConfigObject->Get('LogSystemCacheSize') || 32 * 1024;
99
100    # Create/access shared memory segment.
101    if ( !eval { $Self->{IPCSHMKey} = shmget( $Self->{IPCKey}, $Self->{IPCSize}, oct(1777) ) } ) {
102
103        # If direct creation fails, try more gently, allocate a small segment first and the reset/resize it.
104        $Self->{IPCSHMKey} = shmget( $Self->{IPCKey}, 1, oct(1777) );
105        if ( !shmctl( $Self->{IPCSHMKey}, 0, 0 ) ) {
106            $Self->Log(
107                Priority => 'error',
108                Message  => "Can't remove shm for log: $!",
109            );
110
111            # Continue without IPC.
112            return $Self;
113        }
114
115        # Re-initialize SHM segment.
116        $Self->{IPCSHMKey} = shmget( $Self->{IPCKey}, $Self->{IPCSize}, oct(1777) );
117    }
118
119    # Continue without IPC.
120    return $Self if !$Self->{IPCSHMKey};
121
122    # Only flag IPC as active if everything worked well.
123    $Self->{IPC} = 1;
124
125    return $Self;
126}
127
128=head2 Log()
129
130log something. log priorities are 'debug', 'info', 'notice' and 'error'.
131
132These are mapped to the SysLog priorities. Please use the appropriate priority level:
133
134=over
135
136=item debug
137
138Debug-level messages; info useful for debugging the application, not useful during operations.
139
140=item info
141
142Informational messages; normal operational messages - may be used for reporting etc, no action required.
143
144=item notice
145
146Normal but significant condition; events that are unusual but not error conditions, no immediate action required.
147
148=item error
149
150Error conditions. Non-urgent failures, should be relayed to developers or administrators, each item must be resolved.
151
152=back
153
154See for more info L<http://en.wikipedia.org/wiki/Syslog#Severity_levels>
155
156    $LogObject->Log(
157        Priority => 'error',
158        Message  => "Need something!",
159    );
160
161=cut
162
163sub Log {
164    my ( $Self, %Param ) = @_;
165
166    my $Priority    = lc $Param{Priority}  || 'debug';
167    my $PriorityNum = $LogLevel{$Priority} || $LogLevel{debug};
168
169    return 1 if $PriorityNum < $Self->{MinimumLevelNum};
170
171    my $Message = $Param{MSG}    || $Param{Message} || '???';
172    my $Caller  = $Param{Caller} || 0;
173
174    # returns the context of the current subroutine and sub-subroutine!
175    my ( $Package1, $Filename1, $Line1, $Subroutine1 ) = caller( $Caller + 0 );
176    my ( $Package2, $Filename2, $Line2, $Subroutine2 ) = caller( $Caller + 1 );
177
178    $Subroutine2 ||= $0;
179
180    # log backend
181    $Self->{Backend}->Log(
182        Priority  => $Priority,
183        Message   => $Message,
184        LogPrefix => $Self->{LogPrefix},
185        Module    => $Subroutine2,
186        Line      => $Line1,
187    );
188
189    my $DateTimeObject = $Kernel::OM->Create(
190        'Kernel::System::DateTime'
191    );
192    my $LogTime = $DateTimeObject->ToCTimeString();
193
194    # if error, write it to STDERR
195    if ( $Priority =~ /^error/i ) {
196
197        ## no critic
198        my $Error = sprintf "ERROR: $Self->{LogPrefix} Perl: %vd OS: $^O Time: "
199            . $LogTime . "\n\n", $^V;
200        ## use critic
201
202        $Error .= " Message: $Message\n\n";
203
204        if ( %ENV && ( $ENV{REMOTE_ADDR} || $ENV{REQUEST_URI} ) ) {
205
206            my $RemoteAddress = $ENV{REMOTE_ADDR} || '-';
207            my $RequestURI    = $ENV{REQUEST_URI} || '-';
208
209            $Error .= " RemoteAddress: $RemoteAddress\n";
210            $Error .= " RequestURI: $RequestURI\n\n";
211        }
212
213        $Error .= " Traceback ($$): \n";
214
215        COUNT:
216        for ( my $Count = 0; $Count < 30; $Count++ ) {
217
218            my ( $Package1, $Filename1, $Line1, $Subroutine1 ) = caller( $Caller + $Count );
219
220            last COUNT if !$Line1;
221
222            my ( $Package2, $Filename2, $Line2, $Subroutine2 ) = caller( $Caller + 1 + $Count );
223
224            # if there is no caller module use the file name
225            $Subroutine2 ||= $0;
226
227            # print line if upper caller module exists
228            my $VersionString = '';
229
230            eval { $VersionString = $Package1->VERSION || ''; };    ## no critic
231
232            # version is present
233            if ($VersionString) {
234                $VersionString = ' (v' . $VersionString . ')';
235            }
236
237            $Error .= "   Module: $Subroutine2$VersionString Line: $Line1\n";
238
239            last COUNT if !$Line2;
240        }
241
242        $Error .= "\n";
243        print STDERR $Error;
244
245        # store data (for the frontend)
246        $Self->{error}->{Message}   = $Message;
247        $Self->{error}->{Traceback} = $Error;
248    }
249
250    # remember to info and notice messages
251    elsif ( lc $Priority eq 'info' || lc $Priority eq 'notice' ) {
252        $Self->{ lc $Priority }->{Message} = $Message;
253    }
254
255    # write shm cache log
256    if ( lc $Priority ne 'debug' && $Self->{IPC} ) {
257
258        $Priority = lc $Priority;
259
260        my $Data   = $LogTime . ";;$Priority;;$Self->{LogPrefix};;$Message\n";    ## no critic
261        my $String = $Self->GetLog();
262
263        shmwrite( $Self->{IPCSHMKey}, $Data . $String, 0, $Self->{IPCSize} ) || die $!;
264    }
265
266    return 1;
267}
268
269=head2 GetLogEntry()
270
271to get the last log info back
272
273    my $Message = $LogObject->GetLogEntry(
274        Type => 'error', # error|info|notice
275        What => 'Message', # Message|Traceback
276    );
277
278=cut
279
280sub GetLogEntry {
281    my ( $Self, %Param ) = @_;
282
283    return $Self->{ lc $Param{Type} }->{ $Param{What} } || '';
284}
285
286=head2 GetLog()
287
288to get the tmp log data (from shared memory - ipc) in csv form
289
290    my $CSVLog = $LogObject->GetLog();
291
292=cut
293
294sub GetLog {
295    my ( $Self, %Param ) = @_;
296
297    my $String = '';
298    if ( $Self->{IPC} ) {
299        shmread( $Self->{IPCSHMKey}, $String, 0, $Self->{IPCSize} ) || die "$!";
300    }
301
302    # Remove \0 bytes that shmwrite adds for padding.
303    $String =~ s{\0}{}smxg;
304
305    # encode the string
306    $Kernel::OM->Get('Kernel::System::Encode')->EncodeInput( \$String );
307
308    return $String;
309}
310
311=head2 CleanUp()
312
313to clean up tmp log data from shared memory (ipc)
314
315    $LogObject->CleanUp();
316
317=cut
318
319sub CleanUp {
320    my ( $Self, %Param ) = @_;
321
322    return 1 if !$Self->{IPC};
323
324    shmwrite( $Self->{IPCSHMKey}, '', 0, $Self->{IPCSize} ) || die $!;
325
326    return 1;
327}
328
329=head2 Dumper()
330
331dump a perl variable to log
332
333    $LogObject->Dumper(@Array);
334
335    or
336
337    $LogObject->Dumper(%Hash);
338
339=cut
340
341sub Dumper {
342    my ( $Self, @Data ) = @_;
343
344    require Data::Dumper;    ## no critic
345
346    # returns the context of the current subroutine and sub-subroutine!
347    my ( $Package1, $Filename1, $Line1, $Subroutine1 ) = caller(0);
348    my ( $Package2, $Filename2, $Line2, $Subroutine2 ) = caller(1);
349
350    $Subroutine2 ||= $0;
351
352    # log backend
353    $Self->{Backend}->Log(
354        Priority  => 'debug',
355        Message   => substr( Data::Dumper::Dumper(@Data), 0, 600600600 ),    ## no critic
356        LogPrefix => $Self->{LogPrefix},
357        Module    => $Subroutine2,
358        Line      => $Line1,
359    );
360
361    return 1;
362}
363
3641;
365
366=head1 TERMS AND CONDITIONS
367
368This software is part of the OTRS project (L<https://otrs.org/>).
369
370This software comes with ABSOLUTELY NO WARRANTY. For details, see
371the enclosed file COPYING for license information (GPL). If you
372did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>.
373
374=cut
375