|
Lines 6-12
use warnings;
Link Here
|
| 6 |
use FindBin qw($Bin); |
6 |
use FindBin qw($Bin); |
| 7 |
use lib "$Bin"; |
7 |
use lib "$Bin"; |
| 8 |
use Sys::Syslog qw(syslog); |
8 |
use Sys::Syslog qw(syslog); |
| 9 |
use Net::Server::PreFork; |
|
|
| 10 |
use IO::Socket::INET; |
9 |
use IO::Socket::INET; |
| 11 |
use Socket qw(:DEFAULT :crlf); |
10 |
use Socket qw(:DEFAULT :crlf); |
| 12 |
require UNIVERSAL::require; |
11 |
require UNIVERSAL::require; |
|
Lines 17-23
use C4::SIP::Sip::Checksum qw(checksum verify_cksum);
Link Here
|
| 17 |
use C4::SIP::Sip::MsgType qw( handle login_core ); |
16 |
use C4::SIP::Sip::MsgType qw( handle login_core ); |
| 18 |
use C4::SIP::Sip qw( read_SIP_packet ); |
17 |
use C4::SIP::Sip qw( read_SIP_packet ); |
| 19 |
|
18 |
|
| 20 |
use base qw(Net::Server::PreFork); |
19 |
use base qw(Net::Server::Fork); |
| 21 |
|
20 |
|
| 22 |
use constant LOG_SIP => "local6"; # Local alias for the logging facility |
21 |
use constant LOG_SIP => "local6"; # Local alias for the logging facility |
| 23 |
|
22 |
|
|
Lines 124-151
sub process_request {
Link Here
|
| 124 |
|
123 |
|
| 125 |
sub raw_transport { |
124 |
sub raw_transport { |
| 126 |
my $self = shift; |
125 |
my $self = shift; |
| 127 |
my ($input); |
|
|
| 128 |
my $service = $self->{service}; |
126 |
my $service = $self->{service}; |
| 129 |
|
127 |
|
| 130 |
while (!$self->{account}) { |
128 |
while (!$self->{account}) { |
| 131 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
129 |
my $input = read_request(); |
| 132 |
syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); |
130 |
if (!$input) { |
| 133 |
$input = read_SIP_packet(*STDIN); |
131 |
# EOF on the socket |
| 134 |
if (!$input) { |
132 |
syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
| 135 |
# EOF on the socket |
133 |
return; |
| 136 |
syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
134 |
} |
| 137 |
return; |
135 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
| 138 |
} |
136 |
last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN); |
| 139 |
$input =~ s/[\r\n]+$//sm; # Strip off trailing line terminator(s) |
|
|
| 140 |
last if C4::SIP::Sip::MsgType::handle($input, $self, LOGIN); |
| 141 |
} |
137 |
} |
| 142 |
|
138 |
|
| 143 |
syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
139 |
syslog("LOG_DEBUG", "raw_transport: uname/inst: '%s/%s'", |
| 144 |
$self->{account}->{id}, |
140 |
$self->{account}->{id}, |
| 145 |
$self->{account}->{institution}); |
141 |
$self->{account}->{institution}); |
| 146 |
|
142 |
|
| 147 |
$self->sip_protocol_loop(); |
143 |
$self->sip_protocol_loop(); |
| 148 |
syslog("LOG_INFO", "raw_transport: shutting down"); |
144 |
syslog("LOG_INFO", "raw_transport: shutting down"); |
|
|
145 |
return; |
| 149 |
} |
146 |
} |
| 150 |
|
147 |
|
| 151 |
sub get_clean_string { |
148 |
sub get_clean_string { |
|
Lines 230-235
sub telnet_transport {
Link Here
|
| 230 |
syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); |
227 |
syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); |
| 231 |
$self->sip_protocol_loop(); |
228 |
$self->sip_protocol_loop(); |
| 232 |
syslog("LOG_INFO", "telnet_transport: shutting down"); |
229 |
syslog("LOG_INFO", "telnet_transport: shutting down"); |
|
|
230 |
return; |
| 233 |
} |
231 |
} |
| 234 |
|
232 |
|
| 235 |
# |
233 |
# |
|
Lines 241-248
sub sip_protocol_loop {
Link Here
|
| 241 |
my $self = shift; |
239 |
my $self = shift; |
| 242 |
my $service = $self->{service}; |
240 |
my $service = $self->{service}; |
| 243 |
my $config = $self->{config}; |
241 |
my $config = $self->{config}; |
| 244 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
|
|
| 245 |
my $input; |
| 246 |
|
242 |
|
| 247 |
# The spec says the first message will be: |
243 |
# The spec says the first message will be: |
| 248 |
# SIP v1: SC_STATUS |
244 |
# SIP v1: SC_STATUS |
|
Lines 258-294
sub sip_protocol_loop {
Link Here
|
| 258 |
# |
254 |
# |
| 259 |
# In short, we'll take any valid message here. |
255 |
# In short, we'll take any valid message here. |
| 260 |
#my $expect = SC_STATUS; |
256 |
#my $expect = SC_STATUS; |
| 261 |
local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; }; |
257 |
while ( my $inputbuf = read_request() ) { |
| 262 |
my $expect = ''; |
258 |
if ( !defined $inputbuf ) { |
| 263 |
while (1) { |
259 |
return; # EOF |
| 264 |
alarm $timeout; |
|
|
| 265 |
$input = read_SIP_packet(*STDIN); |
| 266 |
unless ($input) { |
| 267 |
return; # EOF |
| 268 |
} |
260 |
} |
| 269 |
# begin input hacks ... a cheap stand in for better Telnet layer |
261 |
|
| 270 |
$input =~ s/^[^A-z0-9]+//s; # Kill leading bad characters... like Telnet handshakers |
262 |
unless ($inputbuf) { |
| 271 |
$input =~ s/[^A-z0-9]+$//s; # Same on the end, should get DOSsy ^M line-endings too. |
263 |
syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" ); |
| 272 |
while (chomp($input)) {warn "Extra line ending on input";} |
|
|
| 273 |
unless ($input) { |
| 274 |
syslog("LOG_ERR", "sip_protocol_loop: empty input skipped"); |
| 275 |
print("96$CR"); |
264 |
print("96$CR"); |
| 276 |
next; |
265 |
next; |
| 277 |
} |
266 |
} |
| 278 |
# end cheap input hacks |
267 |
|
| 279 |
my $status = handle($input, $self, $expect); |
268 |
# end cheap input hacks |
| 280 |
if (!$status) { |
269 |
my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} ); |
| 281 |
syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2)); |
270 |
if ( !$status ) { |
| 282 |
} |
271 |
syslog( |
| 283 |
next if $status eq REQUEST_ACS_RESEND; |
272 |
"LOG_ERR", |
| 284 |
if ($expect && ($status ne $expect)) { |
273 |
"sip_protocol_loop: failed to handle %s", |
| 285 |
# We received a non-"RESEND" that wasn't what we were expecting. |
274 |
substr( $inputbuf, 0, 2 ) |
| 286 |
syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input); |
275 |
); |
| 287 |
} |
276 |
} |
| 288 |
# We successfully received and processed what we were expecting |
277 |
next if $status eq REQUEST_ACS_RESEND; |
| 289 |
$expect = ''; |
278 |
} |
| 290 |
alarm 0; |
279 |
return; |
| 291 |
} |
280 |
} |
|
|
281 |
|
| 282 |
sub read_request { |
| 283 |
my $raw_length; |
| 284 |
local $/ = "\015"; |
| 285 |
|
| 286 |
# proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return |
| 287 |
my $buffer = <STDIN>; |
| 288 |
if ( defined $buffer ) { |
| 289 |
STDIN->flush(); # clear an extra linefeed |
| 290 |
chomp $buffer; |
| 291 |
syslog( "LOG_INFO", "read_SIP_packet, INPUT MSG: '$buffer'" ); |
| 292 |
$raw_length = length $buffer; |
| 293 |
$buffer =~ s/^\s*[^A-z0-9]+//s; |
| 294 |
# Every line must start with a "real" character. Not whitespace, control chars, etc. |
| 295 |
$buffer =~ s/[^A-z0-9]+$//s; |
| 296 |
|
| 297 |
# Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| |
| 298 |
$buffer =~ s/\015?\012//g; # Extra line breaks must die |
| 299 |
$buffer =~ s/\015?\012//s; # Extra line breaks must die |
| 300 |
$buffer =~ s/\015*\012*$//s; |
| 301 |
|
| 302 |
# treat as one line to include the extra linebreaks we are trying to remove! |
| 303 |
} |
| 304 |
else { |
| 305 |
syslog( 'LOG_DEBUG', 'EOF returned on read' ); |
| 306 |
return; |
| 307 |
} |
| 308 |
my $len = length $buffer; |
| 309 |
if ( $len != $raw_length ) { |
| 310 |
my $trim = $raw_length - $len; |
| 311 |
syslog( "LOG_DEBUG", "read_SIP_packet, trimmed $trim character(s) " ); |
| 312 |
} |
| 313 |
|
| 314 |
syslog( "LOG_INFO", "INPUT MSG: '$buffer'" ); |
| 315 |
return $buffer; |
| 292 |
} |
316 |
} |
| 293 |
|
317 |
|
| 294 |
1; |
318 |
1; |