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-22 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
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__
(-)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