Attachment #100062 for bug #15253

View | Details | Raw Unified | Return to bug 15253
Collapse All | Expand All

Lines 6-12 package C4::SIP::ILS; Link Here

(-)a/C4/SIP/ILS.pm (-1 / +1 lines)
6		6
7	use warnings;	7	use warnings;
8	use strict;	8	use strict;
9	use Sys::Syslog qw(syslog);	9	use C4::SIP::Sip qw(syslog);
10	use Data::Dumper;	10	use Data::Dumper;
11		11
12	use C4::SIP::ILS::Item;	12	use C4::SIP::ILS::Item;

Lines 9-15 package C4::SIP::ILS::Item; Link Here

(-)a/C4/SIP/ILS/Item.pm (-1 / +1 lines)
9	use strict;	9	use strict;
10	use warnings;	10	use warnings;
11		11
12	use Sys::Syslog qw(syslog);	12	use C4::SIP::Sip qw(syslog);
13	use Carp;	13	use Carp;
14	use Template;	14	use Template;
15		15

Lines 12-18 use warnings; Link Here

(-)a/C4/SIP/ILS/Patron.pm (-1 / +1 lines)
12	use Exporter;	12	use Exporter;
13	use Carp;	13	use Carp;
14		14
15	use Sys::Syslog qw(syslog);	15	use C4::SIP::Sip qw(syslog);
16	use Data::Dumper;	16	use Data::Dumper;
17		17
18	use C4::SIP::Sip qw(add_field);	18	use C4::SIP::Sip qw(add_field);

Lines 8-14 use warnings; Link Here

(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-1 / +1 lines)
8	use strict;	8	use strict;
9		9
10	use POSIX qw(strftime);	10	use POSIX qw(strftime);
11	use Sys::Syslog qw(syslog);	11	use C4::SIP::Sip qw(syslog);
12	use Data::Dumper;	12	use Data::Dumper;
13	use CGI qw ( -utf8 );	13	use CGI qw ( -utf8 );
14		14

Lines 6-12 package C4::SIP::ILS::Transaction::RenewAll; Link Here

(-)a/C4/SIP/ILS/Transaction/RenewAll.pm (-1 / +1 lines)
6	use strict;	6	use strict;
7	use warnings;	7	use warnings;
8		8
9	use Sys::Syslog qw(syslog);	9	use C4::SIP::Sip qw(syslog);
10		10
11	use C4::SIP::ILS::Item;	11	use C4::SIP::ILS::Item;
12		12




use warnings;
use FindBin qw($Bin);
use lib "$Bin";
use Sys::Syslog qw(syslog);
use Net::Server::PreFork;
use IO::Socket::INET;
use Socket qw(:DEFAULT :crlf);
use Scalar::Util qw(blessed);
require UNIVERSAL::require;

use C4::Context;
use C4::SIP::Sip qw(syslog);
use C4::SIP::Sip::Constants qw(:all);
use C4::SIP::Sip::Configuration;
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
use C4::SIP::Sip::MsgType qw( handle login_core );
use Koha::Caches;

use Koha::Logger;
use C4::SIP::Trapper;
tie *STDERR, "C4::SIP::Trapper";

use base qw(Net::Server::PreFork);

use constant LOG_SIP => "local6"; # Local alias for the logging facility

# Child
#

my $activeSIPServer;
my $activeLogger;

# process_request is the callback used by Net::Server to handle
# an incoming connection request.


    # Flushing L1 to make sure the request will be processed using the correct data
    Koha::Caches->flush_L1_caches();

    $self->{account} = undef;  # Clear out the account from the last request, it may be different
    $self->{logger} = _set_logger( Koha::Logger->get( { interface => 'sip' } ) );

    # Flush previous MDCs to prevent accidentally leaking incorrect MDC-entries
    Log::Log4perl::MDC->put( "accountid", undef );
    Log::Log4perl::MDC->put( "peeraddr",  undef );

    my $sockname = getsockname(STDIN);

    # Check if socket connection is IPv6 before resolving address

    }
    alarm 0;

    $self->{logger} = _set_logger(
        Koha::Logger->get(
            {
                interface => 'sip',
                category  => $self->{account}->{id}, # Add id to namespace
            }
        )
    );

    # Set MDCs after properly authenticating
    Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
    Log::Log4perl::MDC->put( "peeraddr",  $self->{server}->{peeraddr} );

    syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
        $self->{account}->{id},
        $self->{account}->{institution});

    }
}

