Bug 8271 teach SIPServer.pm to set its own lib path

[koha_ffzg] / C4 / SIP / SIPServer.pm

diff --git a/C4/SIP/SIPServer.pm b/C4/SIP/SIPServer.pm
index b872e77..44c58b4 100644 (file)
--- a/C4/SIP/SIPServer.pm
+++ b/C4/SIP/SIPServer.pm
@@ -2,6 +2,8 @@ package SIPServer;
 
 use strict;
 use warnings;
+use FindBin qw($Bin);
+use lib "$Bin";
 # use Exporter;
 use Sys::Syslog qw(syslog);
 use Net::Server::PreFork;
@@ -21,7 +23,7 @@ use constant LOG_SIP => "local6"; # Local alias for the logging facility
 use vars qw(@ISA $VERSION);
 
 BEGIN {
-       $VERSION = 1.01;
+    $VERSION = 3.07.00.049;
        @ISA = qw(Net::Server::PreFork);
 }
 
@@ -35,7 +37,6 @@ BEGIN {
 my %transports = (
     RAW    => \&raw_transport,
     telnet => \&telnet_transport,
-    # http   => \&http_transport,      # for http just use the OPAC
 );
 
 #
@@ -55,8 +56,12 @@ foreach my $svc (keys %{$config->{listeners}}) {
 #
 # Logging
 #
-push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server",
-  "syslog_facility=" . LOG_SIP;
+# Log lines look like this:
+# Jun 16 21:21:31 server08 steve_sip[19305]: ILS::Transaction::Checkout performing checkout...
+# [  TIMESTAMP  ] [ HOST ] [ IDENT ]  PID  : Message...
+#
+# The IDENT is determined by config file 'server-params' arguments
+
 
 #
 # Server Management: set parameters for the Net::Server::PreFork
@@ -70,6 +75,7 @@ if (defined($config->{'server-params'})) {
     }
 }
 
+print scalar(localtime),  " -- startup -- procid:$$\n";
 print "Params for Net::Server::PreFork : \n" . Dumper(\@parms);
 
 #
@@ -121,31 +127,18 @@ sub raw_transport {
     my $self = shift;
     my ($input);
     my $service = $self->{service};
-    my $strikes = 3;
 
-    eval {
-               local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
-               syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
-               while ($strikes--) {
-                   alarm $service->{timeout};
-                   $input = Sip::read_SIP_packet(*STDIN);
-                   alarm 0;
-                       if (!$input) {
-                               # EOF on the socket
-                               syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
-                               return;
-                   }
-                   $input =~ s/[\r\n]+$//sm;   # Strip off trailing line terminator(s)
-                   last if Sip::MsgType::handle($input, $self, LOGIN);
-               }
-       };
-
-    if (length $@) {
-               syslog("LOG_ERR", "raw_transport: LOGIN ERROR: '$@'");
-               die "raw_transport: login error (timeout? $@), exiting";
-    } elsif (!$self->{account}) {
-               syslog("LOG_ERR", "raw_transport: LOGIN FAILED");
-               die "raw_transport: Login failed (no account), exiting";
+    while (!$self->{account}) {
+    local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; };
+    syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout});
+    $input = Sip::read_SIP_packet(*STDIN);
+    if (!$input) {
+        # EOF on the socket
+        syslog("LOG_INFO", "raw_transport: shutting down: EOF during login");
+        return;
+    }
+    $input =~ s/[\r\n]+$//sm;  # Strip off trailing line terminator(s)
+    last if Sip::MsgType::handle($input, $self, LOGIN);
     }
 
     syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
@@ -156,7 +149,7 @@ sub raw_transport {
     syslog("LOG_INFO", "raw_transport: shutting down");
 }
 
-sub get_clean_string ($) {
+sub get_clean_string {
        my $string = shift;
        if (defined $string) {
                syslog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
@@ -211,13 +204,6 @@ sub telnet_transport {
                $uid = get_clean_string ($uid);
                $pwd = get_clean_string ($pwd);
                syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd));
-               # $uid =~ s/^\s+//;                     # 
-               # $pwd =~ s/^\s+//;                     # 
-           # $uid =~ s/[\r\n]+$//gms;  # 
-           # $pwd =~ s/[\r\n]+$//gms;  # 
-           # $uid =~ s/[[:cntrl:]]//g; # 
-           # $pwd =~ s/[[:cntrl:]]//g; # 
-               # syslog("LOG_DEBUG", "telnet_transport 3: uid length %s, pwd length %s", length($uid), length($pwd));
 
            if (exists ($config->{accounts}->{$uid})
                && ($pwd eq $config->{accounts}->{$uid}->password())) {
@@ -271,32 +257,29 @@ sub sip_protocol_loop {
        # In short, we'll take any valid message here.
        #my $expect = SC_STATUS;
     my $expect = '';
-    my $strikes = 3;
-    while ($input = Sip::read_SIP_packet(*STDIN)) {
+    while (1) {
+        $input = Sip::read_SIP_packet(*STDIN);
+        unless ($input) {
+            return;            # EOF
+        }
                # begin input hacks ...  a cheap stand in for better Telnet layer
                $input =~ s/^[^A-z0-9]+//s;     # Kill leading bad characters... like Telnet handshakers
                $input =~ s/[^A-z0-9]+$//s;     # Same on the end, should get DOSsy ^M line-endings too.
                while (chomp($input)) {warn "Extra line ending on input";}
                unless ($input) {
-                       if ($strikes--) {
-                               syslog("LOG_ERR", "sip_protocol_loop: empty input skipped");
-                               next;
-                       } else {
-                               syslog("LOG_ERR", "sip_protocol_loop: quitting after too many errors");
-                               die "sip_protocol_loop: quitting after too many errors";
-                       }
+            syslog("LOG_ERR", "sip_protocol_loop: empty input skipped");
+            print("96$CR");
+            next;
                }
                # end cheap input hacks
                my $status = Sip::MsgType::handle($input, $self, $expect);
                if (!$status) {
                        syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2));
-                       die "sip_protocol_loop: failed Sip::MsgType::handle('$input', $self, '$expect')";
                }
                next if $status eq REQUEST_ACS_RESEND;
                if ($expect && ($status ne $expect)) {
                        # We received a non-"RESEND" that wasn't what we were expecting.
                    syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input);
-                       die "sip_protocol_loop: exiting: expected '$expect', received '$status'";
                }
                # We successfully received and processed what we were expecting
                $expect = '';