X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=C4%2FSIP%2FSIPServer.pm;h=c6de11e46442778b105e58a1be631bbb48e5736d;hb=c9ba8c899d854d4190df783f3f1aec2989d2cb10;hp=15364b03bf374a377363d068107928dd0f317df0;hpb=68cdeccfe71917370c3dbee01103c6cf761799ee;p=koha_fer

diff --git a/C4/SIP/SIPServer.pm b/C4/SIP/SIPServer.pm
index 15364b03bf..c6de11e464 100644
--- a/C4/SIP/SIPServer.pm
+++ b/C4/SIP/SIPServer.pm
@@ -2,11 +2,11 @@ package SIPServer;
 
 use strict;
 use warnings;
-use Exporter;
+# use Exporter;
 use Sys::Syslog qw(syslog);
 use Net::Server::PreFork;
 use IO::Socket::INET;
-use Socket;
+use Socket qw(:DEFAULT :crlf);
 use Data::Dumper;		# For debugging
 require UNIVERSAL::require;
 
@@ -21,24 +21,28 @@ use constant LOG_SIP => "local6"; # Local alias for the logging facility
 use vars qw(@ISA $VERSION);
 
 BEGIN {
-	$VERSION = 1.00;
+	$VERSION = 1.02;
 	@ISA = qw(Net::Server::PreFork);
 }
 
 #
-# Main
+# Main	# not really, since package SIPServer
 #
+# FIXME: Is this a module or a script?  
+# A script with no MAIN namespace?
+# A module that takes command line args?
 
 my %transports = (
     RAW    => \&raw_transport,
     telnet => \&telnet_transport,
-    http   => \&http_transport,
+    # http   => \&http_transport,	# for http just use the OPAC
 );
 
+#
 # Read configuration
-
+#
 my $config = new Sip::Configuration $ARGV[0];
-
+print STDERR "SIPServer config: \n" . Dumper($config) . "\nEND SIPServer config.\n";
 my @parms;
 
 #
@@ -51,8 +55,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
@@ -62,15 +70,16 @@ push @parms, "log_file=Sys::Syslog", "syslog_ident=acs-server",
 #
 if (defined($config->{'server-params'})) {
     while (my ($key, $val) = each %{$config->{'server-params'}}) {
-	push @parms, $key . '=' . $val;
+		push @parms, $key . '=' . $val;
     }
 }
 
-print Dumper(@parms);
+print scalar(localtime),  " -- startup -- procid:$$\n";
+print "Params for Net::Server::PreFork : \n" . Dumper(\@parms);
 
 #
 # This is the main event.
-SIPServer->run(@parms);
+__PACKAGE__ ->run(@parms);
 
 #
 # Child
@@ -82,13 +91,12 @@ SIPServer->run(@parms);
 sub process_request {
     my $self = shift;
     my $service;
-    my $sockname;
     my ($sockaddr, $port, $proto);
     my $transport;
 
     $self->{config} = $config;
 
-    $sockname = getsockname(STDIN);
+    my $sockname = getsockname(STDIN);
     ($port, $sockaddr) = sockaddr_in($sockname);
     $sockaddr = inet_ntoa($sockaddr);
     $proto = $self->{server}->{client}->NS_proto();
@@ -96,17 +104,17 @@ sub process_request {
     $self->{service} = $config->find_service($sockaddr, $port, $proto);
 
     if (!defined($self->{service})) {
-	syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
-	die "process_request: Bad server connection";
+		syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto);
+		die "process_request: Bad server connection";
     }
 
     $transport = $transports{$self->{service}->{transport}};
 
     if (!defined($transport)) {
-	syslog("LOG_WARN", "Unknown transport '%s', dropping", $service->{transport});
-	return;
+		syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport});
+		return;
     } else {
-	&$transport($self);
+		&$transport($self);
     }
 }
 
@@ -116,39 +124,33 @@ sub process_request {
 
 sub raw_transport {
     my $self = shift;
-    my ($uid, $pwd);
-    my $input;
+    my ($input);
     my $service = $self->{service};
     my $strikes = 3;
-    my $expect;
-    my $inst;
 
     eval {
-	local $SIG{ALRM} = sub { die "alarm\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
-
-	    last if Sip::MsgType::handle($input, $self, LOGIN);
-	}
-    };
-
-    if ($@) {
-	syslog("LOG_ERR", "raw_transport: LOGIN ERROR: '$@'");
-	die "raw_transport: login error, exiting";
+		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, exiting";
+		syslog("LOG_ERR", "raw_transport: LOGIN FAILED");
+		die "raw_transport: Login failed (no account), exiting";
     }
 
     syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'",
@@ -156,123 +158,147 @@ sub raw_transport {
 	   $self->{account}->{institution});
 
     $self->sip_protocol_loop();
-
     syslog("LOG_INFO", "raw_transport: shutting down");
 }
 
+sub get_clean_string ($) {
+	my $string = shift;
+	if (defined $string) {
+		syslog("LOG_DEBUG", "get_clean_string  pre-clean(length %s): %s", length($string), $string);
+		chomp($string);
+		$string =~ s/^[^A-z0-9]+//;
+		$string =~ s/[^A-z0-9]+$//;
+		syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string);
+	} else {
+		syslog("LOG_INFO", "get_clean_string called on undefined");
+	}
+	return $string;
+}
+
+sub get_clean_input {
+	local $/ = "\012";
+	my $in = <STDIN>;
+	$in = get_clean_string($in);
+	while (my $extra = <STDIN>){
+		syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra);
+	}
+	return $in;
+}
+
 sub telnet_transport {
     my $self = shift;
     my ($uid, $pwd);
     my $strikes = 3;
     my $account = undef;
     my $input;
-    my $config = $self->{config};
+    my $config  = $self->{config};
+	my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30;
+	syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout);
 
