Attachment #87993 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::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.



    $self->{config} = $config;

    $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-13 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
		21	log4perl.logger.sip = DEBUG, SIP
		22	log4perl.appender.SIP=Log::Log4perl::Appender::File
		23	log4perl.appender.SIP.filename=__LOG_DIR__/sip2.log
		24	log4perl.appender.SIP.mode=append
		25	log4perl.appender.SIP.create_at_logtime=true
		26	log4perl.appender.SIP.syswrite=true
		27	log4perl.appender.SIP.recreate=true
		28	log4perl.appender.SIP.layout=PatternLayout
		29	log4perl.appender.SIP.layout.ConversionPattern=[%d] [%p] %X{accountid}@%X{peeraddr}: %m %l %n

Return to bug 15253

Lines 5-22 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		20
		21	use Koha::Logger;
		22	use C4::SIP::Trapper;
		23	tie *STDERR, "C4::SIP::Trapper";
		24
20	use base qw(Net::Server::PreFork);	25	use base qw(Net::Server::PreFork);
21		26
22	use constant LOG_SIP => "local6"; # Local alias for the logging facility	27	use constant LOG_SIP => "local6"; # Local alias for the logging facility
Lines 80-85 __PACKAGE__ ->run(@parms); Link Here
80	# Child	85	# Child
81	#	86	#
82		87
		88	my $activeSIPServer;
		89	my $activeLogger;
		90
83	# process_request is the callback used by Net::Server to handle	91	# process_request is the callback used by Net::Server to handle
84	# an incoming connection request.	92	# an incoming connection request.
85		93
Lines 91-96 sub process_request { Link Here
91		99
92	$self->{config} = $config;	100	$self->{config} = $config;
93		101
		102	$self->{account} = undef; # Clear out the account from the last request, it may be different
		103	$self->{logger} = _set_logger( Koha::Logger->get( { interface => 'sip' } ) );
		104
		105	# Flush previous MDCs to prevent accidentally leaking incorrect MDC-entries
		106	Log::Log4perl::MDC->put( "accountid", undef );
		107	Log::Log4perl::MDC->put( "peeraddr", undef );
		108
94	my $sockname = getsockname(STDIN);	109	my $sockname = getsockname(STDIN);
95		110
96	# Check if socket connection is IPv6 before resolving address	111	# Check if socket connection is IPv6 before resolving address
Lines 156-161 sub raw_transport { Link Here
156	}	171	}
157	alarm 0;	172	alarm 0;
158		173
		174	$self->{logger} = _set_logger(
		175	Koha::Logger->get(
		176	{
		177	interface => 'sip',
		178	category => $self->{account}->{id}, # Add id to namespace
		179	}
		180	)
		181	);
		182
		183	# Set MDCs after properly authenticating
		184	Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
		185	Log::Log4perl::MDC->put( "peeraddr", $self->{server}->{peeraddr} );
		186
159	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",	187	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
160	$self->{account}->{id},	188	$self->{account}->{id},
161	$self->{account}->{institution});	189	$self->{account}->{institution});
Lines 393-398 sub get_timeout { Link Here
393	}	421	}
394	}	422	}
395		423
		424	=head2 get_SIPServer
		425
		426	my $sipServer = C4::SIP::SIPServer::get_SIPServer()
		427
		428	@RETURNS C4::SIP::SIPServer, the current server's child-process used to handle this SIP-transaction
		429
		430	=cut
		431
		432	sub get_SIPServer {
		433	unless($activeSIPServer) {
		434	my @cc = caller(1);
		435	die "$cc[3]() asks for \$activeSIPServer, but he is not defined yet";
		436	}
		437	return $activeSIPServer;
		438	}
		439
		440	sub _set_SIPServer {
		441	my ($sipServer) = @_;
		442	unless (blessed($sipServer) && $sipServer->isa('C4::SIP::SIPServer')) {
		443	my @cc = caller(0);
		444	die "$cc[3]():> \$sipServer '$sipServer' is not a C4::SIP::SIPServer-object";
		445	}
		446	$activeSIPServer = $sipServer;
		447	return $activeSIPServer;
		448	}
		449
		450	=head2 get_logger
		451
		452	my $logger = C4::SIP::SIPServer::get_logger()
		453
		454	@RETURNS Koha::Logger, the logger used to log this SIP-transaction
		455
		456	=cut
		457
		458	sub get_logger {
		459	unless($activeLogger) {
		460	my @cc = caller(1);
		461	die "$cc[3]() asks for \$activeLogger, but he is not defined yet";
		462	}
		463	return $activeLogger;
		464	}
		465
		466	sub _set_logger {
		467	my ($logger) = @_;
		468	unless (blessed($logger) && $logger->isa('Koha::Logger')) {
		469	my @cc = caller(0);
		470	die "$cc[3]():> \$logger '$logger' is not a Koha::Logger-object";
		471	}
		472	$activeLogger = $logger;
		473	return $activeLogger;
		474	}
		475
396	1;	476	1;
397		477
398	__END__	478	__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 21-33 use base qw(Exporter); Link Here
21	our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count	20	our @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count
22	denied sipbool boolspace write_msg	21	denied sipbool boolspace write_msg
23	$error_detection $protocol_version $field_delimiter	22	$error_detection $protocol_version $field_delimiter
24	$last_response);	23	$last_response syslog);
25		24
26	our %EXPORT_TAGS = (	25	our %EXPORT_TAGS = (
27	all => [qw(y_or_n timestamp add_field maybe_add	26	all => [qw(y_or_n timestamp add_field maybe_add
28	add_count denied sipbool boolspace write_msg	27	add_count denied sipbool boolspace write_msg
29	$error_detection $protocol_version	28	$error_detection $protocol_version
30	$field_delimiter $last_response)]);	29	$field_delimiter $last_response syslog)]);
31		30
32	our $error_detection = 0;	31	our $error_detection = 0;
33	our $protocol_version = 1;	32	our $protocol_version = 1;
Lines 193-196 sub write_msg { Link Here
193	$last_response = $msg;	192	$last_response = $msg;
194	}	193	}
195		194
		195	sub syslog {
		196	my ( $level, $mask, @args ) = @_;
		197
		198	my $method =
		199	$level eq 'LOG_ERR' ? 'error'
		200	: $level eq 'LOG_DEBUG' ? 'debug'
		201	: $level eq 'LOG_INFO' ? 'info'
		202	: $level eq 'LOG_WARNING' ? 'warn'
		203	: 'error';
		204
		205	my $message = @args ? sprintf($mask, @args) : $mask;
		206
		207	C4::SIP::SIPServer::get_logger()->$method($message);
		208	}
		209
196	1;	210	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;