=head2 get_SIPServer

    my $sipServer = C4::SIP::SIPServer::get_SIPServer()

@RETURNS C4::SIP::SIPServer, the current server's child-process used to handle this SIP-transaction

=cut

sub get_SIPServer {
    unless($activeSIPServer) {
        my @cc = caller(1);
        die "$cc[3]() asks for \$activeSIPServer, but he is not defined yet";
    }
    return $activeSIPServer;
}

sub _set_SIPServer {
    my ($sipServer) = @_;
    unless (blessed($sipServer) && $sipServer->isa('C4::SIP::SIPServer')) {
        my @cc = caller(0);
        die "$cc[3]():> \$sipServer '$sipServer' is not a C4::SIP::SIPServer-object";
    }
    $activeSIPServer = $sipServer;
    return $activeSIPServer;
}

=head2 get_logger

    my $logger = C4::SIP::SIPServer::get_logger()

@RETURNS Koha::Logger, the logger used to log this SIP-transaction

=cut

sub get_logger {
    unless($activeLogger) {
        my @cc = caller(1);
        die "$cc[3]() asks for \$activeLogger, but he is not defined yet";
    }
    return $activeLogger;
}

sub _set_logger {
    my ($logger) = @_;
    unless (blessed($logger) && $logger->isa('Koha::Logger')) {
        my @cc = caller(0);
        die "$cc[3]():> \$logger '$logger' is not a Koha::Logger-object";
    }
    $activeLogger = $logger;
    return $activeLogger;
}

1;

__END__




use warnings;
use Exporter;
use Encode;
use Sys::Syslog qw(syslog);
use POSIX qw(strftime);
use Socket qw(:crlf);
use IO::Handle;

our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
    denied sipbool boolspace write_msg
    $error_detection $protocol_version $field_delimiter
    $last_response syslog);

our %EXPORT_TAGS = (
    all => [qw(y_or_n timestamp add_field maybe_add
        add_count denied sipbool boolspace write_msg
        $error_detection $protocol_version
        $field_delimiter $last_response syslog)]);

our $error_detection = 0;
our $protocol_version = 1;

    $last_response = $msg;
}

sub syslog {
    my ( $level, $mask, @args ) = @_;

    my $method =
        $level eq 'LOG_ERR'     ? 'error'
      : $level eq 'LOG_DEBUG'   ? 'debug'
      : $level eq 'LOG_INFO'    ? 'info'
      : $level eq 'LOG_WARNING' ? 'warn'
      :                           'error';

    my $message = @args ? sprintf($mask, @args) : $mask;

    C4::SIP::SIPServer::get_logger()->$method($message);
}

1;

Lines 10-15 use strict; Link Here

(-)a/C4/SIP/Sip/Configuration.pm (-1 / +3 lines)
10	use warnings;	10	use warnings;
11	use XML::Simple qw(:strict);	11	use XML::Simple qw(:strict);
12		12
		13	use C4::SIP::Sip qw(syslog);
		14
