Lines 15-21
use C4::SIP::Sip::Constants qw(:all);
Link Here
|
15 |
use C4::SIP::Sip::Configuration; |
15 |
use C4::SIP::Sip::Configuration; |
16 |
use C4::SIP::Sip::Checksum qw(checksum verify_cksum); |
16 |
use C4::SIP::Sip::Checksum qw(checksum verify_cksum); |
17 |
use C4::SIP::Sip::MsgType qw( handle login_core ); |
17 |
use C4::SIP::Sip::MsgType qw( handle login_core ); |
18 |
use C4::SIP::Sip qw( read_SIP_packet ); |
|
|
19 |
|
18 |
|
20 |
use base qw(Net::Server::PreFork); |
19 |
use base qw(Net::Server::PreFork); |
21 |
|
20 |
|
Lines 116-121
sub process_request {
Link Here
|
116 |
} else { |
115 |
} else { |
117 |
&$transport($self); |
116 |
&$transport($self); |
118 |
} |
117 |
} |
|
|
118 |
return; |
119 |
} |
119 |
} |
120 |
|
120 |
|
121 |
# |
121 |
# |
Lines 130-136
sub raw_transport {
Link Here
|
130 |
while (!$self->{account}) { |
130 |
while (!$self->{account}) { |
131 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
131 |
local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; |
132 |
syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); |
132 |
syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); |
133 |
$input = read_SIP_packet(*STDIN); |
133 |
$input = read_request(); |
134 |
if (!$input) { |
134 |
if (!$input) { |
135 |
# EOF on the socket |
135 |
# EOF on the socket |
136 |
syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
136 |
syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); |
Lines 146-151
sub raw_transport {
Link Here
|
146 |
|
146 |
|
147 |
$self->sip_protocol_loop(); |
147 |
$self->sip_protocol_loop(); |
148 |
syslog("LOG_INFO", "raw_transport: shutting down"); |
148 |
syslog("LOG_INFO", "raw_transport: shutting down"); |
|
|
149 |
return; |
149 |
} |
150 |
} |
150 |
|
151 |
|
151 |
sub get_clean_string { |
152 |
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}); |
231 |
syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); |
231 |
$self->sip_protocol_loop(); |
232 |
$self->sip_protocol_loop(); |
232 |
syslog("LOG_INFO", "telnet_transport: shutting down"); |
233 |
syslog("LOG_INFO", "telnet_transport: shutting down"); |
|
|
234 |
return; |
233 |
} |
235 |
} |
234 |
|
236 |
|
235 |
# |
237 |
# |
Lines 242-248
sub sip_protocol_loop {
Link Here
|
242 |
my $service = $self->{service}; |
244 |
my $service = $self->{service}; |
243 |
my $config = $self->{config}; |
245 |
my $config = $self->{config}; |
244 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
246 |
my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; |
245 |
my $input; |
|
|
246 |
|
247 |
|
247 |
# The spec says the first message will be: |
248 |
# The spec says the first message will be: |
248 |
# SIP v1: SC_STATUS |
249 |
# SIP v1: SC_STATUS |
Lines 257-295
sub sip_protocol_loop {
Link Here
|
257 |
# case, the LOGIN message has already been processed (above). |
258 |
# case, the LOGIN message has already been processed (above). |
258 |
# |
259 |
# |
259 |
# In short, we'll take any valid message here. |
260 |
# In short, we'll take any valid message here. |
260 |
#my $expect = SC_STATUS; |
261 |
eval { |
261 |
local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; }; |
262 |
local $SIG{ALRM} = sub { |
262 |
my $expect = ''; |
263 |
syslog( 'LOG_DEBUG', 'Inactive: timed out' ); |
263 |
while (1) { |
264 |
die "Timed Out!\n"; |
264 |
alarm $timeout; |
265 |
}; |
265 |
$input = read_SIP_packet(*STDIN); |
266 |
my $previous_alarm = alarm($timeout); |
266 |
unless ($input) { |
267 |
|
267 |
return; # EOF |
268 |
while ( my $inputbuf = read_request() ) { |
|
|
269 |
if ( !defined $inputbuf ) { |
270 |
return; #EOF |
271 |
} |
272 |
alarm($timeout); |
273 |
|
274 |
unless ($inputbuf) { |
275 |
syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" ); |
276 |
print("96$CR"); |
277 |
next; |
278 |
} |
279 |
|
280 |
my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} ); |
281 |
if ( !$status ) { |
282 |
syslog( |
283 |
"LOG_ERR", |
284 |
"sip_protocol_loop: failed to handle %s", |
285 |
substr( $inputbuf, 0, 2 ) |
286 |
); |
287 |
} |
288 |
next if $status eq REQUEST_ACS_RESEND; |
268 |
} |
289 |
} |
269 |
# begin input hacks ... a cheap stand in for better Telnet layer |
290 |
alarm($previous_alarm); |
270 |
$input =~ s/^[^A-z0-9]+//s; # Kill leading bad characters... like Telnet handshakers |
291 |
return; |
271 |
$input =~ s/[^A-z0-9]+$//s; # Same on the end, should get DOSsy ^M line-endings too. |
292 |
}; |
272 |
while (chomp($input)) {warn "Extra line ending on input";} |
293 |
if ( $@ =~ m/timed out/i ) { |
273 |
unless ($input) { |
294 |
return; |
274 |
syslog("LOG_ERR", "sip_protocol_loop: empty input skipped"); |
295 |
} |
275 |
print("96$CR"); |
296 |
return; |
276 |
next; |
|
|
277 |
} |
278 |
# end cheap input hacks |
279 |
my $status = handle($input, $self, $expect); |
280 |
if (!$status) { |
281 |
syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2)); |
282 |
} |
283 |
next if $status eq REQUEST_ACS_RESEND; |
284 |
if ($expect && ($status ne $expect)) { |
285 |
# We received a non-"RESEND" that wasn't what we were expecting. |
286 |
syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input); |
287 |
} |
288 |
# We successfully received and processed what we were expecting |
289 |
$expect = ''; |
290 |
alarm 0; |
291 |
} |
292 |
} |
297 |
} |
293 |
|
298 |
|
|
|
299 |
sub read_request { |
300 |
my $raw_length; |
301 |
local $/ = "\015"; |
302 |
|
303 |
# proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return |
304 |
my $buffer = <STDIN>; |
305 |
if ( defined $buffer ) { |
306 |
STDIN->flush(); # clear an extra linefeed |
307 |
chomp $buffer; |
308 |
$raw_length = length $buffer; |
309 |
$buffer =~ s/^\s*[^A-z0-9]+//s; |
310 |
# Every line must start with a "real" character. Not whitespace, control chars, etc. |
311 |
$buffer =~ s/[^A-z0-9]+$//s; |
312 |
|
313 |
# Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| |
314 |
$buffer =~ s/\015?\012//g; # Extra line breaks must die |
315 |
$buffer =~ s/\015?\012//s; # Extra line breaks must die |
316 |
$buffer =~ s/\015*\012*$//s; |
317 |
|
318 |
# treat as one line to include the extra linebreaks we are trying to remove! |
319 |
} |
320 |
else { |
321 |
syslog( 'LOG_DEBUG', 'EOF returned on read' ); |
322 |
return; |
323 |
} |
324 |
my $len = length $buffer; |
325 |
if ( $len != $raw_length ) { |
326 |
my $trim = $raw_length - $len; |
327 |
syslog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " ); |
328 |
} |
329 |
|
330 |
syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" ); |
331 |
return $buffer; |
332 |
} |
294 |
1; |
333 |
1; |
295 |
__END__ |
334 |
__END__ |