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