|
Lines 1-299
Link Here
|
| 1 |
#!/usr/bin/perl |
|
|
| 2 |
package C4::SIP::SIPServer; |
| 3 |
|
| 4 |
use strict; |
| 5 |
use warnings; |
| 6 |
use FindBin qw($Bin); |
| 7 |
use lib "$Bin"; |
| 8 |
use Sys::Syslog qw(syslog); |
| 9 |
use Net::Server::PreFork; |
| 10 |
use IO::Socket::INET; |
| 11 |
use Socket qw(:DEFAULT :crlf); |
| 12 |
require UNIVERSAL::require; |
| 13 |
|
| 14 |
use C4::SIP::Sip::Constants qw(:all); |
| 15 |
use C4::SIP::Sip::Configuration; |
| 16 |
use C4::SIP::Sip::Checksum qw(checksum verify_cksum); |
| 17 |
use C4::SIP::Sip::MsgType qw( handle login_core ); |
| 18 |
use C4::SIP::Sip qw( read_SIP_packet ); |
| 19 |
|
| 20 |
use base qw(Net::Server::PreFork); |
| 21 |
|
| 22 |
use constant LOG_SIP => "local6"; # Local alias for the logging facility |
| 23 |
|
| 24 |
# |
| 25 |
# Main # not really, since package SIPServer |
| 26 |
# |
| 27 |
# FIXME: Is this a module or a script? |
| 28 |
# A script with no MAIN namespace? |
| 29 |
# A module that takes command line args? |
| 30 |
|
| 31 |
my %transports = ( |
| 32 |
RAW => \&raw_transport, |
| 33 |
telnet => \&telnet_transport, |
| 34 |
); |
| 35 |
|
| 36 |
# |
| 37 |
# Read configuration |
| 38 |
# |
| 39 |
my $config = C4::SIP::Sip::Configuration->new( $ARGV[0] ); |
| 40 |
my @parms; |
| 41 |
|
| 42 |
# |
| 43 |
# Ports to bind |
| 44 |
# |
| 45 |
foreach my $svc (keys %{$config->{listeners}}) { |
| 46 |
push @parms, "port=" . $svc; |
| 47 |
} |
| 48 |
|
| 49 |
# |
| 50 |
# Logging |
| 51 |
# |
| 52 |
# Log lines look like this: |
| 53 |
# Jun 16 21:21:31 server08 steve_sip[19305]: ILS::Transaction::Checkout performing checkout... |
| 54 |
# [ TIMESTAMP ] [ HOST ] [ IDENT ] PID : Message... |
| 55 |
# |
| 56 |
# The IDENT is determined by config file 'server-params' arguments |
| 57 |
|
| 58 |
|
| 59 |
# |
| 60 |
# Server Management: set parameters for the Net::Server::PreFork |
| 61 |
# module. The module silently ignores parameters that it doesn't |
| 62 |
# recognize, and complains about invalid values for parameters |
| 63 |
# that it does. |
| 64 |
# |
| 65 |
if (defined($config->{'server-params'})) { |
| 66 |
while (my ($key, $val) = each %{$config->{'server-params'}}) { |
| 67 |
push @parms, $key . '=' . $val; |
| 68 |
} |
| 69 |
} |
| 70 |
|
| 71 |
|
| 72 |
# |
| 73 |
# This is the main event. |
| 74 |
__PACKAGE__ ->run(@parms); |
| 75 |
|
| 76 |
# |
| 77 |
# Child |
| 78 |
# |
| 79 |
|
| 80 |
# process_request is the callback used by Net::Server to handle |
| 81 |
# an incoming connection request. |
| 82 |
|
| 83 |
sub process_request { |
| 84 |
my $self = shift; |
| 85 |
my $service; |
| 86 |
my ($sockaddr, $port, $proto); |
| 87 |
my $transport; |
| 88 |
|
| 89 |
$self->{config} = $config; |
| 90 |
|
| 91 |
my $sockname = getsockname(STDIN); |
| 92 |
|
| 93 |
# Check if socket connection is IPv6 before resolving address |
| 94 |
my $family = Socket::sockaddr_family($sockname); |
| 95 |
if ($family == AF_INET6) { |
| 96 |
($port, $sockaddr) = sockaddr_in6($sockname); |
| 97 |
$sockaddr = Socket::inet_ntop(AF_INET6, $sockaddr); |
| 98 |
} else { |
| 99 |
($port, $sockaddr) = sockaddr_in($sockname); |
| 100 |
$sockaddr = inet_ntoa($sockaddr); |
| 101 |
} |
| 102 |
$proto = $self->{server}->{client}->NS_proto(); |
| 103 |
|
| 104 |
$self->{service} = $config->find_service($sockaddr, $port, $proto); |
| 105 |
|
| 106 |
if (!defined($self->{service})) { |
| 107 |
syslog("LOG_ERR", "process_request: Unknown recognized server connection: %s:%s/%s", $sockaddr, $port, $proto); |
| 108 |
die "process_request: Bad server connection"; |
| 109 |
} |
| 110 |
|
| 111 |
$transport = $transports{$self->{service}->{transport}}; |
| 112 |
|
| 113 |
if (!defined($transport)) { |
| 114 |
syslog("LOG_WARNING", "Unknown transport '%s', dropping", $service->{transport}); |
| 115 |
return; |
| 116 |
} else { |
| 117 |
&$transport($self); |
| 118 |
} |
| 119 |
} |
| 120 |
|
| 121 |
# |
| 122 |
# Transports |
| 123 |
# |
| 124 |
|
| 125 |
sub raw_transport { |
| 126 |
my $self = shift; |
| 127 |
my ($input); |
| 128 |
my $service = $self->{service}; |
| 129 |
|
| 130 |
while (!$self->{account}) { |
| 131 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
| 132 |
syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); |
| 133 |
$input = read_SIP_packet(*STDIN); |
| 134 |
if (!$input) { |
| 135 |
# EOF on the socket |
| 136 |
syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
| 137 |
return; |
| 138 |
} |
| 139 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
| 140 |
last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN); |
| 141 |
} |
| 142 |
|
| 143 |
syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
| 144 |
$self->{account}->{id}, |
| 145 |
$self->{account}->{institution}); |
| 146 |
|
| 147 |
$self->sip_protocol_loop(); |
| 148 |
syslog("LOG_INFO", "raw_transport: shutting down"); |
| 149 |
} |
| 150 |
|
| 151 |
sub get_clean_string { |
| 152 |
my $string = shift; |
| 153 |
if (defined $string) { |
| 154 |
syslog("LOG_DEBUG", "get_clean_string pre-clean(length %s): %s", length($string), $string); |
| 155 |
chomp($string); |
| 156 |
$string =~ s/^[^A-z0-9]+//; |
| 157 |
$string =~ s/[^A-z0-9]+$//; |
| 158 |
syslog("LOG_DEBUG", "get_clean_string post-clean(length %s): %s", length($string), $string); |
| 159 |
} else { |
| 160 |
syslog("LOG_INFO", "get_clean_string called on undefined"); |
| 161 |
} |
| 162 |
return $string; |
| 163 |
} |
| 164 |
|
| 165 |
sub get_clean_input { |
| 166 |
local $/ = "\012"; |
| 167 |
my $in = <STDIN>; |
| 168 |
$in = get_clean_string($in); |
| 169 |
while (my $extra = <STDIN>){ |
| 170 |
syslog("LOG_ERR", "get_clean_input got extra lines: %s", $extra); |
| 171 |
} |
| 172 |
return $in; |
| 173 |
} |
| 174 |
|
| 175 |
sub telnet_transport { |
| 176 |
my $self = shift; |
| 177 |
my ($uid, $pwd); |
| 178 |
my $strikes = 3; |
| 179 |
my $account = undef; |
| 180 |
my $input; |
| 181 |
my $config = $self->{config}; |
| 182 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
| 183 |
syslog("LOG_DEBUG", "telnet_transport: timeout is %s", $timeout); |
| 184 |
|
| 185 |
eval { |
| 186 |
local $SIG{ALRM} = sub { die "telnet_transport: Timed Out ($timeout seconds)!\n"; }; |
| 187 |
local $| = 1; # Unbuffered output |
| 188 |
$/ = "\015"; # Internet Record Separator (lax version) |
| 189 |
# Until the terminal has logged in, we don't trust it |
| 190 |
# so use a timeout to protect ourselves from hanging. |
| 191 |
|
| 192 |
while ($strikes--) { |
| 193 |
print "login: "; |
| 194 |
alarm $timeout; |
| 195 |
# $uid = &get_clean_input; |
| 196 |
$uid = <STDIN>; |
| 197 |
print "password: "; |
| 198 |
# $pwd = &get_clean_input || ''; |
| 199 |
$pwd = <STDIN>; |
| 200 |
alarm 0; |
| 201 |
|
| 202 |
syslog("LOG_DEBUG", "telnet_transport 1: uid length %s, pwd length %s", length($uid), length($pwd)); |
| 203 |
$uid = get_clean_string ($uid); |
| 204 |
$pwd = get_clean_string ($pwd); |
| 205 |
syslog("LOG_DEBUG", "telnet_transport 2: uid length %s, pwd length %s", length($uid), length($pwd)); |
| 206 |
|
| 207 |
if (exists ($config->{accounts}->{$uid}) |
| 208 |
&& ($pwd eq $config->{accounts}->{$uid}->{password})) { |
| 209 |
$account = $config->{accounts}->{$uid}; |
| 210 |
if ( C4::SIP::Sip::MsgType::login_core($self,$uid,$pwd) ) { |
| 211 |
last; |
| 212 |
} |
| 213 |
} |
| 214 |
syslog("LOG_WARNING", "Invalid login attempt: '%s'", ($uid||'')); |
| 215 |
print("Invalid login$CRLF"); |
| 216 |
} |
| 217 |
}; # End of eval |
| 218 |
|
| 219 |
if ($@) { |
| 220 |
syslog("LOG_ERR", "telnet_transport: Login timed out"); |
| 221 |
die "Telnet Login Timed out"; |
| 222 |
} elsif (!defined($account)) { |
| 223 |
syslog("LOG_ERR", "telnet_transport: Login Failed"); |
| 224 |
die "Login Failure"; |
| 225 |
} else { |
| 226 |
print "Login OK. Initiating SIP$CRLF"; |
| 227 |
} |
| 228 |
|
| 229 |
$self->{account} = $account; |
| 230 |
syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); |
| 231 |
$self->sip_protocol_loop(); |
| 232 |
syslog("LOG_INFO", "telnet_transport: shutting down"); |
| 233 |
} |
| 234 |
|
| 235 |
# |
| 236 |
# The terminal has logged in, using either the SIP login process |
| 237 |
# over a raw socket, or via the pseudo-unix login provided by the |
| 238 |
# telnet transport. From that point on, both the raw and the telnet |
| 239 |
# processes are the same: |
| 240 |
sub sip_protocol_loop { |
| 241 |
my $self = shift; |
| 242 |
my $service = $self->{service}; |
| 243 |
my $config = $self->{config}; |
| 244 |
my $timeout = $self->{service}->{client_timeout} || $config->{client_timeout}; |
| 245 |
my $input; |
| 246 |
|
| 247 |
# The spec says the first message will be: |
| 248 |
# SIP v1: SC_STATUS |
| 249 |
# SIP v2: LOGIN (or SC_STATUS via telnet?) |
| 250 |
# But it might be SC_REQUEST_RESEND. As long as we get |
| 251 |
# SC_REQUEST_RESEND, we keep waiting. |
| 252 |
|
| 253 |
# Comprise reports that no other ILS actually enforces this |
| 254 |
# constraint, so we'll relax about it too. |
| 255 |
# Using the SIP "raw" login process, rather than telnet, |
| 256 |
# requires the LOGIN message and forces SIP 2.00. In that |
| 257 |
# case, the LOGIN message has already been processed (above). |
| 258 |
# |
| 259 |
# In short, we'll take any valid message here. |
| 260 |
#my $expect = SC_STATUS; |
| 261 |
local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; } if $timeout; |
| 262 |
my $expect = ''; |
| 263 |
while (1) { |
| 264 |
if ($timeout) { |
| 265 |
alarm $timeout; |
| 266 |
} |
| 267 |
$input = read_SIP_packet(*STDIN); |
| 268 |
unless ($input) { |
| 269 |
return; # EOF |
| 270 |
} |
| 271 |
# begin input hacks ... a cheap stand in for better Telnet layer |
| 272 |
$input =~ s/^[^A-z0-9]+//s; # Kill leading bad characters... like Telnet handshakers |
| 273 |
$input =~ s/[^A-z0-9]+$//s; # Same on the end, should get DOSsy ^M line-endings too. |
| 274 |
while (chomp($input)) {warn "Extra line ending on input";} |
| 275 |
unless ($input) { |
| 276 |
syslog("LOG_ERR", "sip_protocol_loop: empty input skipped"); |
| 277 |
print("96$CR"); |
| 278 |
next; |
| 279 |
} |
| 280 |
# end cheap input hacks |
| 281 |
my $status = handle($input, $self, $expect); |
| 282 |
if (!$status) { |
| 283 |
syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2)); |
| 284 |
} |
| 285 |
next if $status eq REQUEST_ACS_RESEND; |
| 286 |
if ($expect && ($status ne $expect)) { |
| 287 |
# We received a non-"RESEND" that wasn't what we were expecting. |
| 288 |
syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input); |
| 289 |
} |
| 290 |
# We successfully received and processed what we were expecting |
| 291 |
$expect = ''; |
| 292 |
if ($timeout ) { |
| 293 |
alarm 0; |
| 294 |
} |
| 295 |
} |
| 296 |
} |
| 297 |
|
| 298 |
1; |
| 299 |
__END__ |