Revert "Bug 15253: (follow-up) Fix qa complaints"
[koha-equinox.git] / C4 / SIP / SIPServer.pm
index b3f67d4..2b73b98 100755 (executable)
@@ -5,17 +5,23 @@ use strict;
 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::Context;
+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
@@ -27,6 +33,9 @@ use constant LOG_SIP => "local6"; # Local alias for the logging facility
 # A script with no MAIN namespace?
 # A module that takes command line args?
 
+# Set interface to 'sip'
+C4::Context->interface('sip');
+
 my %transports = (
     RAW    => \&raw_transport,
     telnet => \&telnet_transport,
@@ -76,6 +85,9 @@ __PACKAGE__ ->run(@parms);
 # Child
 #
 
+my $activeSIPServer;
+my $activeLogger;
+
 # process_request is the callback used by Net::Server to handle
 # an incoming connection request.
 
@@ -87,6 +99,13 @@ sub process_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
@@ -134,9 +153,10 @@ sub raw_transport {
 
     # Timeout the while loop if we get stuck in it
     # In practice it should only iterate once but be prepared
-    local $SIG{ALRM} = sub { die 'raw transport Timed Out!' }
-    syslog('LOG_DEBUG', "raw_transport: timeout is $service->{timeout}");
-    alarm $service->{timeout};
+    local $SIG{ALRM} = sub { die 'raw transport Timed Out!' };
+    my $timeout = $self->get_timeout({ transport => 1 });
+    syslog('LOG_DEBUG', "raw_transport: timeout is $timeout");
+    alarm $timeout;
     while (!$self->{account}) {
         $input = read_request();
         if (!$input) {
@@ -144,11 +164,26 @@ sub raw_transport {
             syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
             return;
         }
-        $input =~ s/[\r\n]+$//sm;      # Strip off trailing line terminator(s)
-        last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
+        $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s)
+        my $reg = qr/^${\(LOGIN)}/;
+        last if $input !~ $reg ||
+            C4::SIP::Sip::MsgType::handle($input, $self, LOGIN);
     }
     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});
@@ -193,8 +228,8 @@ sub telnet_transport {
     my $account = undef;
     my $input;
     my $config  = $self->{config};
-       my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
-       syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout);
+    my $timeout = $self->get_timeout({ transport => 1 });
+    syslog("LOG_DEBUG", "telnet_transport: timeout is $timeout");
 
     eval {
        local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
@@ -253,14 +288,14 @@ sub telnet_transport {
 # telnet transport.  From that point on, both the raw and the telnet
 # processes are the same:
 sub sip_protocol_loop {
-       my $self = shift;
-       my $service = $self->{service};
-       my $config  = $self->{config};
-    my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
+    my $self = shift;
+    my $service = $self->{service};
+    my $config  = $self->{config};
+    my $timeout = $self->get_timeout({ client => 1 });
 
     # The spec says the first message will be:
-       #       SIP v1: SC_STATUS
-       #       SIP v2: LOGIN (or SC_STATUS via telnet?)
+    #     SIP v1: SC_STATUS
+    #     SIP v2: LOGIN (or SC_STATUS via telnet?)
     # But it might be SC_REQUEST_RESEND.  As long as we get
     # SC_REQUEST_RESEND, we keep waiting.
 
@@ -268,9 +303,9 @@ sub sip_protocol_loop {
     # constraint, so we'll relax about it too.
     # Using the SIP "raw" login process, rather than telnet,
     # requires the LOGIN message and forces SIP 2.00.  In that
-       # case, the LOGIN message has already been processed (above).
-       # 
-       # In short, we'll take any valid message here.
+    # case, the LOGIN message has already been processed (above).
+
+    # In short, we'll take any valid message here.
     eval {
         local $SIG{ALRM} = sub {
             syslog( 'LOG_DEBUG', 'Inactive: timed out' );
@@ -343,5 +378,101 @@ sub read_request {
       syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" );
       return $buffer;
 }
+
+# $server->get_timeout({ $type => 1, fallback => $fallback });
+#     where $type is transport | client | policy
+#
+# Centralizes all timeout logic.
+# Transport refers to login process, client to active connections.
+# Policy timeout is transaction timeout (used in ACS status message).
+#
+# Fallback is optional. If you do not pass transport, client or policy,
+# you will get fallback or hardcoded default.
+
+sub get_timeout {
+    my ( $server, $params ) = @_;
+    my $fallback = $params->{fallback} || 30;
+    my $service = $server->{service} // {};
+    my $config = $server->{config} // {};
+
+    if( $params->{transport} ||
+        ( $params->{client} && !exists $service->{client_timeout} )) {
+        # We do not allow zero values here.
+        # Note: config/timeout seems to be deprecated.
+        return $service->{timeout} || $config->{timeout} || $fallback;
+
+    } elsif( $params->{client} ) {
+        # We know that client_timeout exists now.
+        # We do allow zero values here to indicate no timeout.
+        return 0 if $service->{client_timeout} =~ /^0+$|\D/;
+        return $service->{client_timeout};
+
+    } elsif( $params->{policy} ) {
+        my $policy = $server->{policy} // {};
+        my $rv = sprintf( "%03d", $policy->{timeout} // 0 );
+        if( length($rv) != 3 ) {
+            syslog( "LOG_ERR", "Policy timeout has wrong size: '%s'", $rv );
+            return '000';
+        }
+        return $rv;
+
+    } else {
+        return $fallback;
+    }
+}
+
+=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__