Attachment #86573 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::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-21 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::SIP::Sip qw(syslog);
14	use C4::SIP::Sip::Constants qw(:all);	15	use C4::SIP::Sip::Constants qw(:all);
15	use C4::SIP::Sip::Configuration;	16	use C4::SIP::Sip::Configuration;
16	use C4::SIP::Sip::Checksum qw(checksum verify_cksum);	17	use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
17	use C4::SIP::Sip::MsgType qw( handle login_core );	18	use C4::SIP::Sip::MsgType qw( handle login_core );
18		19
		20	use Koha::Logger;
		21	use C4::SIP::Trapper;
		22	tie *STDERR, "C4::SIP::Trapper";
		23
19	use base qw(Net::Server::PreFork);	24	use base qw(Net::Server::PreFork);
20		25
21	use constant LOG_SIP => "local6"; # Local alias for the logging facility	26	use constant LOG_SIP => "local6"; # Local alias for the logging facility
Lines 76-81 __PACKAGE__ ->run(@parms); Link Here
76	# Child	81	# Child
77	#	82	#
78		83
		84	my $activeSIPServer;
		85	my $activeLogger;
		86
79	# process_request is the callback used by Net::Server to handle	87	# process_request is the callback used by Net::Server to handle
80	# an incoming connection request.	88	# an incoming connection request.
81		89
Lines 87-92 sub process_request { Link Here
87		95
88	$self->{config} = $config;	96	$self->{config} = $config;
89		97
		98	$self->{account} = undef; # Clear out the account from the last request, it may be different
		99	$self->{logger} = _set_logger( Koha::Logger->get( { interface => 'sip' } ) );
		100
		101	# Flush previous MDCs to prevent accidentally leaking incorrect MDC-entries
		102	Log::Log4perl::MDC->put( "accountid", undef );
		103	Log::Log4perl::MDC->put( "peeraddr", undef );
		104
90	my $sockname = getsockname(STDIN);	105	my $sockname = getsockname(STDIN);
91		106
92	# Check if socket connection is IPv6 before resolving address	107	# Check if socket connection is IPv6 before resolving address
Lines 152-157 sub raw_transport { Link Here
152	}	167	}
153	alarm 0;	168	alarm 0;
154		169
		170	$self->{logger} = _set_logger(
		171	Koha::Logger->get(
		172	{
		173	interface => 'sip',
		174	category => $self->{account}->{id}, # Add id to namespace
		175	}
		176	)
		177	);
		178
		179	# Set MDCs after properly authenticating
		180	Log::Log4perl::MDC->put( "accountid", $self->{account}->{id} );
		181	Log::Log4perl::MDC->put( "peeraddr", $self->{server}->{peeraddr} );
		182
155	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",	183	syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
156	$self->{account}->{id},	184	$self->{account}->{id},
157	$self->{account}->{institution});	185	$self->{account}->{institution});
Lines 389-394 sub get_timeout { Link Here
389	}	417	}
390	}	418	}
391		419
		420	=head2 get_SIPServer
		421
		422	my $sipServer = C4::SIP::SIPServer::get_SIPServer()
		423
		424	@RETURNS C4::SIP::SIPServer, the current server's child-process used to handle this SIP-transaction
		425
		426	=cut
		427
		428	sub get_SIPServer {
		429	unless($activeSIPServer) {
		430	my @cc = caller(1);
		431	die "$cc[3]() asks for \$activeSIPServer, but he is not defined yet";
		432	}
		433	return $activeSIPServer;
		434	}
		435
		436	sub _set_SIPServer {
		437	my ($sipServer) = @_;
		438	unless (blessed($sipServer) && $sipServer->isa('C4::SIP::SIPServer')) {
		439	my @cc = caller(0);
		440	die "$cc[3]():> \$sipServer '$sipServer' is not a C4::SIP::SIPServer-object";
		441	}
		442	$activeSIPServer = $sipServer;
		443	return $activeSIPServer;
		444	}
		445
		446	=head2 get_logger
		447
		448	my $logger = C4::SIP::SIPServer::get_logger()
		449
		450	@RETURNS Koha::Logger, the logger used to log this SIP-transaction
		451
		452	=cut
		453
		454	sub get_logger {
		455	unless($activeLogger) {
		456	my @cc = caller(1);
		457	die "$cc[3]() asks for \$activeLogger, but he is not defined yet";
		458	}
		459	return $activeLogger;
		460	}
		461
		462	sub _set_logger {
		463	my ($logger) = @_;
		464	unless (blessed($logger) && $logger->isa('Koha::Logger')) {
		465	my @cc = caller(0);
		466	die "$cc[3]():> \$logger '$logger' is not a Koha::Logger-object";
		467	}
		468	$activeLogger = $logger;
		469	return $activeLogger;
		470	}
		471
392	1;	472	1;
393		473
394	__END__	474	__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;