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 <jmf@liblime.com>
This commit is contained in:
Joe Atzberger (siptest
Joshua Ferraro
parent
c5ac051f70
commit
5aecb46ad0
4 changed files with 160 additions and 63 deletions
|
|
@ -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 = <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);
|
||||
|
|
@ -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 = <STDIN>;
|
||||
alarm 0;
|
||||
|
||||
if (defined $uid) {
|
||||
print "password: ";
|
||||
alarm $timeout;
|
||||
$pwd = <STDIN> || '';
|
||||
# $pwd = &get_clean_input || '';
|
||||
$pwd = <STDIN>;
|
||||
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--) {
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 : '';
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
Loading…
Reference in a new issue