13	my $parser = new XML::Simple(	15	my $parser = new XML::Simple(
14	KeyAttr => {	16	KeyAttr => {
15	login => '+id',	17	login => '+id',
Lines 63-69 sub find_service { Link Here
63	my $portstr;	65	my $portstr;
64	foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {	66	foreach my $addr ( '', '*:', "$sockaddr:", "[$sockaddr]:" ) {
65	$portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );	67	$portstr = sprintf( "%s%s/%s", $addr, $port, lc $proto );
66	Sys::Syslog::syslog( "LOG_DEBUG",	68	syslog( "LOG_DEBUG",
67	"Configuration::find_service: Trying $portstr" );	69	"Configuration::find_service: Trying $portstr" );
68	last if ( exists( ( $self->{listeners} )->{$portstr} ) );	70	last if ( exists( ( $self->{listeners} )->{$portstr} ) );
69	}	71	}

Lines 9-15 package C4::SIP::Sip::MsgType; Link Here

(-)a/C4/SIP/Sip/MsgType.pm (-1 lines)
9	use strict;	9	use strict;
10	use warnings;	10	use warnings;
11	use Exporter;	11	use Exporter;
12	use Sys::Syslog qw(syslog);
13		12
14	use C4::SIP::Sip qw(:all);	13	use C4::SIP::Sip qw(:all);
15	use C4::SIP::Sip::Constants qw(:all);	14	use C4::SIP::Sip::Constants qw(:all);




package C4::SIP::Trapper;

use Modern::Perl;

use Koha::Logger;

sub TIEHANDLE {
    my $class = shift;
    bless [], $class;
}

sub PRINT {
    my $self = shift;
    $Log::Log4perl::caller_depth++;
    my $logger =
      Koha::Logger->get( { interface => 'sip', category => 'STDERR' } );
    warn @_;
    $logger->error(@_);
    $Log::Log4perl::caller_depth--;
}

1;

Lines 159-169 sub _check_conf { # check logfiles in log4perl config (at initialization) Link Here

(-)a/Koha/Logger.pm (-2 / +5 lines)
159	if ( $l =~ /(OPAC\|INTRANET)\.filename\s=\s(.)\s$/i ) {	159	if ( $l =~ /(OPAC\|INTRANET)\.filename\s=\s(.)\s$/i ) {
160		160
161	# we only check the two default logfiles, skipping additional ones	161	# we only check the two default logfiles, skipping additional ones
162	return if !-w $2;	162	if ( !-w $2 ) {
		163	warn "Log file $2 is not writable!";
		164	return;
		165	};
163	push @logs, $1 . ':' . $2;	166	push @logs, $1 . ':' . $2;
164	}	167	}
165	}	168	}
166	return if !@logs; # we should find one	169	return unless @logs; # we should find one
167	return \@logs;	170	return \@logs;
168	}	171	}
169		172

Lines 2-7 log4perl.logger.intranet = WARN, INTRANET Link Here

(-)a/etc/log4perl.conf (-1 / +16 lines)
2	log4perl.appender.INTRANET=Log::Log4perl::Appender::File	2	log4perl.appender.INTRANET=Log::Log4perl::Appender::File
3	log4perl.appender.INTRANET.filename=__LOG_DIR__/intranet-error.log	3	log4perl.appender.INTRANET.filename=__LOG_DIR__/intranet-error.log
4	log4perl.appender.INTRANET.mode=append	4	log4perl.appender.INTRANET.mode=append
		5	log4perl.appender.INTRANET.create_at_logtime=true
		6	log4perl.appender.INTRANET.syswrite=true
		7	log4perl.appender.INTRANET.recreate=true
5	log4perl.appender.INTRANET.layout=PatternLayout	8	log4perl.appender.INTRANET.layout=PatternLayout
6	log4perl.appender.INTRANET.layout.ConversionPattern=[%d] [%p] %m %l %n	9	log4perl.appender.INTRANET.layout.ConversionPattern=[%d] [%p] %m %l %n
7		10
Lines 9-14 log4perl.logger.opac = WARN, OPAC Link Here
9	log4perl.appender.OPAC=Log::Log4perl::Appender::File	12	log4perl.appender.OPAC=Log::Log4perl::Appender::File
10	log4perl.appender.OPAC.filename=__LOG_DIR__/opac-error.log	13	log4perl.appender.OPAC.filename=__LOG_DIR__/opac-error.log
11	log4perl.appender.OPAC.mode=append	14	log4perl.appender.OPAC.mode=append
		15	log4perl.appender.OPAC.create_at_logtime=true
		16	log4perl.appender.OPAC.syswrite=true
		17	log4perl.appender.OPAC.recreate=true
12	log4perl.appender.OPAC.layout=PatternLayout	18	log4perl.appender.OPAC.layout=PatternLayout
13	log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n	19	log4perl.appender.OPAC.layout.ConversionPattern=[%d] [%p] %m %l %n
14		20
Lines 18-20 log4perl.appender.Z3950.filename=__LOG_DIR__/z3950-error.log Link Here
18	log4perl.appender.Z3950.mode=append	24	log4perl.appender.Z3950.mode=append
19	log4perl.appender.Z3950.layout=PatternLayout	25	log4perl.appender.Z3950.layout=PatternLayout
20	log4perl.appender.Z3950.layout.ConversionPattern=[%d] [%p] %m %l %n	26	log4perl.appender.Z3950.layout.ConversionPattern=[%d] [%p] %m %l %n
21	-	27
		28	log4perl.logger.sip = DEBUG, SIP
		29	log4perl.appender.SIP=Log::Log4perl::Appender::File
		30	log4perl.appender.SIP.filename=__LOG_DIR__/sip2.log
		31	log4perl.appender.SIP.mode=append
		32	log4perl.appender.SIP.create_at_logtime=true
		33	log4perl.appender.SIP.syswrite=true
		34	log4perl.appender.SIP.recreate=true
		35	log4perl.appender.SIP.layout=PatternLayout
		36	log4perl.appender.SIP.layout.ConversionPattern=[%d] [%p] %X{accountid}@%X{peeraddr}: %m %l %n

Return to bug 15253

Lines 5-23 use strict; Link Here

(-)a/C4/SIP/SIPServer.pm (-1 / +81 lines)
5	use warnings;	5	use warnings;
6	use FindBin qw($Bin);	6	use FindBin qw($Bin);
7	use lib "$Bin";	7	use lib "$Bin";
8	use Sys::Syslog qw(syslog);
9	use Net::Server::PreFork;	8	use Net::Server::PreFork;
10	use IO::Socket::INET;	9	use IO::Socket::INET;
11	use Socket qw(:DEFAULT :crlf);	10	use Socket qw(:DEFAULT :crlf);
		11	use Scalar::Util qw(blessed);
12	require UNIVERSAL::require;	12	require UNIVERSAL::require;
13		13
14	use C4::Context;	14	use C4::Context;
		15	use C4::SIP::Sip qw(syslog);
15	use C4::SIP::Sip::Constants qw(:all);	16	use C4::SIP::Sip::Constants qw(:all);
16	use C4::SIP::Sip::Configuration;	17	use C4::SIP::Sip::Configuration;
17	use C4::SIP::Sip::Checksum qw(checksum verify_cksum);	18	use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
18	use C4::SIP::Sip::MsgType qw( handle login_core );	19	use C4::SIP::Sip::MsgType qw( handle login_core );
19	use Koha::Caches;	20	use Koha::Caches;
20		21
		22	use Koha::Logger;
		23	use C4::SIP::Trapper;
		24	tie *STDERR, "C4::SIP::Trapper";
		25
21	use base qw(Net::Server::PreFork);	26	use base qw(Net::Server::PreFork);
22		27
23	use constant LOG_SIP => "local6"; # Local alias for the logging facility	28	use constant LOG_SIP => "local6"; # Local alias for the logging facility
Lines 81-86 __PACKAGE__ ->run(@parms); Link Here
81	# Child	86	# Child
82	#	87	#
83		88
		89	my $activeSIPServer;
		90	my $activeLogger;
		91
84	# process_request is the callback used by Net::Server to handle	92	# process_request is the callback used by Net::Server to handle
85	# an incoming connection request.	93	# an incoming connection request.
86		94
Lines 95-100 sub process_request { Link Here
95	# Flushing L1 to make sure the request will be processed using the correct data	103	# Flushing L1 to make sure the request will be processed using the correct data
96	Koha::Caches->flush_L1_caches();	104	Koha::Caches->flush_L1_caches();
97		105
		106	$self->{account} = undef; # Clear out the account from the last request, it may be different
		107	$self->{logger} = _set_logger( Koha::Logger->get( { interface => 'sip' } ) );
		108
		109	# Flush previous MDCs to prevent accidentally leaking incorrect MDC-entries
		110	Log::Log4perl::MDC->put( "accountid", undef );
		111	Log::Log4perl::MDC->put( "peeraddr", undef );
		112
98	my $sockname = getsockname(STDIN);	113	my $sockname = getsockname(STDIN);
99		114
100	# Check if socket connection is IPv6 before resolving address	115	# Check if socket connection is IPv6 before resolving address
Lines 160-165 sub raw_transport { Link Here
160	}	175	}
161	alarm 0;	176	alarm 0;
162		177
		178	$self->{logger} = _set_logger(
		179	Koha::Logger->get(
		180	{
		181	interface => 'sip',
		182	category => $self->{account}->{id}, # Add id to namespace
		183	}
		184	)
		185	);
		186
		187	# Set MDCs after properly authenticating
		188	Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
		189	Log::Log4perl::MDC->put( "peeraddr", $self->{server}->{peeraddr} );
		190
163	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",	191	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
164	$self->{account}->{id},	192	$self->{account}->{id},
165	$self->{account}->{institution});	193	$self->{account}->{institution});
Lines 397-402 sub get_timeout { Link Here
397	}	425	}
398	}	426	}
399		427
		428	=head2 get_SIPServer
		429
		430	my $sipServer = C4::SIP::SIPServer::get_SIPServer()
		431
		432	@RETURNS C4::SIP::SIPServer, the current server's child-process used to handle this SIP-transaction
		433
		434	=cut
		435
		436	sub get_SIPServer {
		437	unless($activeSIPServer) {
		438	my @cc = caller(1);
		439	die "$cc[3]() asks for \$activeSIPServer, but he is not defined yet";
		440	}
		441	return $activeSIPServer;
		442	}
		443
		444	sub _set_SIPServer {
		445	my ($sipServer) = @_;
		446	unless (blessed($sipServer) && $sipServer->isa('C4::SIP::SIPServer')) {
		447	my @cc = caller(0);
		448	die "$cc[3]():> \$sipServer '$sipServer' is not a C4::SIP::SIPServer-object";
		449	}
		450	$activeSIPServer = $sipServer;
		451	return $activeSIPServer;
		452	}
		453
		454	=head2 get_logger
		455
		456	my $logger = C4::SIP::SIPServer::get_logger()
		457
		458	@RETURNS Koha::Logger, the logger used to log this SIP-transaction
		459
		460	=cut
		461
		462	sub get_logger {
		463	unless($activeLogger) {
		464	my @cc = caller(1);
		465	die "$cc[3]() asks for \$activeLogger, but he is not defined yet";
		466	}
		467	return $activeLogger;
		468	}
		469
		470	sub _set_logger {
		471	my ($logger) = @_;
		472	unless (blessed($logger) && $logger->isa('Koha::Logger')) {
		473	my @cc = caller(0);
		474	die "$cc[3]():> \$logger '$logger' is not a Koha::Logger-object";
		475	}
		476	$activeLogger = $logger;
		477	return $activeLogger;
		478	}
		479