+    eval {
+	local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; };
+	local $| = 1;			# Unbuffered output
+	$/ = "\015";		# Internet Record Separator (lax version)
     # Until the terminal has logged in, we don't trust it
     # so use a timeout to protect ourselves from hanging.
-    eval {
-	local $SIG{ALRM} = sub { die "alarm\n"; };
-	local $|;
-	my $timeout = 0;
-	$| = 1;			# Unbuffered output
-	$timeout = $config->{timeout} if (exists($config->{timeout}));
 
 	while ($strikes--) {
 	    print "login: ";
-	    alarm $timeout;
-	    $uid = <STDIN>;
-	    alarm 0;
-
+		alarm $timeout;
+		# $uid = &get_clean_input;
+		$uid = <STDIN>;
 	    print "password: ";
-	    alarm $timeout;
-	    $pwd = <STDIN>;
-	    alarm 0;
+	    # $pwd = &get_clean_input || '';
+		$pwd = <STDIN>;
+		alarm 0;
 
-	    $uid =~ s/[\r\n]+$//;
-	    $pwd =~ s/[\r\n]+$//;
+		syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd));
+		$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));
 
-	    if (exists($config->{accounts}->{$uid})
+	    if (exists ($config->{accounts}->{$uid})
 		&& ($pwd eq $config->{accounts}->{$uid}->password())) {
-		$account = $config->{accounts}->{$uid};
-		last;
-	    } else {
-		syslog("LOG_WARNING", "Invalid login attempt: '%s'", $uid);
-		print("Invalid login\n");
+			$account = $config->{accounts}->{$uid};
+			Sip::MsgType::login_core($self,$uid,$pwd) and last;
 	    }
+		syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||''));
+		print("Invalid login$CRLF");
 	}
     }; # End of eval
 
     if ($@) {
-	syslog("LOG_ERR", "telnet_transport: Login timed out");
-	die "Telnet Login Timed out";
+		syslog("LOG_ERR", "telnet_transport: Login timed out");
+		die "Telnet Login Timed out";
     } elsif (!defined($account)) {
-	syslog("LOG_ERR", "telnet_transport: Login Failed");
-	die "Login Failure";
+		syslog("LOG_ERR", "telnet_transport: Login Failed");
+		die "Login Failure";
     } else {
-	print "Login OK.  Initiating SIP\n";
+		print "Login OK.  Initiating SIP$CRLF";
     }
 
     $self->{account} = $account;
-
+    syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution});
     $self->sip_protocol_loop();
     syslog("LOG_INFO", "telnet_transport: shutting down");
 }
 
-
-sub http_transport {
-}
-
 #
 # The terminal has logged in, using either the SIP login process
 # over a raw socket, or via the pseudo-unix login provided by the
 # telnet transport.  From that point on, both the raw and the telnet
 # processes are the same:
 sub sip_protocol_loop {
-    my $self = shift;
-    my $expect;
-    my $service = $self->{service};
-    my $config = $self->{config};
-    my $input;
-    # Now that the terminal has logged in, the first message
-    # we recieve must be an SC_STATUS message.  But it might be
-    # an SC_REQUEST_RESEND.  So, as long as we keep receiving
-    # SC_REQUEST_RESEND, we keep waiting for an SC_STATUS
+	my $self = shift;
+	my $service = $self->{service};
+	my $config  = $self->{config};
+	my $input;
 
-    # Comprise reports that no other ILS actually enforces this
-    # constraint, so we'll relax about it too.  As long as everybody
-    # uses the SIP "raw" login process, rather than telnet, this
-    # will be fine, becaues the LOGIN protocol exchange will force
-    # us into SIP 2.00 anyway.  Machines that want to log in using
-    # telnet MUST send an SC Status message first, even though we're
-    # not enforcing it.
-    # 
-    #$expect = SC_STATUS;
-    $expect = '';
+    # The spec says the first message will be:
+	# 	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.
 
+    # Comprise reports that no other ILS actually enforces this
+    # 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.
+	#my $expect = SC_STATUS;
+    my $expect = '';
+    my $strikes = 3;
     while ($input = Sip::read_SIP_packet(*STDIN)) {
-	my $status;
-
-	$input =~ s/[\r\n]+$//sm;	# Strip off any trailing line ends
-
-	$status = Sip::MsgType::handle($input, $self, $expect);
-	next if $status eq REQUEST_ACS_RESEND;
-#### stopped here rch
-	if (!$status) {
-	    syslog("LOG_ERR", "raw_transport: failed to handle %s",
-		   substr($input, 0, 2));
-	    die "raw_transport: dying";
-	} elsif ($expect && ($status ne $expect)) {
-	    # We received a non-"RESEND" that wasn't what we were
-	    # expecting.
-	    syslog("LOG_ERR",
-		   "raw_transport: expected %s, received %s, exiting",
-		   $expect, $input);
-	    die "raw_transport: exiting: expected '$expect', received '$status'";
+		# 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";
+			}
+		}
+		# 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 = '';
 	}
-	# We successfully received and processed what we were expecting
-	# to receive
-	$expect = '';
-    }
 }
 
 1;