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

(-)a/C4/SIP/ILS.pm (-1 / +1 lines)
Lines 6-12 package C4::SIP::ILS; Link Here
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;
(-)a/C4/SIP/ILS/Item.pm (-1 / +1 lines)
Lines 9-15 package C4::SIP::ILS::Item; Link Here
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
(-)a/C4/SIP/ILS/Patron.pm (-1 / +1 lines)
Lines 12-18 use warnings; Link Here
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 maybe_add);
18
use C4::SIP::Sip qw(add_field maybe_add);
(-)a/C4/SIP/ILS/Transaction/Checkout.pm (-1 / +1 lines)
Lines 8-14 use warnings; Link Here
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
(-)a/C4/SIP/ILS/Transaction/RenewAll.pm (-1 / +1 lines)
Lines 6-12 package C4::SIP::ILS::Transaction::RenewAll; Link Here
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
(-)a/C4/SIP/SIPServer.pm (-1 / +81 lines)
Lines 5-23 use strict; Link Here
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__
(-)a/C4/SIP/Sip.pm (-3 / +17 lines)
Lines 8-14 use strict; Link Here
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 204-207 sub write_msg { Link Here
204
    $last_response = $msg;
203
    $last_response = $msg;
205
}
204
}
206
205
206
sub syslog {
207
    my ( $level, $mask, @args ) = @_;
208
209
    my $method =
210
        $level eq 'LOG_ERR'     ? 'error'
211
      : $level eq 'LOG_DEBUG'   ? 'debug'
212
      : $level eq 'LOG_INFO'    ? 'info'
213
      : $level eq 'LOG_WARNING' ? 'warn'
214
      :                           'error';
215
216
    my $message = @args ? sprintf($mask, @args) : $mask;
217
218
    C4::SIP::SIPServer::get_logger()->$method($message);
219
}
220
207
1;
221
1;
(-)a/C4/SIP/Sip/Configuration.pm (-1 / +3 lines)
Lines 10-15 use strict; Link Here
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
    }
(-)a/C4/SIP/Sip/MsgType.pm (-1 lines)
Lines 9-15 package C4::SIP::Sip::MsgType; Link Here
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);
(-)a/C4/SIP/Trapper.pm (+22 lines)
Line 0 Link Here
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;
(-)a/etc/log4perl.conf (-1 / +8 lines)
Lines 21-23 log4perl.appender.Z3950.mode=append Link Here
21
log4perl.appender.Z3950.layout=PatternLayout
21
log4perl.appender.Z3950.layout=PatternLayout
22
log4perl.appender.Z3950.layout.ConversionPattern=[%d] [%p] %m %l %n
22
log4perl.appender.Z3950.layout.ConversionPattern=[%d] [%p] %m %l %n
23
log4perl.appender.Z3950.utf8=1
23
log4perl.appender.Z3950.utf8=1
24
- 
24
25
log4perl.logger.sip = DEBUG, SIP
26
log4perl.appender.SIP=Log::Log4perl::Appender::File
27
log4perl.appender.SIP.filename=__LOG_DIR__/sip2.log
28
log4perl.appender.SIP.mode=append
29
log4perl.appender.SIP.layout=PatternLayout
30
log4perl.appender.SIP.layout.ConversionPattern=[%d] [%p] %X{accountid}@%X{peeraddr}: %m %l %n
31
log4perl.appender.SIP.utf8=1

Return to bug 15253