400	1;	480	1;
401		481
402	__END__	482	__END__

Lines 8-14 use strict; Link Here

(-)a/C4/SIP/Sip.pm (-3 / +17 lines)
8	use warnings;	8	use warnings;
9	use Exporter;	9	use Exporter;
10	use Encode;	10	use Encode;
11	use Sys::Syslog qw(syslog);
12	use POSIX qw(strftime);	11	use POSIX qw(strftime);
13	use Socket qw(:crlf);	12	use Socket qw(:crlf);
14	use IO::Handle;	13	use IO::Handle;
Lines 22-34 use base qw(Exporter); Link Here
22	our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count	21	our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
23	denied sipbool boolspace write_msg	22	denied sipbool boolspace write_msg
24	$error_detection $protocol_version $field_delimiter	23	$error_detection $protocol_version $field_delimiter
25	$last_response);	24	$last_response syslog);
26		25
27	our %EXPORT_TAGS = (	26	our %EXPORT_TAGS = (
28	all => [qw(y_or_n timestamp add_field maybe_add	27	all => [qw(y_or_n timestamp add_field maybe_add
29	add_count denied sipbool boolspace write_msg	28	add_count denied sipbool boolspace write_msg
30	$error_detection $protocol_version	29	$error_detection $protocol_version
31	$field_delimiter $last_response)]);	30	$field_delimiter $last_response syslog)]);
32		31
33	our $error_detection = 0;	32	our $error_detection = 0;
34	our $protocol_version = 1;	33	our $protocol_version = 1;
Lines 205-208 sub write_msg { Link Here
205	$last_response = $msg;	204	$last_response = $msg;
206	}	205	}
207		206
		207	sub syslog {
		208	my ( $level, $mask, @args ) = @_;
		209
		210	my $method =
		211	$level eq 'LOG_ERR' ? 'error'
		212	: $level eq 'LOG_DEBUG' ? 'debug'
		213	: $level eq 'LOG_INFO' ? 'info'
		214	: $level eq 'LOG_WARNING' ? 'warn'
		215	: 'error';
		216
		217	my $message = @args ? sprintf($mask, @args) : $mask;
		218
		219	C4::SIP::SIPServer::get_logger()->$method($message);
		220	}
		221
208	1;	222	1;

Line 0 Link Here

(-)a/C4/SIP/Trapper.pm (+22 lines)
	1	package C4::SIP::Trapper;
	2
	3	use Modern::Perl;
	4
	5	use Koha::Logger;
	6
	7	sub TIEHANDLE {
	8	my $class = shift;
	9	bless [], $class;
	10	}
	11
	12	sub PRINT {
	13	my $self = shift;
	14	$Log::Log4perl::caller_depth++;
	15	my $logger =
	16	Koha::Logger->get( { interface => 'sip', category => 'STDERR' } );
	17	warn @_;
	18	$logger->error(@_);
	19	$Log::Log4perl::caller_depth--;
	20	}
	21
	22	1;