From 10b085fb1c69c711af6de3942d70f6b39a7c255b Mon Sep 17 00:00:00 2001 From: Kyle M Hall Date: Thu, 12 Nov 2015 19:28:37 +0000 Subject: [PATCH] Bug 15253 - Add Koha::Logger based logging for SIP2 Now that we have Koha::Logger, we should use it in our SIP server. This has the potential to make debugging SIP issue much easier. We should add the userid for the sipser to the namespace so we can allow for separate files per sip user if wanted. Test Plan: 1) Apply this patch set 2) Add the following to your log4perl.conf: log4perl.logger.sip = DEBUG, SIP log4perl.appender.SIP = Log::Dispatch::Syslog log4perl.appender.SIP.min_level = debug log4perl.appender.SIP.ident = koha_sip log4perl.appender.SIP.facility = local6 log4perl.appender.SIP.layout=PatternLayout log4perl.appender.SIP.layout.ConversionPattern=[%d] [%p] %m %l %n 3) Restart your sip server 4) Tail your syslog, run some queries 5) Note you still get the same output messages as before, with the addition of the ip address and username ( if available ) prefixing the message. --- C4/SIP/ILS.pm | 69 ++++++++++++-------- C4/SIP/ILS/Item.pm | 6 +- C4/SIP/ILS/Patron.pm | 9 ++- C4/SIP/ILS/Transaction/Checkout.pm | 6 +- C4/SIP/ILS/Transaction/RenewAll.pm | 5 +- C4/SIP/SIPServer.pm | 123 ++++++++++++++++++++++++------------ C4/SIP/Sip.pm | 36 +++++++++-- C4/SIP/Sip/Configuration.pm | 2 + C4/SIP/Sip/MsgType.pm | 112 +++++++++++++++++++++----------- etc/log4perl.conf | 8 +++ 10 files changed, 261 insertions(+), 115 deletions(-) diff --git a/C4/SIP/ILS.pm b/C4/SIP/ILS.pm index 7d702b7..61058df 100644 --- a/C4/SIP/ILS.pm +++ b/C4/SIP/ILS.pm @@ -43,25 +43,27 @@ my %supports = ( ); sub new { - my ($class, $institution) = @_; + my ($class, $institution, $account, $server) = @_; my $type = ref($class) || $class; my $self = {}; - $debug and warn "new ILS: INSTITUTION: " . Dumper($institution); + $debug and warn "new ILS: INSTITUTION: " . Dumper($institution); + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS $institution->{id}"); syslog("LOG_DEBUG", "new ILS '%s'", $institution->{id}); $self->{institution} = $institution; + $self->{server} = $server; return bless $self, $type; } sub find_patron { my $self = shift; $debug and warn "ILS: finding patron"; - return C4::SIP::ILS::Patron->new(@_); + return C4::SIP::ILS::Patron->new( @_, $self->{server} ); } sub find_item { my $self = shift; $debug and warn "ILS: finding item"; - return C4::SIP::ILS::Item->new(@_); + return C4::SIP::ILS::Item->new(@_, $self->{server}); } sub institution { @@ -82,6 +84,7 @@ sub supports { sub check_inst_id { my ($self, $id, $whence) = @_; if ($id ne $self->{institution}->{id}) { + $self->{server}->{logger}->warn("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: $whence: received institution '$id', expected '$self->{institution}->{id}'"); syslog("LOG_WARNING", "%s: received institution '%s', expected '%s'", $whence, $id, $self->{institution}->{id}); # Just an FYI check, we don't expect the user to change location from that in SIPconfig.xml } @@ -129,10 +132,10 @@ sub checkout { my ($self, $patron_id, $item_id, $sc_renew, $fee_ack) = @_; my ($patron, $item, $circ); - $circ = C4::SIP::ILS::Transaction::Checkout->new(); + $circ = C4::SIP::ILS::Transaction::Checkout->new( $self->{server} ); # BEGIN TRANSACTION - $circ->patron($patron = C4::SIP::ILS::Patron->new( $patron_id)); - $circ->item($item = C4::SIP::ILS::Item->new( $item_id)); + $circ->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) ); + $circ->item( $item = C4::SIP::ILS::Item->new( $item_id, $self->{server} ) ); if ($fee_ack) { $circ->fee_ack($fee_ack); } @@ -162,10 +165,12 @@ sub checkout { push(@{$patron->{items}}, $item_id); $circ->desensitize(!$item->magnetic_media); + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::Checkout: patron $patron_id has checked out " . join(', ', @{$patron->{items}}) ); syslog("LOG_DEBUG", "ILS::Checkout: patron %s has checked out %s", $patron_id, join(', ', @{$patron->{items}})); } else { + $self->{server}->{logger}->error("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::Checkout Issue failed"); syslog("LOG_ERR", "ILS::Checkout Issue failed"); } } @@ -181,7 +186,7 @@ sub checkin { $circ = C4::SIP::ILS::Transaction::Checkin->new(); # BEGIN TRANSACTION - $circ->item( $item = C4::SIP::ILS::Item->new($item_id) ); + $circ->item( $item = C4::SIP::ILS::Item->new( $item_id, $self->{server} ) ); if ($item) { $circ->do_checkin( $current_loc, $return_date ); @@ -195,21 +200,22 @@ sub checkin { # It's ok to check it in if it exists, and if it was checked out # or it was not checked out but the checked_in_ok flag was set $circ->ok( ( $checked_in_ok && $item ) || ( $item && $item->{patron} ) ); + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: C4::SIP::ILS::checkin - using checked_in_ok") if $checked_in_ok; syslog("LOG_DEBUG", "C4::SIP::ILS::checkin - using checked_in_ok") if $checked_in_ok; if ( !defined( $item->{patron} ) ) { $circ->screen_msg("Item not checked out") unless $checked_in_ok; - syslog("LOG_DEBUG", "C4::SIP::ILS::checkin - item not checked out"); + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: C4::SIP::ILS::checkin - item not checked out"); + syslog("LOG_DEBUG", "C4::SIP::ILS::checkin - item not checked out"); } else { if ( $circ->ok ) { - $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron} ) ); + $circ->patron( $patron = C4::SIP::ILS::Patron->new( $item->{patron}, $self->{server} ) ); delete $item->{patron}; delete $item->{due_date}; $patron->{items} = [ grep { $_ ne $item_id } @{ $patron->{items} } ]; } } - # END TRANSACTION return $circ; @@ -234,7 +240,7 @@ sub pay_fee { $trans->transaction_id($trans_id); my $patron; - $trans->patron($patron = C4::SIP::ILS::Patron->new($patron_id)); + $trans->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) ); if (!$patron) { $trans->screen_msg('Invalid patron barcode.'); return $trans; @@ -252,17 +258,18 @@ sub add_hold { my $trans = C4::SIP::ILS::Transaction::Hold->new(); - $patron = C4::SIP::ILS::Patron->new( $patron_id); + $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ); if (!$patron || (defined($patron_pwd) && !$patron->check_password($patron_pwd))) { $trans->screen_msg("Invalid Patron."); return $trans; } - unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) { - $trans->screen_msg("No such item."); - return $trans; - } + my $id = $item_id || $title_id; + unless ($item = C4::SIP::ILS::Item->new( $id, $self->{server} ) ) { + $trans->screen_msg("No such item."); + return $trans; + } if ( $patron->holds_blocked_by_excessive_fees() ) { $trans->screen_msg("Excessive fees blocking placement of hold."); @@ -299,7 +306,7 @@ sub cancel_hold { my $trans = C4::SIP::ILS::Transaction::Hold->new(); - $patron = C4::SIP::ILS::Patron->new( $patron_id ); + $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ); if (!$patron) { $trans->screen_msg("Invalid patron barcode."); return $trans; @@ -308,9 +315,10 @@ sub cancel_hold { return $trans; } - unless ($item = C4::SIP::ILS::Item->new($item_id || $title_id)) { - $trans->screen_msg("No such item."); - return $trans; + my $id = $item_id || $title_id; + unless ( $item = C4::SIP::ILS::Item->new( $id, $self->{server} ) ) { + $trans->screen_msg("No such item."); + return $trans; } $trans->patron($patron); @@ -358,7 +366,7 @@ sub alter_hold { $trans = C4::SIP::ILS::Transaction::Hold->new(); # BEGIN TRANSACTION - $patron = C4::SIP::ILS::Patron->new( $patron_id ); + $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ); unless ($patron) { $trans->screen_msg("Invalid patron barcode: '$patron_id'."); return $trans; @@ -376,7 +384,7 @@ sub alter_hold { # $trans->ok(1); $trans->screen_msg("Hold updated."); $trans->patron($patron); - $trans->item(C4::SIP::ILS::Item->new( $hold->{item_id})); + $trans->item( C4::SIP::ILS::Item->new( $hold->{item_id}, $self->{server} ) ); last; } } @@ -401,7 +409,7 @@ sub renew { my $trans; $trans = C4::SIP::ILS::Transaction::Renew->new(); - $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id )); + $trans->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) ); if (!$patron) { $trans->screen_msg("Invalid patron barcode."); @@ -425,13 +433,18 @@ sub renew { my $count = scalar @{$patron->{items}}; foreach my $i (@{$patron->{items}}) { unless (defined $i->{barcode}) { # FIXME: using data instead of objects may violate the abstraction layer + $self->{server}->{logger}->error("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: No barcode for item " . $j+1 . " of $count: $item_id"); syslog("LOG_ERR", "No barcode for item %s of %s: $item_id", $j+1, $count); next; } + $self->{server}->{logger}->debug( "$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: " + . "checking item " + . $j + 1 + . " of $count: $item_id vs. $i->{barcode} " ); syslog("LOG_DEBUG", "checking item %s of %s: $item_id vs. %s", ++$j, $count, $i->{barcode}); if ($i->{barcode} eq $item_id) { # We have it checked out - $item = C4::SIP::ILS::Item->new( $item_id ); + $item = C4::SIP::ILS::Item->new( $item_id, $self->{server} ); last; } } @@ -458,12 +471,14 @@ sub renew_all { my ($patron, $item_id); my $trans; - $trans = C4::SIP::ILS::Transaction::RenewAll->new(); + $trans = C4::SIP::ILS::Transaction::RenewAll->new( $self->{server} ); - $trans->patron($patron = C4::SIP::ILS::Patron->new( $patron_id )); + $trans->patron( $patron = C4::SIP::ILS::Patron->new( $patron_id, $self->{server} ) ); if (defined $patron) { + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::renew_all: patron '$patron->name': renew_ok: $patron->renew_ok"); syslog("LOG_DEBUG", "ILS::renew_all: patron '%s': renew_ok: %s", $patron->name, $patron->renew_ok); } else { + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::renew_all: Invalid patron id: '$patron_id'"); syslog("LOG_DEBUG", "ILS::renew_all: Invalid patron id: '%s'", $patron_id); } diff --git a/C4/SIP/ILS/Item.pm b/C4/SIP/ILS/Item.pm index 4586fee..2ae11bf 100644 --- a/C4/SIP/ILS/Item.pm +++ b/C4/SIP/ILS/Item.pm @@ -73,12 +73,13 @@ sub priority_sort { } sub new { - my ($class, $item_id) = @_; + my ( $class, $item_id, $server ) = @_; my $type = ref($class) || $class; my $self; my $itemnumber = GetItemnumberFromBarcode($item_id); my $item = GetBiblioFromItemNumber($itemnumber); # actually biblio.*, biblioitems.* AND items.* (overkill) if (! $item) { + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS::Item('$item_id'): not found"); syslog("LOG_DEBUG", "new ILS::Item('%s'): not found", $item_id); warn "new ILS::Item($item_id) : No item '$item_id'."; return; @@ -105,8 +106,10 @@ sub new { $item->{hold_shelf} = [( grep { defined $_->{found} and $_->{found} eq 'W' } @{$item->{hold_queue}} )]; $item->{pending_queue} = [( grep {(! defined $_->{found}) or $_->{found} ne 'W' } @{$item->{hold_queue}} )]; $self = $item; + $self->{server} = $server; bless $self, $type; + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS::Item('$item_id'): found with title '$self->{title}'"); syslog("LOG_DEBUG", "new ILS::Item('%s'): found with title '%s'", $item_id, $self->{title}); @@ -170,6 +173,7 @@ sub hold_patron_name { my $borrowernumber = (@_ ? shift: $self->hold_patron_id()) or return; my $holder = GetMember(borrowernumber=>$borrowernumber); unless ($holder) { + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: While checking hold, GetMember failed for borrowernumber '$borrowernumber'"); syslog("LOG_ERR", "While checking hold, GetMember failed for borrowernumber '$borrowernumber'"); return; } diff --git a/C4/SIP/ILS/Patron.pm b/C4/SIP/ILS/Patron.pm index 4e9c152..2d6057f 100644 --- a/C4/SIP/ILS/Patron.pm +++ b/C4/SIP/ILS/Patron.pm @@ -29,12 +29,14 @@ our $VERSION = 3.07.00.049; our $kp; # koha patron sub new { - my ($class, $patron_id) = @_; + my ($class, $patron_id, $server) = @_; my $type = ref($class) || $class; my $self; + $kp = GetMember(cardnumber=>$patron_id) || GetMember(userid=>$patron_id); $debug and warn "new Patron (GetMember): " . Dumper($kp); unless (defined $kp) { + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: new ILS::Patron($patron_id): no such patron"); syslog("LOG_DEBUG", "new ILS::Patron(%s): no such patron", $patron_id); return; } @@ -121,7 +123,9 @@ sub new { $ilspatron{unavail_holds} = _get_outstanding_holds($kp->{borrowernumber}); $ilspatron{items} = GetPendingIssues($kp->{borrowernumber}); $self = \%ilspatron; + $self->{server} = $server; $debug and warn Dumper($self); + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: new ILS::Patron($patron_id): found patron '$self->{id}'"); syslog("LOG_DEBUG", "new ILS::Patron(%s): found patron '%s'", $patron_id,$self->{id}); bless $self, $type; return $self; @@ -322,6 +326,9 @@ sub enable { foreach my $field ('charge_ok', 'renew_ok', 'recall_ok', 'hold_ok', 'inet') { $self->{$field} = 1; } + $self->{server}->{logger}->debug( "$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: " + . "Patron($self->{id})->enable: charge: $self->{charge_ok}, " + . "renew:$self->{renew_ok}, recall:$self->{recall_ok}, hold:$self->{hold_ok}" ); syslog("LOG_DEBUG", "Patron(%s)->enable: charge: %s, renew:%s, recall:%s, hold:%s", $self->{id}, $self->{charge_ok}, $self->{renew_ok}, $self->{recall_ok}, $self->{hold_ok}); diff --git a/C4/SIP/ILS/Transaction/Checkout.pm b/C4/SIP/ILS/Transaction/Checkout.pm index 0ac0bfc..91430c4 100644 --- a/C4/SIP/ILS/Transaction/Checkout.pm +++ b/C4/SIP/ILS/Transaction/Checkout.pm @@ -35,8 +35,9 @@ my %fields = ( ); sub new { - my $class = shift;; + my ( $class, $server ) = @_; my $self = $class->SUPER::new(); + $self->{server} = $server; foreach my $element (keys %fields) { $self->{_permitted}->{$element} = $fields{$element}; } @@ -48,6 +49,7 @@ sub new { sub do_checkout { my $self = shift; + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: ILS::Transaction::Checkout performing checkout..."); syslog('LOG_DEBUG', "ILS::Transaction::Checkout performing checkout..."); my $pending = $self->{item}->pending_queue; my $shelf = $self->{item}->hold_shelf; @@ -99,7 +101,7 @@ sub do_checkout { } else { $self->screen_msg($needsconfirmation->{$confirmation}); $noerror = 0; - syslog('LOG_DEBUG', "Blocking checkout Reason:$confirmation"); + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: Blocking checkout Reason:$confirmation"); } } } diff --git a/C4/SIP/ILS/Transaction/RenewAll.pm b/C4/SIP/ILS/Transaction/RenewAll.pm index 845a509..c4fb5a6 100644 --- a/C4/SIP/ILS/Transaction/RenewAll.pm +++ b/C4/SIP/ILS/Transaction/RenewAll.pm @@ -7,7 +7,6 @@ use strict; use warnings; use Sys::Syslog qw(syslog); - use C4::SIP::ILS::Item; use C4::Members qw( GetMember ); @@ -21,6 +20,7 @@ my %fields = ( sub new { my $class = shift; + my $server = shift; my $self = $class->SUPER::new(); foreach my $element ( keys %fields ) { @@ -28,6 +28,8 @@ sub new { } @{$self}{ keys %fields } = values %fields; + + $self->{server} = $server; return bless $self, $class; } @@ -42,6 +44,7 @@ sub do_renew_all { my $item_id = $itemx->{barcode}; my $item = C4::SIP::ILS::Item->new($item_id); if ( !defined($item) ) { + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$self->{server}->{account}->{id}: renew_all: Invalid item id '$item_id' associated with patron '$patron->id'"); syslog( 'LOG_WARNING', q|renew_all: Invalid item id '%s' associated with patron '%s'|, diff --git a/C4/SIP/SIPServer.pm b/C4/SIP/SIPServer.pm index 8722ab6..c552a68 100755 --- a/C4/SIP/SIPServer.pm +++ b/C4/SIP/SIPServer.pm @@ -6,6 +6,7 @@ use warnings; use FindBin qw($Bin); use lib "$Bin"; use Sys::Syslog qw(syslog); +use Koha::Logger; use Net::Server::PreFork; use IO::Socket::INET; use Socket qw(:DEFAULT :crlf); @@ -17,6 +18,8 @@ use C4::SIP::Sip::Checksum qw(checksum verify_cksum); use C4::SIP::Sip::MsgType qw( handle login_core ); use C4::SIP::Sip qw( read_SIP_packet ); +use Koha::Logger; + use base qw(Net::Server::PreFork); use constant LOG_SIP => "local6"; # Local alias for the logging facility @@ -88,6 +91,9 @@ sub process_request { $self->{config} = $config; + $self->{logger} = Koha::Logger->get({ interface => 'sip' }); + $self->{account} = undef; # Clear out the account from the last request, it may be different + my $sockname = getsockname(STDIN); # Check if socket connection is IPv6 before resolving address @@ -104,6 +110,7 @@ sub process_request { $self->{service} = $config->find_service($sockaddr, $port, $proto); if (!defined($self->{service})) { + $self->{logger}->error("$self->{server}->{peeraddr}: process_request: Unknown recognized server connection: $sockaddr:$port/$proto"); syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); die "process_request: Bad server connection"; } @@ -111,6 +118,7 @@ sub process_request { $transport = $transports{$self->{service}->{transport}}; if (!defined($transport)) { + $self->{logger}->warn("$self->{server}->{peeraddr}: Unknown transport '$service->{transport}', dropping"); syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport}); return; } else { @@ -129,10 +137,15 @@ sub raw_transport { while (!$self->{account}) { local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; + + $self->{logger}->debug("$self->{server}->{peeraddr}: raw_transport: timeout is $service->{timeout}"); syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); + + $C4::SIP::Sip::server = $self; $input = read_SIP_packet(*STDIN); if (!$input) { # EOF on the socket + $self->{logger}->info("$self->{server}->{peeraddr}: raw_transport: shutting down: EOF during login"); syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); return; } @@ -140,36 +153,48 @@ sub raw_transport { last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN); } - syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", - $self->{account}->{id}, - $self->{account}->{institution}); + $self->{logger} = Koha::Logger->get( { interface => 'sip', category => $self->{account}->{id} } ); # Add id to namespace + $self->{logger}->debug("$self->{server}->{peeraddr}:$self->{account}->{id}: raw_transport: uname/inst: '$self->{account}->{id}/$self->{account}->{institution}'"); + syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", $self->{account}->{id}, $self->{account}->{institution}); $self->sip_protocol_loop(); + + $self->{logger}->info("$self->{server}->{peeraddr}:$self->{account}->{id}: raw_transport: shutting down"); syslog("LOG_INFO", "raw_transport: shutting down"); } sub get_clean_string { - my $string = shift; - if (defined $string) { - syslog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string); - chomp($string); - $string =~ s/^[^A-z0-9]+//; - $string =~ s/[^A-z0-9]+$//; - syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string); - } else { - syslog("LOG_INFO", "get_clean_string called on undefined"); - } - return $string; + my $self = shift; + my $string = shift; + if ( defined $string ) { + $self->{logger}->debug( "$self->{server}->{peeraddr}: get_clean_string pre-clean(length " . length($string) . "): $string" ); + syslog( "LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string ); + + chomp($string); + $string =~ s/^[^A-z0-9]+//; + $string =~ s/[^A-z0-9]+$//; + + $self->{logger}->debug( "$self->{server}->{peeraddr}: get_clean_string post-clean(length " . length($string) . "): $string)" ); + syslog( "LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string ); + } + else { + $self->{logger}->info("$self->{server}->{peeraddr}: get_clean_string called on undefined"); + syslog( "LOG_INFO", "get_clean_string called on undefined" ); + } + return $string; } +# looks like this sub is no longer used sub get_clean_input { - local $/ = "\012"; - my $in = ; - $in = get_clean_string($in); - while (my $extra = ){ - syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra); - } - return $in; + local $/ = "\012"; + my $in = ; + $in = get_clean_string($in); + + while ( my $extra = ) { + syslog( "LOG_ERR", "get_clean_input got extra lines: %s", $extra ); + } + + return $in; } sub telnet_transport { @@ -179,8 +204,10 @@ sub telnet_transport { my $account = undef; my $input; my $config = $self->{config}; - my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; - syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout); + my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; + + $self->{logger}->debug("$self->{server}->{peeraddr}: telnet_transport: timeout is $timeout"); + syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout); eval { local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; @@ -199,10 +226,12 @@ sub telnet_transport { $pwd = ; alarm 0; - syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd)); - $uid = get_clean_string ($uid); - $pwd = get_clean_string ($pwd); - syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd)); + $self->{logger}->debug( "$self->{server}->{peeraddr}: telnet_transport 1: uid length " . length($uid) . ", pwd length " . length($pwd) ); + syslog( "LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd) ); + $uid = $self->get_clean_string($uid); + $pwd = $self->get_clean_string($pwd); + $self->{logger}->debug( "$self->{server}->{peeraddr}: telnet_transport 2: uid length " . length($uid) . ", pwd length " . length($pwd) ); + syslog( "LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd) ); if (exists ($config->{accounts}->{$uid}) && ($pwd eq $config->{accounts}->{$uid}->{password})) { @@ -211,24 +240,32 @@ sub telnet_transport { last; } } + $self->{logger}->warn("$self->{server}->{peeraddr}: Invalid login attempt: ' . ($uid||'') . '"); syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||'')); print("Invalid login$CRLF"); } }; # End of eval if ($@) { - syslog("LOG_ERR", "telnet_transport: Login timed out"); - die "Telnet Login Timed out"; - } elsif (!defined($account)) { - syslog("LOG_ERR", "telnet_transport: Login Failed"); - die "Login Failure"; - } else { - print "Login OK. Initiating SIP$CRLF"; + $self->{logger}->error("$self->{server}->{peeraddr}: telnet_transport: Login timed out"); + syslog( "LOG_ERR", "telnet_transport: Login timed out" ); + die "Telnet Login Timed out"; + } + elsif ( !defined($account) ) { + $self->{logger}->error("$self->{server}->{peeraddr}: telnet_transport: Login Failed"); + syslog( "LOG_ERR", "telnet_transport: Login Failed" ); + die "Login Failure"; + } + else { + print "Login OK. Initiating SIP$CRLF"; } $self->{account} = $account; + $self->{logger} = Koha::Logger->get( { interface => 'sip', category => $self->{account}->{id} } ); # Add id to namespace + $self->{logger}->debug("$self->{server}->{peeraddr}:$self->{account}->{id}: telnet_transport: uname/inst: '$account->{id}/$account->{institution}'"); syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); $self->sip_protocol_loop(); + $self->{logger}->info("$self->{server}->{peeraddr}:$self->{account}->{id}: telnet_transport: shutting down"); syslog("LOG_INFO", "telnet_transport: shutting down"); } @@ -262,6 +299,7 @@ sub sip_protocol_loop { my $expect = ''; while (1) { alarm $timeout; + $C4::SIP::Sip::server = $self; $input = read_SIP_packet(*STDIN); unless ($input) { return; # EOF @@ -271,20 +309,23 @@ sub sip_protocol_loop { $input =~ s/[^A-z0-9]+$//s; # Same on the end, should get DOSsy ^M line-endings too. while (chomp($input)) {warn "Extra line ending on input";} unless ($input) { + $self->{logger}->error("$self->{server}->{peeraddr}:$self->{account}->{id}: sip_protocol_loop: empty input skipped"); syslog("LOG_ERR", "sip_protocol_loop: empty input skipped"); print("96$CR"); next; } # end cheap input hacks my $status = handle($input, $self, $expect); - if (!$status) { - syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2)); - } + if ( !$status ) { + $self->{logger}->error( "$self->{server}->{peeraddr}:$self->{account}->{id}: sip_protocol_loop: failed to handle " . substr( $input, 0, 2 ) ); + syslog( "LOG_ERR", "sip_protocol_loop: failed to handle %s", substr( $input, 0, 2 ) ); + } next if $status eq REQUEST_ACS_RESEND; - if ($expect && ($status ne $expect)) { - # We received a non-"RESEND" that wasn't what we were expecting. - syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input); - } + if ( $expect && ( $status ne $expect ) ) { + # We received a non-"RESEND" that wasn't what we were expecting. + $self->{logger}->error("$self->{server}->{peeraddr}:$self->{account}->{id}: sip_protocol_loop: expected $expect, received $input, exiting"); + syslog( "LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input ); + } # We successfully received and processed what we were expecting $expect = ''; alarm 0; diff --git a/C4/SIP/Sip.pm b/C4/SIP/Sip.pm index 29aa6a2..ea678a5 100644 --- a/C4/SIP/Sip.pm +++ b/C4/SIP/Sip.pm @@ -47,6 +47,9 @@ our $field_delimiter = '|'; # Protocol Default our $last_response = ''; +# We need to have the server to do logging +our $server = undef; + sub timestamp { my $time = $_[0] || time(); if ( ref $time eq 'DateTime') { @@ -67,8 +70,9 @@ sub add_field { my ($i, $ent); if (!defined($value)) { - syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'", - $field_id); + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: add_field: Undefined value being added to '$field_id'"); + syslog("LOG_DEBUG", "add_field: Undefined value being added to '%s'", + $field_id); $value = ''; } $value=~s/\r/ /g; # CR terminates a sip message @@ -122,6 +126,7 @@ sub add_count { $count = sprintf("%04d", $count); if (length($count) != 4) { + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_patron_info: $label wrong size: '$count'"); syslog("LOG_WARNING", "handle_patron_info: %s wrong size: '%s'", $label, $count); $count = ' ' x 4; @@ -162,7 +167,11 @@ sub boolspace { # sub read_SIP_packet { my $record; - my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!"); + my $fh; + unless ( $fh = shift ) { + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet: no filehandle argument!"); + syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!"); + } my $len1 = 999; # local $/ = "\r"; # don't need any of these here. use whatever the prevailing $/ is. @@ -173,6 +182,7 @@ sub read_SIP_packet { if ( defined($record) ) { while ( chomp($record) ) { 1; } $len1 = length($record); + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet, INPUT MSG: '$record'"); syslog( "LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'" ); $record =~ s/^\s*[^A-z0-9]+//s; # Every line must start with a "real" character. Not whitespace, control chars, etc. $record =~ s/[^A-z0-9]+$//s; # Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| @@ -186,9 +196,19 @@ sub read_SIP_packet { } if ($record) { my $len2 = length($record); - syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record; - ($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2); + if ( $record ) { + $server->{logger}->info("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet, INPUT MSG: '$record'"); + syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'"); + } + if ($len1 != $len2) { + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: read_SIP_packet, trimmed " . $len1-$len2 . " character(s) (after chomps)."); + syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2); + } } else { + $server->{logger}->debug( "$server->{server}->{peeraddr}:$server->{account}->{id}: " + . "read_SIP_packet input " + . ( defined($record) ? "empty ($record)" : 'undefined' ) + . ", end of input." ); syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record) ? "empty ($record)" : 'undefined')); } # @@ -204,7 +224,10 @@ sub read_SIP_packet { # # This is now handled by the vigorous cleansing above. # syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record; - syslog("LOG_INFO", "INPUT MSG: '$record'") if $record; + if ( $record ) { + $server->{logger}->debug( "$server->{server}->{peeraddr}:$server->{account}->{id}: INPUT MSG: '$record'" ); + syslog("LOG_INFO", "INPUT MSG: '$record'"); + } return $record; } @@ -246,6 +269,7 @@ sub write_msg { } else { STDOUT->autoflush(1); print $msg, $terminator; + $server->{logger}->info( "$server->{server}->{peeraddr}:$server->{account}->{id}: OUTPUT MSG: '$msg'"); syslog("LOG_INFO", "OUTPUT MSG: '$msg'"); } diff --git a/C4/SIP/Sip/Configuration.pm b/C4/SIP/Sip/Configuration.pm index 2b7bdca..8450fcc 100644 --- a/C4/SIP/Sip/Configuration.pm +++ b/C4/SIP/Sip/Configuration.pm @@ -60,9 +60,11 @@ sub accounts { sub find_service { my ( $self, $sockaddr, $port, $proto ) = @_; + my $logger = Koha::Logger->get({ interface => 'sip' }); my $portstr; foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) { $portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto ); + $logger->debug("Configuration::find_service: Trying $portstr"); Sys::Syslog::syslog( "LOG_DEBUG", "Configuration::find_service: Trying $portstr" ); last if ( exists( ( $self->{listeners} )->{$portstr} ) ); diff --git a/C4/SIP/Sip/MsgType.pm b/C4/SIP/Sip/MsgType.pm index 1e06a19..a2b9440 100644 --- a/C4/SIP/Sip/MsgType.pm +++ b/C4/SIP/Sip/MsgType.pm @@ -276,7 +276,7 @@ foreach my $i (keys(%handlers)) { } sub new { - my ($class, $msg, $seqno) = @_; + my ($class, $msg, $seqno, $server) = @_; my $self = {}; my $msgtag = substr($msg, 0, 2); @@ -287,14 +287,18 @@ sub new { # it's using the 2.00 login process, so it must support 2.00. $protocol_version = 2; } + my $id = $server->{account} ? $server->{account}->{id} . ':' : q{}; + $server->{logger}->debug( "$server->{server}->{peeraddr}:$id Sip::MsgType::new('$class', '" . substr($msg, 0, 10) + . "...', '$msgtag'): seq.no '$seqno', protocol $protocol_version" ); syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s", $class, substr($msg, 0, 10), $msgtag, $seqno, $protocol_version); - # warn "SIP PROTOCOL: $protocol_version"; if (!exists($handlers{$msgtag})) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$id new Sip::MsgType: Skipping message of unknown type '$msgtag' in '$msg'"); syslog("LOG_WARNING", "new Sip::MsgType: Skipping message of unknown type '%s' in '%s'", $msgtag, $msg); return; } elsif (!exists($handlers{$msgtag}->{protocol}->{$protocol_version})) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$id new Sip::MsgType: Skipping message '$msgtag' unsupported by protocol rev. '$protocol_version'"); syslog("LOG_WARNING", "new Sip::MsgType: Skipping message '%s' unsupported by protocol rev. '%d'", $msgtag, $protocol_version); return; @@ -302,6 +306,7 @@ sub new { bless $self, $class; + $self->{server} = $server; $self->{seqno} = $seqno; $self->_initialize(substr($msg,2), $handlers{$msgtag}); @@ -328,6 +333,8 @@ sub _initialize { $self->{fields}->{$field} = undef; } + my $id = $self->{server}->{account} ? $self->{server}->{account}->{id} . ':' : q{}; + $self->{server}->{logger}->debug("$self->{server}->{server}->{peeraddr}:$id Sip::MsgType::_initialize('$self->{name}', '$msg', '$proto->{template}', '$proto->{template_len}', ...)"); syslog("LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s', '%s', '%s', ...)", $self->{name}, $msg, $proto->{template}, $proto->{template_len}); @@ -339,9 +346,11 @@ sub _initialize { $fn = substr($field, 0, 2); if (!exists($self->{fields}->{$fn})) { + $self->{server}->{logger}->warn("$self->{server}->{server}->{peeraddr}:$id: Unsupported field '$fn' in $self->{name}, message '$msg'"); syslog("LOG_WARNING", "Unsupported field '%s' in %s message '%s'", $fn, $self->{name}, $msg); } elsif (defined($self->{fields}->{$fn})) { + $self->{server}->{logger}->warn("$self->{server}->{server}->{peeraddr}:$id: Duplicate field '$fn' (previous value '$self->{fields}->{$fn}') in $self->{name} message '$msg'"); syslog("LOG_WARNING", "Duplicate field '%s' (previous value '%s') in %s message '%s'", $fn, $self->{fields}->{$fn}, $self->{name}, $msg); } else { @@ -373,11 +382,12 @@ sub handle { if ($msg eq REQUEST_ACS_RESEND_CKSUM) { # Special case $error_detection = 1; - $self = C4::SIP::Sip::MsgType->new((REQUEST_ACS_RESEND), 0); + $self = C4::SIP::Sip::MsgType->new( (REQUEST_ACS_RESEND), 0, $server ); } elsif((length($msg) > 11) && (substr($msg, -9, 2) eq "AY")) { $error_detection = 1; if (!verify_cksum($msg)) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Checksum failed on message '$msg'"); syslog("LOG_WARNING", "Checksum failed on message '%s'", $msg); # REQUEST_SC_RESEND with error detection $last_response = REQUEST_SC_RESEND_CKSUM; @@ -386,17 +396,18 @@ sub handle { } else { # Save the sequence number, then strip off the # error detection data to process the message - $self = C4::SIP::Sip::MsgType->new(substr($msg, 0, -9), substr($msg, -7, 1)); + $self = C4::SIP::Sip::MsgType->new( substr( $msg, 0, -9 ), substr( $msg, -7, 1 ), $server ); } } elsif ($error_detection) { # We received a non-ED message when ED is supposed to be active. # Warn about this problem, then process the message anyway. + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Received message without error detection: '$msg'"); syslog("LOG_WARNING", "Received message without error detection: '%s'", $msg); $error_detection = 0; - $self = C4::SIP::Sip::MsgType->new($msg, 0); + $self = C4::SIP::Sip::MsgType->new( $msg, 0, $server ); } else { - $self = C4::SIP::Sip::MsgType->new($msg, 0); + $self = C4::SIP::Sip::MsgType->new( $msg, 0, $server ); } if ((substr($msg, 0, 2) ne REQUEST_ACS_RESEND) && @@ -404,6 +415,7 @@ sub handle { return substr($msg, 0, 2); } unless ($self->{handler}) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: No handler defined for '$msg'"); syslog("LOG_WARNING", "No handler defined for '%s'", $msg); $last_response = REQUEST_SC_RESEND; print("$last_response\r"); @@ -437,7 +449,7 @@ sub build_patron_status { my $resp = (PATRON_STATUS_RESP); if ($patron) { - $resp .= patron_status_string($patron); + $resp .= patron_status_string( $patron, $server ); $resp .= $lang . timestamp(); $resp .= add_field(FID_PERSONAL_NAME, $patron->name); @@ -518,6 +530,7 @@ sub handle_checkout { # Off-line transactions need to be recorded, but there's # not a lot we can do about it + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: received no-block checkout from terminal '$account->{id}'"); syslog( "LOG_WARNING", "received no-block checkout from terminal '%s'", $account->{id} ); $status = $ils->checkout_no_block( $patron_id, $item_id, $sc_renewal_policy, $trans_date, $nb_due_date ); @@ -640,6 +653,7 @@ sub handle_checkin { if ($no_block eq 'Y') { # Off-line transactions, ick. + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: received no-block checkin from terminal '$account->{id}'"); syslog("LOG_WARNING", "received no-block checkin from terminal '%s'", $account->{id}); $status = $ils->checkin_no_block($item_id, $trans_date, $return_date, $item_props, $cancel); } else { @@ -759,21 +773,25 @@ sub handle_sc_status { } elsif ($sc_protocol_version =~ /^2\./) { $new_proto = 2; } else { + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Unrecognized protocol revision '$sc_protocol_version', falling back to '1'"); syslog("LOG_WARNING", "Unrecognized protocol revision '%s', falling back to '1'", $sc_protocol_version); $new_proto = 1; } if ($new_proto != $protocol_version) { + $server->{logger}->info("$server->{server}->{peeraddr}:$server->{account}->{id}: Setting protocol level to $new_proto"); syslog("LOG_INFO", "Setting protocol level to $new_proto"); $protocol_version = $new_proto; } if ($status == SC_STATUS_PAPER) { - syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper", - $self->{account}->{id}, $self->{account}->{institution}); + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Self-Check unit '$self->{account}->{id}@$self->{account}->{institution}' out of paper"); + syslog("LOG_WARNING", "Self-Check unit '%s@%s' out of paper", + $self->{account}->{id}, $self->{account}->{institution}); } elsif ($status == SC_STATUS_SHUTDOWN) { - syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down", - $self->{account}->{id}, $self->{account}->{institution}); + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: Self-Check unit '$self->{account}->{id}@$self->{account}->{institution}' shutting down"); + syslog("LOG_WARNING", "Self-Check unit '%s@%s' shutting down", + $self->{account}->{id}, $self->{account}->{institution}); } $self->{account}->{print_width} = $print_width; @@ -810,9 +828,11 @@ sub login_core { my $pwd = shift; my $status = 1; # Assume it all works if (!exists($server->{config}->{accounts}->{$uid})) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: MsgType::login_core: Unknown login '$uid'"); syslog("LOG_WARNING", "MsgType::login_core: Unknown login '$uid'"); $status = 0; } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: MsgType::login_core: Invalid password for login '$uid'"); syslog("LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'"); $status = 0; } else { @@ -826,15 +846,18 @@ sub login_core { my $auth_status = api_auth($uid,$pwd,$inst); if (!$auth_status or $auth_status !~ /^ok$/i) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: api_auth failed for SIP terminal '$uid' of '$inst': " . ($auth_status||'unknown') ); syslog("LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", $uid, $inst, ($auth_status||'unknown')); $status = 0; } else { + $server->{logger}->info("$server->{server}->{peeraddr}:$server->{account}->{id}: Successful login/auth for '$server->{account}->{id}' of '$inst'"); syslog("LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst); # # initialize connection to ILS # my $module = $server->{config}->{institutions}->{$inst}->{implementation}; + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: login_core: " . Dumper($module) ); syslog("LOG_DEBUG", 'login_core: ' . Dumper($module)); # Suspect this is always ILS but so we don't break any eccentic install (for now) if ($module eq 'ILS') { @@ -842,14 +865,17 @@ sub login_core { } $module->use; if ($@) { + $server->{logger}->error("$server->{server}->{peeraddr}:$server->{service}: Loading ILS implementation '$module' for institution '$inst' failed"); syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", $server->{service}, $module, $inst); die("Failed to load ILS implementation '$module' for $inst"); } # like ILS->new(), I think. - $server->{ils} = $module->new($server->{institution}, $server->{account}); + + $server->{ils} = $module->new( $server->{institution}, $server->{account}, $server ); if (!$server->{ils}) { + $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: $server->{service}: ILS connection to '$inst' failed"); syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst); die("Unable to connect to ILS '$inst'"); } @@ -873,6 +899,7 @@ sub handle_login { $pwd = $fields->{(FID_LOGIN_PWD)}; # Terminal PWD, not patron PWD. if ($uid_algorithm || $pwd_algorithm) { + $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm"); syslog("LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm"); $status = 0; } @@ -890,7 +917,7 @@ sub handle_login { # and we're going to believe it. # sub summary_info { - my ($ils, $patron, $summary, $start, $end) = @_; + my ($server, $ils, $patron, $summary, $start, $end) = @_; my $resp = ''; my $summary_type; # @@ -910,6 +937,7 @@ sub summary_info { return ''; # No detailed information required } + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: Summary_info: index == '$summary_type', field '$summary_map[$summary_type]->{fid}'"); syslog("LOG_DEBUG", "Summary_info: index == '%d', field '%s'", $summary_type, $summary_map[$summary_type]->{fid}); @@ -917,6 +945,7 @@ sub summary_info { my $fid = $summary_map[$summary_type]->{fid}; my $itemlist = &$func($patron, $start, $end); + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: summary_info: list = (" . join(", ", @{$itemlist}) . ")"); syslog("LOG_DEBUG", "summary_info: list = (%s)", join(", ", @{$itemlist})); foreach my $i (@{$itemlist}) { $resp .= add_field($fid, $i->{barcode}); @@ -944,7 +973,7 @@ sub handle_patron_info { $resp = (PATRON_INFO_RESP); if ($patron) { - $resp .= patron_status_string($patron); + $resp .= patron_status_string($patron, $server); $resp .= (defined($lang) and length($lang) ==3) ? $lang : $patron->language; $resp .= timestamp(); @@ -991,7 +1020,7 @@ sub handle_patron_info { # fine_items # recall_items - $resp .= summary_info($ils, $patron, $summary, $start, $end); + $resp .= summary_info($server, $ils, $patron, $summary, $start, $end); $resp .= maybe_add(FID_HOME_ADDR, $patron->address); $resp .= maybe_add(FID_EMAIL, $patron->email_addr); @@ -1177,6 +1206,7 @@ sub handle_item_status_update { $item_props = $fields->{(FID_ITEM_PROPS)}; if (!defined($item_id)) { + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_item_status: received message without Item ID field"); syslog("LOG_WARNING", "handle_item_status: received message without Item ID field"); } else { @@ -1221,6 +1251,7 @@ sub handle_patron_enable { $patron_id = $fields->{(FID_PATRON_ID)}; $patron_pwd = $fields->{(FID_PATRON_PWD)}; + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_patron_enable: patron_id: '$patron_id', patron_pwd: '$patron_pwd'"); syslog("LOG_DEBUG", "handle_patron_enable: patron_id: '%s', patron_pwd: '%s'", $patron_id, $patron_pwd); @@ -1239,7 +1270,7 @@ sub handle_patron_enable { # Don't enable the patron if there was an invalid password $status = $patron->enable; } - $resp .= patron_status_string($patron); + $resp .= patron_status_string( $patron, $server ); $resp .= $patron->language . timestamp(); $resp .= add_field(FID_PATRON_ID, $patron->id); @@ -1292,10 +1323,11 @@ sub handle_hold { $status = $ils->alter_hold($patron_id, $patron_pwd, $item_id, $title_id, $expiry_date, $pickup_locn, $hold_type, $fee_ack); } else { - syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", - $hold_mode, $server->{account}->{id}); - $status = $ils->Transaction::Hold; # new? - $status->screen_msg("System error. Please contact library staff."); + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_hold: Unrecognized hold mode '$hold_mode' from terminal '$server->{account}->{id}'"); + syslog("LOG_WARNING", "handle_hold: Unrecognized hold mode '%s' from terminal '%s'", + $hold_mode, $server->{account}->{id}); + $status = $ils->Transaction::Hold; # new? + $status->screen_msg("System error. Please contact library staff."); } $resp .= $status->ok; @@ -1342,9 +1374,10 @@ sub handle_renew { $ils->check_inst_id($fields->{(FID_INST_ID)}, "handle_renew"); if ($no_block eq 'Y') { - syslog("LOG_WARNING", - "handle_renew: received 'no block' renewal from terminal '%s'", - $server->{account}->{id}); + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_renew: received 'no block' renewal from terminal '$server->{account}->{id}'"); + syslog("LOG_WARNING", + "handle_renew: received 'no block' renewal from terminal '%s'", + $server->{account}->{id}); } $patron_id = $fields->{(FID_PATRON_ID)}; @@ -1511,15 +1544,17 @@ sub send_acs_status { $retries = sprintf("%03d", $policy->{retries}); if (length($timeout) != 3) { - syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'", - $timeout); - $timeout = '000'; + $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_acs_status: timeout field wrong size: '$timeout'"); + syslog("LOG_ERR", "handle_acs_status: timeout field wrong size: '%s'", + $timeout); + $timeout = '000'; } if (length($retries) != 3) { - syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", - $retries); - $retries = '000'; + $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: handle_acs_status: retries field wrong size: '$retries'"); + syslog("LOG_ERR", "handle_acs_status: retries field wrong size: '%s'", + $retries); + $retries = '000'; } $msg .= "$online_status$checkin_ok$checkout_ok$ACS_renewal_policy"; @@ -1531,10 +1566,11 @@ sub send_acs_status { } elsif ($protocol_version == 2) { $msg .= '2.00'; } else { - syslog("LOG_ERR", - 'Bad setting for $protocol_version, "%s" in send_acs_status', - $protocol_version); - $msg .= '1.00'; + $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: Bad setting for \$protocol_version, '$protocol_version' in send_acs_status"); + syslog("LOG_ERR", + 'Bad setting for $protocol_version, "%s" in send_acs_status', + $protocol_version); + $msg .= '1.00'; } # Institution ID @@ -1552,6 +1588,7 @@ sub send_acs_status { } } if (length($supported_msgs) < 16) { + $server->{logger}->error("$server->{server}->{peeraddr}:$server->{account}->{id}: send_acs_status: supported messages '$supported_msgs' too short"); syslog("LOG_ERR", 'send_acs_status: supported messages "%s" too short', $supported_msgs); } $msg .= add_field(FID_SUPPORTED_MSGS, $supported_msgs); @@ -1561,9 +1598,10 @@ sub send_acs_status { if (defined($account->{print_width}) && defined($print_line) && $account->{print_width} < length($print_line)) { - syslog("LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating", - $print_line); - $print_line = substr($print_line, 0, $account->{print_width}); + $server->{logger}->warn("$server->{server}->{peeraddr}:$server->{account}->{id}: send_acs_status: print line '$print_line' too long. Truncating"); + syslog("LOG_WARNING", "send_acs_status: print line '%s' too long. Truncating", + $print_line); + $print_line = substr($print_line, 0, $account->{print_width}); } $msg .= maybe_add(FID_PRINT_LINE, $print_line); @@ -1580,8 +1618,10 @@ sub send_acs_status { # sub patron_status_string { my $patron = shift; + my $server = shift; my $patron_status; + $server->{logger}->debug("$server->{server}->{peeraddr}:$server->{account}->{id}: patron_status_string: $patron->id charge_ok: $patron->charge_ok"); syslog("LOG_DEBUG", "patron_status_string: %s charge_ok: %s", $patron->id, $patron->charge_ok); $patron_status = sprintf( '%s%s%s%s%s%s%s%s%s%s%s%s%s%s', diff --git a/etc/log4perl.conf b/etc/log4perl.conf index efc4707..d558387 100644 --- a/etc/log4perl.conf +++ b/etc/log4perl.conf @@ -11,3 +11,11 @@ log4perl.appender.OPAC.filename=__LOG_DIR__/opac-error.log log4perl.appender.OPAC.mode=append log4perl.appender.OPAC.layout=PatternLayout log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n + +log4perl.logger.sip = DEBUG, SIP +log4perl.appender.SIP = Log::Dispatch::Syslog +log4perl.appender.SIP.min_level = debug +log4perl.appender.SIP.ident = koha_sip +log4perl.appender.SIP.facility = local6 +log4perl.appender.SIP.layout=PatternLayout +log4perl.appender.SIP.layout.ConversionPattern=[%d] [%p] %m %l %n -- 1.7.10.4