From 5aecb46ad05795d259dfe7f581e3519af5a07afd Mon Sep 17 00:00:00 2001 From: "Joe Atzberger (siptest" Date: Thu, 19 Jun 2008 22:23:00 -0500 Subject: [PATCH] SIP - Lots of regexp hacking of input streams and verbose debugging feedback. The basic problem is that the SIP logic doesn't know where the input is coming from. It might be a RAW socket, and it might be telnet. If it is telnet, although the specs declare a character set (from MS, unfortunately), they do not specify a telnet implementation. So you might get telnet handshaking or renegotiations in the middle of an otherwise peaceful session and these should not be taken as SIP commands. Patches include a move towards using $CRLF from Socket to avoid problems w/ foreign platform mapping \n and \r to \015 or \012. Signed-off-by: Joshua Ferraro --- C4/SIP/SIPServer.pm | 101 ++++++++++++++++++++++++++---------------- C4/SIP/Sip.pm | 51 +++++++++++++++------ C4/SIP/Sip/MsgType.pm | 68 ++++++++++++++++++++++++---- C4/SIP/t/SIPtest.pm | 3 +- 4 files changed, 160 insertions(+), 63 deletions(-) diff --git a/C4/SIP/SIPServer.pm b/C4/SIP/SIPServer.pm index cad52ea393..b872e77d13 100644 --- a/C4/SIP/SIPServer.pm +++ b/C4/SIP/SIPServer.pm @@ -6,7 +6,7 @@ use warnings; 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; @@ -70,7 +70,7 @@ if (defined($config->{'server-params'})) { } } -print "Params for Net::Server::PreFork : \n" . Dumper(@parms); +print "Params for Net::Server::PreFork : \n" . Dumper(\@parms); # # This is the main event. @@ -124,7 +124,7 @@ sub raw_transport { my $strikes = 3; eval { - local $SIG{ALRM} = sub { die "Timed Out!\n"; }; + 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}; @@ -135,7 +135,7 @@ sub raw_transport { syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); return; } - $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator + $input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) last if Sip::MsgType::handle($input, $self, LOGIN); } }; @@ -156,6 +156,30 @@ sub raw_transport { 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 = ; + $in = get_clean_string($in); + while (my $extra = ){ + syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra); + } + return $in; +} + sub telnet_transport { my $self = shift; my ($uid, $pwd); @@ -164,46 +188,44 @@ sub telnet_transport { my $input; my $config = $self->{config}; my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; - # syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout); + syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout); eval { - local $SIG{ALRM} = sub { die "Timed Out ($timeout seconds)!\n"; }; + 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. while ($strikes--) { print "login: "; alarm $timeout; + # $uid = &get_clean_input; $uid = ; - alarm 0; - - if (defined $uid) { print "password: "; - alarm $timeout; - $pwd = || ''; + # $pwd = &get_clean_input || ''; + $pwd = ; alarm 0; syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd)); - while (chomp($uid)) {1;} - while (chomp($pwd)) {1;} + $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)); + # $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())) { $account = $config->{accounts}->{$uid}; - last; + Sip::MsgType::login_core($self,$uid,$pwd) and last; } - } syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||'')); - print("Invalid login\n"); + print("Invalid login$CRLF"); } }; # End of eval @@ -214,7 +236,7 @@ sub telnet_transport { 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; @@ -233,26 +255,27 @@ sub sip_protocol_loop { 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 + + # 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. 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. - # - #my $expect = SC_STATUS; + # 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)) { - # begin cheap input hacks - $input =~ s/^\s+//; # Kill leading whitespace... a cheap stand in for better Telnet layer - $input =~ s/[\r\n]+$//sm; # Strip off any trailing line ends (chomp?) + # 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--) { diff --git a/C4/SIP/Sip.pm b/C4/SIP/Sip.pm index 7c82cdc014..558a1d4000 100644 --- a/C4/SIP/Sip.pm +++ b/C4/SIP/Sip.pm @@ -11,6 +11,7 @@ use Exporter; use Sys::Syslog qw(syslog); use POSIX qw(strftime); +use Socket qw(:crlf); use Sip::Constants qw(SIP_DATETIME); use Sip::Checksum qw(checksum); @@ -135,24 +136,46 @@ sub boolspace { } -# read_SIP_packet($file) -# # Read a packet from $file, using the correct record separator # sub read_SIP_packet { my $record; + my $fh = shift or syslog("LOG_ERR", "read_SIP_packet: no filehandle argument!"); + my $len1 = 999; + # local $/ = "\012"; # Internet Record Separator (lax version) { # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html - undef $!; - local $/ = "\r"; - unless (defined($record = readline(shift))) { - if ($!) { - syslog("LOG_ERR", "read_SIP_packet ERROR: $!"); - die "read_SIP_packet ERROR: $!"; + for (my $tries=1; $tries<=3; $tries++) { + undef $!; + $record = readline($fh); + if (defined($record)) { + while(chomp($record)){1;} + $len1 = length($record); + syslog("LOG_DEBUG", "read_SIP_packet, INPUT MSG: '$record'"); + $record =~ s/^\s*[^A-z0-9]+//s; + $record =~ s/[^A-z0-9]+$//s; + $record =~ s/\015?\012//g; + $record =~ s/\015?\012//s; + $record =~ s/\015*\012*$//s; # treat as one line to include the extra linebreaks we are trying to remove! + while(chomp($record)){1;} + if ($record) { + last; # success + } + } else { + if ($!) { + syslog("LOG_DEBUG", "read_SIP_packet (try #$tries) ERROR: $!"); + # die "read_SIP_packet ERROR: $!"; + warn "read_SIP_packet ERROR: $!"; + } } - # else reached EOF } } - syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record; + if ($record) { + my $len2 = length($record); + syslog("LOG_INFO", "read_SIP_packet, INPUT MSG: '$record'") if $record; + ($len1 != $len2) and syslog("LOG_DEBUG", "read_SIP_packet, trimmed %s character(s) (after chomps).", $len1-$len2); + } else { + syslog("LOG_WARNING", "read_SIP_packet input %s, end of input.", (defined($record)? "empty ($record)" : 'undefined')); + } return $record; } @@ -180,13 +203,13 @@ sub write_msg { $msg .= sprintf('%04.4X', $cksum); } - if ($file) { - print $file "$msg\r"; + print $file "$msg$CRLF"; + syslog("LOG_DEBUG", "write_msg outputting to $file"); } else { - print "$msg\r"; - syslog("LOG_INFO", "OUTPUT MSG: '$msg'"); + print "$msg$CRLF"; } + syslog("LOG_INFO", "OUTPUT MSG: '$msg'"); $last_response = $msg; } diff --git a/C4/SIP/Sip/MsgType.pm b/C4/SIP/Sip/MsgType.pm index b4dbfcc2d6..506355833d 100644 --- a/C4/SIP/Sip/MsgType.pm +++ b/C4/SIP/Sip/MsgType.pm @@ -286,7 +286,7 @@ sub new { # it's using the 2.00 login process, so it must support 2.00. $protocol_version = 2; } - syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): msgtag '%s', protocol %s", + syslog("LOG_DEBUG", "Sip::MsgType::new('%s', '%s...', '%s'): seq.no '%s', protocol %s", $class, substr($msg, 0, 10), $msgtag, $seqno, $protocol_version); # warn "SIP PROTOCOL: $protocol_version"; if (!exists($handlers{$msgtag})) { @@ -318,13 +318,11 @@ sub _initialize { $self->{fields} = {}; $self->{fixed_fields} = []; - chomp($msg); + chomp($msg); # These four are probably unnecessary now. $msg =~ tr/\cM//d; $msg =~ s/\^M$//; chomp($msg); - # syslog("LOG_DEBUG", "Sip::MsgType::_initialize('%s', '%s...')", $self->{name}, substr($msg, 0, 20)); - foreach my $field (@{$proto->{fields}}) { $self->{fields}->{$field} = undef; } @@ -477,7 +475,7 @@ sub build_patron_status { sub handle_patron_status { my ($self, $server) = @_; - #warn Dumper($server); + warn "handle_patron_status server: " . Dumper(\$server); my $ils = $server->{ils}; my $patron; my $resp = (PATRON_STATUS_RESP); @@ -777,6 +775,56 @@ sub handle_request_acs_resend { return REQUEST_ACS_RESEND; } +sub login_core ($$$) { + my $server = shift or return undef; + my $uid = shift; + my $pwd = shift; + my $status = 1; # Assume it all works + if (!exists($server->{config}->{accounts}->{$uid})) { + syslog("LOG_WARNING", "MsgType::login_core: Unknown login '$uid'"); + $status = 0; + } elsif ($server->{config}->{accounts}->{$uid}->{password} ne $pwd) { + syslog("LOG_WARNING", "MsgType::login_core: Invalid password for login '$uid'"); + $status = 0; + } else { + # Store the active account someplace handy for everybody else to find. + $server->{account} = $server->{config}->{accounts}->{$uid}; + my $inst = $server->{account}->{institution}; + $server->{institution} = $server->{config}->{institutions}->{$inst}; + $server->{policy} = $server->{institution}->{policy}; + $server->{sip_username} = $uid; + $server->{sip_password} = $pwd; + + my $auth_status = api_auth($uid,$pwd); + if (!$auth_status or $auth_status !~ /^ok$/i) { + syslog("LOG_WARNING", "api_auth failed for SIP terminal '%s' of '%s': %s", + $uid, $inst, ($auth_status||'unknown')); + $status = 0; + } else { + syslog("LOG_INFO", "Successful login/auth for '%s' of '%s'", $server->{account}->{id}, $inst); + # + # initialize connection to ILS + # + my $module = $server->{config}->{institutions}->{$inst}->{implementation}; + syslog("LOG_DEBUG", 'login_core: ' . Dumper($module)); + $module->use; + if ($@) { + syslog("LOG_ERR", "%s: Loading ILS implementation '%s' for institution '%s' failed", + $server->{service}, $module, $inst); + die("Failed to load ILS implementation '$module' for $inst"); + } + + # like ILS->new(), I think. + $server->{ils} = $module->new($server->{institution}, $server->{account}); + if (!$server->{ils}) { + syslog("LOG_ERR", "%s: ILS connection to '%s' failed", $server->{service}, $inst); + die("Unable to connect to ILS '$inst'"); + } + } + } + return $status; +} + sub handle_login { my ($self, $server) = @_; my ($uid_algorithm, $pwd_algorithm); @@ -788,14 +836,15 @@ sub handle_login { $fields = $self->{fields}; ($uid_algorithm, $pwd_algorithm) = @{$self->{fixed_fields}}; - $uid = $fields->{(FID_LOGIN_UID)}; - $pwd = $fields->{(FID_LOGIN_PWD)}; + $uid = $fields->{(FID_LOGIN_UID)}; # Terminal ID, not patron ID. + $pwd = $fields->{(FID_LOGIN_PWD)}; # Terminal PWD, not patron PWD. if ($uid_algorithm || $pwd_algorithm) { syslog("LOG_ERR", "LOGIN: Unsupported non-zero encryption method(s): uid = $uid_algorithm, pwd = $pwd_algorithm"); $status = 0; } - + else { $status = login_core($server,$uid,$pwd); } +=doc if (!exists($server->{config}->{accounts}->{$uid})) { syslog("LOG_WARNING", "MsgType::handle_login: Unknown login '$uid'"); $status = 0; @@ -838,7 +887,8 @@ sub handle_login { } } } - $self->write_msg(LOGIN_RESP . $status); +=cut + $self->write_msg(LOGIN_RESP . $status); return $status ? LOGIN : ''; } diff --git a/C4/SIP/t/SIPtest.pm b/C4/SIP/t/SIPtest.pm index 9f0efeb316..5c432b0b50 100644 --- a/C4/SIP/t/SIPtest.pm +++ b/C4/SIP/t/SIPtest.pm @@ -181,6 +181,7 @@ sub one_msg { chomp($resp); $resp =~ tr/\cM//d; + $resp =~ s/\015?\012$//; chomp($resp); if (!verify_cksum($resp)) { @@ -248,7 +249,7 @@ sub run_sip_tests { my ($sock, $seqno); $Sip::error_detection = 1; - $/ = "\r"; + $/ = "\015\012"; # must use correct record separator $sock = new IO::Socket::INET(PeerAddr => $server, Type => SOCK_STREAM); -- 2.20.1