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);
18
use C4::SIP::Sip qw(add_field);
(-)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 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;
(-)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/Koha/Logger.pm (-2 / +5 lines)
Lines 159-169 sub _check_conf { # check logfiles in log4perl config (at initialization) Link Here
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
(-)a/etc/log4perl.conf (-1 / +16 lines)
Lines 2-7 log4perl.logger.intranet = WARN, INTRANET Link Here
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