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-21 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::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__
(-)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 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;
(-)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-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