@@ -, +, @@ 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(-) --- a/C4/SIP/ILS.pm +++ a/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); } --- a/C4/SIP/ILS/Item.pm +++ a/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; } --- a/C4/SIP/ILS/Patron.pm +++ a/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}); --- a/C4/SIP/ILS/Transaction/Checkout.pm +++ a/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"); } } } --- a/C4/SIP/ILS/Transaction/RenewAll.pm +++ a/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'|, --- a/C4/SIP/SIPServer.pm +++ a/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; --- a/C4/SIP/Sip.pm +++ a/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'"); } --- a/C4/SIP/Sip/Configuration.pm +++ a/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} ) ); --- a/C4/SIP/Sip/MsgType.pm +++ a/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', --- a/etc/log4perl.conf +++ a/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 --