@@ -, +, @@ addition of the ip address and username ( if available ) prefixing the message. --- C4/SIP/ILS.pm | 2 +- C4/SIP/ILS/Item.pm | 2 +- C4/SIP/ILS/Patron.pm | 2 +- C4/SIP/ILS/Transaction/Checkout.pm | 2 +- C4/SIP/ILS/Transaction/RenewAll.pm | 2 +- C4/SIP/SIPServer.pm | 82 +++++++++++++++++++++++++++++- C4/SIP/Sip.pm | 20 ++++++-- C4/SIP/Sip/Configuration.pm | 4 +- C4/SIP/Sip/MsgType.pm | 1 - C4/SIP/Trapper.pm | 22 ++++++++ Koha/Logger.pm | 7 ++- etc/log4perl.conf | 16 ++++++ 12 files changed, 149 insertions(+), 13 deletions(-) create mode 100644 C4/SIP/Trapper.pm --- a/C4/SIP/ILS.pm +++ a/C4/SIP/ILS.pm @@ -6,7 +6,7 @@ package C4::SIP::ILS; use warnings; use strict; -use Sys::Syslog qw(syslog); +use C4::SIP::Sip qw(syslog); use Data::Dumper; use C4::SIP::ILS::Item; --- a/C4/SIP/ILS/Item.pm +++ a/C4/SIP/ILS/Item.pm @@ -9,7 +9,7 @@ package C4::SIP::ILS::Item; use strict; use warnings; -use Sys::Syslog qw(syslog); +use C4::SIP::Sip qw(syslog); use Carp; use Template; --- a/C4/SIP/ILS/Patron.pm +++ a/C4/SIP/ILS/Patron.pm @@ -12,7 +12,7 @@ use warnings; use Exporter; use Carp; -use Sys::Syslog qw(syslog); +use C4::SIP::Sip qw(syslog); use Data::Dumper; use C4::SIP::Sip qw(add_field); --- a/C4/SIP/ILS/Transaction/Checkout.pm +++ a/C4/SIP/ILS/Transaction/Checkout.pm @@ -8,7 +8,7 @@ use warnings; use strict; use POSIX qw(strftime); -use Sys::Syslog qw(syslog); +use C4::SIP::Sip qw(syslog); use Data::Dumper; use CGI qw ( -utf8 ); --- a/C4/SIP/ILS/Transaction/RenewAll.pm +++ a/C4/SIP/ILS/Transaction/RenewAll.pm @@ -6,7 +6,7 @@ package C4::SIP::ILS::Transaction::RenewAll; use strict; use warnings; -use Sys::Syslog qw(syslog); +use C4::SIP::Sip qw(syslog); use C4::SIP::ILS::Item; --- a/C4/SIP/SIPServer.pm +++ a/C4/SIP/SIPServer.pm @@ -5,19 +5,24 @@ use strict; use warnings; use FindBin qw($Bin); use lib "$Bin"; -use Sys::Syslog qw(syslog); use Net::Server::PreFork; use IO::Socket::INET; use Socket qw(:DEFAULT :crlf); +use Scalar::Util qw(blessed); require UNIVERSAL::require; use C4::Context; +use C4::SIP::Sip qw(syslog); use C4::SIP::Sip::Constants qw(:all); use C4::SIP::Sip::Configuration; use C4::SIP::Sip::Checksum qw(checksum verify_cksum); use C4::SIP::Sip::MsgType qw( handle login_core ); use Koha::Caches; +use Koha::Logger; +use C4::SIP::Trapper; +tie *STDERR, "C4::SIP::Trapper"; + use base qw(Net::Server::PreFork); use constant LOG_SIP => "local6"; # Local alias for the logging facility @@ -81,6 +86,9 @@ __PACKAGE__ ->run(@parms); # Child # +my $activeSIPServer; +my $activeLogger; + # process_request is the callback used by Net::Server to handle # an incoming connection request. @@ -95,6 +103,13 @@ sub process_request { # Flushing L1 to make sure the request will be processed using the correct data Koha::Caches->flush_L1_caches(); + $self->{account} = undef; # Clear out the account from the last request, it may be different + $self->{logger} = _set_logger( Koha::Logger->get( { interface => 'sip' } ) ); + + # Flush previous MDCs to prevent accidentally leaking incorrect MDC-entries + Log::Log4perl::MDC->put( "accountid", undef ); + Log::Log4perl::MDC->put( "peeraddr", undef ); + my $sockname = getsockname(STDIN); # Check if socket connection is IPv6 before resolving address @@ -160,6 +175,19 @@ sub raw_transport { } alarm 0; + $self->{logger} = _set_logger( + Koha::Logger->get( + { + interface => 'sip', + category => $self->{account}->{id}, # Add id to namespace + } + ) + ); + + # Set MDCs after properly authenticating + Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} ); + Log::Log4perl::MDC->put( "peeraddr", $self->{server}->{peeraddr} ); + syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", $self->{account}->{id}, $self->{account}->{institution}); @@ -397,6 +425,58 @@ sub get_timeout { } } +=head2 get_SIPServer + + my $sipServer = C4::SIP::SIPServer::get_SIPServer() + +@RETURNS C4::SIP::SIPServer, the current server's child-process used to handle this SIP-transaction + +=cut + +sub get_SIPServer { + unless($activeSIPServer) { + my @cc = caller(1); + die "$cc[3]() asks for \$activeSIPServer, but he is not defined yet"; + } + return $activeSIPServer; +} + +sub _set_SIPServer { + my ($sipServer) = @_; + unless (blessed($sipServer) && $sipServer->isa('C4::SIP::SIPServer')) { + my @cc = caller(0); + die "$cc[3]():> \$sipServer '$sipServer' is not a C4::SIP::SIPServer-object"; + } + $activeSIPServer = $sipServer; + return $activeSIPServer; +} + +=head2 get_logger + + my $logger = C4::SIP::SIPServer::get_logger() + +@RETURNS Koha::Logger, the logger used to log this SIP-transaction + +=cut + +sub get_logger { + unless($activeLogger) { + my @cc = caller(1); + die "$cc[3]() asks for \$activeLogger, but he is not defined yet"; + } + return $activeLogger; +} + +sub _set_logger { + my ($logger) = @_; + unless (blessed($logger) && $logger->isa('Koha::Logger')) { + my @cc = caller(0); + die "$cc[3]():> \$logger '$logger' is not a Koha::Logger-object"; + } + $activeLogger = $logger; + return $activeLogger; +} + 1; __END__ --- a/C4/SIP/Sip.pm +++ a/C4/SIP/Sip.pm @@ -8,7 +8,6 @@ use strict; use warnings; use Exporter; use Encode; -use Sys::Syslog qw(syslog); use POSIX qw(strftime); use Socket qw(:crlf); use IO::Handle; @@ -22,13 +21,13 @@ use base qw(Exporter); our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count denied sipbool boolspace write_msg $error_detection $protocol_version $field_delimiter - $last_response); + $last_response syslog); our %EXPORT_TAGS = ( all => [qw(y_or_n timestamp add_field maybe_add add_count denied sipbool boolspace write_msg $error_detection $protocol_version - $field_delimiter $last_response)]); + $field_delimiter $last_response syslog)]); our $error_detection = 0; our $protocol_version = 1; @@ -205,4 +204,19 @@ sub write_msg { $last_response = $msg; } +sub syslog { + my ( $level, $mask, @args ) = @_; + + my $method = + $level eq 'LOG_ERR' ? 'error' + : $level eq 'LOG_DEBUG' ? 'debug' + : $level eq 'LOG_INFO' ? 'info' + : $level eq 'LOG_WARNING' ? 'warn' + : 'error'; + + my $message = @args ? sprintf($mask, @args) : $mask; + + C4::SIP::SIPServer::get_logger()->$method($message); +} + 1; --- a/C4/SIP/Sip/Configuration.pm +++ a/C4/SIP/Sip/Configuration.pm @@ -10,6 +10,8 @@ use strict; use warnings; use XML::Simple qw(:strict); +use C4::SIP::Sip qw(syslog); + my $parser = new XML::Simple( KeyAttr => { login => '+id', @@ -63,7 +65,7 @@ sub find_service { my $portstr; foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) { $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto ); - Sys::Syslog::syslog( "LOG_DEBUG", + syslog( "LOG_DEBUG", "Configuration::find_service: Trying $portstr" ); last if ( exists( ( $self->{listeners} )->{$portstr} ) ); } --- a/C4/SIP/Sip/MsgType.pm +++ a/C4/SIP/Sip/MsgType.pm @@ -9,7 +9,6 @@ package C4::SIP::Sip::MsgType; use strict; use warnings; use Exporter; -use Sys::Syslog qw(syslog); use C4::SIP::Sip qw(:all); use C4::SIP::Sip::Constants qw(:all); --- a/C4/SIP/Trapper.pm +++ a/C4/SIP/Trapper.pm @@ -0,0 +1,22 @@ +package C4::SIP::Trapper; + +use Modern::Perl; + +use Koha::Logger; + +sub TIEHANDLE { + my $class = shift; + bless [], $class; +} + +sub PRINT { + my $self = shift; + $Log::Log4perl::caller_depth++; + my $logger = + Koha::Logger->get( { interface => 'sip', category => 'STDERR' } ); + warn @_; + $logger->error(@_); + $Log::Log4perl::caller_depth--; +} + +1; --- a/Koha/Logger.pm +++ a/Koha/Logger.pm @@ -159,11 +159,14 @@ sub _check_conf { # check logfiles in log4perl config (at initialization) if ( $l =~ /(OPAC|INTRANET)\.filename\s*=\s*(.*)\s*$/i ) { # we only check the two default logfiles, skipping additional ones - return if !-w $2; + if ( !-w $2 ) { + warn "Log file $2 is not writable!"; + return; + }; push @logs, $1 . ':' . $2; } } - return if !@logs; # we should find one + return unless @logs; # we should find one return \@logs; } --- a/etc/log4perl.conf +++ a/etc/log4perl.conf @@ -2,6 +2,9 @@ log4perl.logger.intranet = WARN, INTRANET log4perl.appender.INTRANET=Log::Log4perl::Appender::File log4perl.appender.INTRANET.filename=__LOG_DIR__/intranet-error.log log4perl.appender.INTRANET.mode=append +log4perl.appender.INTRANET.create_at_logtime=true +log4perl.appender.INTRANET.syswrite=true +log4perl.appender.INTRANET.recreate=true log4perl.appender.INTRANET.layout=PatternLayout log4perl.appender.INTRANET.layout.ConversionPattern=[%d] [%p] %m %l %n @@ -9,6 +12,9 @@ log4perl.logger.opac = WARN, OPAC log4perl.appender.OPAC=Log::Log4perl::Appender::File log4perl.appender.OPAC.filename=__LOG_DIR__/opac-error.log log4perl.appender.OPAC.mode=append +log4perl.appender.OPAC.create_at_logtime=true +log4perl.appender.OPAC.syswrite=true +log4perl.appender.OPAC.recreate=true log4perl.appender.OPAC.layout=PatternLayout log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n @@ -18,3 +24,13 @@ log4perl.appender.Z3950.filename=__LOG_DIR__/z3950-error.log log4perl.appender.Z3950.mode=append log4perl.appender.Z3950.layout=PatternLayout log4perl.appender.Z3950.layout.ConversionPattern=[%d] [%p] %m %l %n + +log4perl.logger.sip = DEBUG, SIP +log4perl.appender.SIP=Log::Log4perl::Appender::File +log4perl.appender.SIP.filename=__LOG_DIR__/sip2.log +log4perl.appender.SIP.mode=append +log4perl.appender.SIP.create_at_logtime=true +log4perl.appender.SIP.syswrite=true +log4perl.appender.SIP.recreate=true +log4perl.appender.SIP.layout=PatternLayout +log4perl.appender.SIP.layout.ConversionPattern=[%d] [%p] %X{accountid}@%X{peeraddr}: %m %l %n --