@@ -, +, @@ --- C4/SIP/SIPServer.pm | 107 +++++++++++++++++++++++++++++++++++----------------- C4/SIP/Sip.pm | 56 +-------------------------- 2 files changed, 74 insertions(+), 89 deletions(-) --- a/C4/SIP/SIPServer.pm +++ a/C4/SIP/SIPServer.pm @@ -15,7 +15,6 @@ use C4::SIP::Sip::Constants qw(:all); use C4::SIP::Sip::Configuration; use C4::SIP::Sip::Checksum qw(checksum verify_cksum); use C4::SIP::Sip::MsgType qw( handle login_core ); -use C4::SIP::Sip qw( read_SIP_packet ); use base qw(Net::Server::PreFork); @@ -116,6 +115,7 @@ sub process_request { } else { &$transport($self); } + return; } # @@ -130,7 +130,7 @@ sub raw_transport { while (!$self->{account}) { local $SIG{ALRM} = sub { die "raw_transport Timed Out!\n"; }; syslog("LOG_DEBUG", "raw_transport: timeout is %d", $service->{timeout}); - $input = read_SIP_packet(*STDIN); + $input = read_request(); if (!$input) { # EOF on the socket syslog("LOG_INFO", "raw_transport: shutting down: EOF during login"); @@ -146,6 +146,7 @@ sub raw_transport { $self->sip_protocol_loop(); syslog("LOG_INFO", "raw_transport: shutting down"); + return; } sub get_clean_string { @@ -230,6 +231,7 @@ sub telnet_transport { syslog("LOG_DEBUG", "telnet_transport: uname/inst: '%s/%s'", $account->{id}, $account->{institution}); $self->sip_protocol_loop(); syslog("LOG_INFO", "telnet_transport: shutting down"); + return; } # @@ -242,7 +244,6 @@ sub sip_protocol_loop { my $service = $self->{service}; my $config = $self->{config}; my $timeout = $self->{service}->{timeout} || $config->{timeout} || 30; - my $input; # The spec says the first message will be: # SIP v1: SC_STATUS @@ -257,39 +258,77 @@ sub sip_protocol_loop { # case, the LOGIN message has already been processed (above). # # In short, we'll take any valid message here. - #my $expect = SC_STATUS; - local $SIG{ALRM} = sub { die "SIP Timed Out!\n"; }; - my $expect = ''; - while (1) { - alarm $timeout; - $input = read_SIP_packet(*STDIN); - unless ($input) { - return; # EOF + eval { + local $SIG{ALRM} = sub { + syslog( 'LOG_DEBUG', 'Inactive: timed out' ); + die "Timed Out!\n"; + }; + my $previous_alarm = alarm($timeout); + + while ( my $inputbuf = read_request() ) { + if ( !defined $inputbuf ) { + return; #EOF + } + alarm($timeout); + + unless ($inputbuf) { + syslog( "LOG_ERR", "sip_protocol_loop: empty input skipped" ); + print("96$CR"); + next; + } + + my $status = C4::SIP::Sip::MsgType::handle( $inputbuf, $self, q{} ); + if ( !$status ) { + syslog( + "LOG_ERR", + "sip_protocol_loop: failed to handle %s", + substr( $inputbuf, 0, 2 ) + ); + } + next if $status eq REQUEST_ACS_RESEND; } - # 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) { - syslog("LOG_ERR", "sip_protocol_loop: empty input skipped"); - print("96$CR"); - next; - } - # end cheap input hacks - my $status = handle($input, $self, $expect); - if (!$status) { - syslog("LOG_ERR", "sip_protocol_loop: failed to handle %s",substr($input,0,2)); - } - next if $status eq REQUEST_ACS_RESEND; - if ($expect && ($status ne $expect)) { - # We received a non-"RESEND" that wasn't what we were expecting. - syslog("LOG_ERR", "sip_protocol_loop: expected %s, received %s, exiting", $expect, $input); - } - # We successfully received and processed what we were expecting - $expect = ''; - alarm 0; - } + alarm($previous_alarm); + return; + }; + if ( $@ =~ m/timed out/i ) { + return; + } + return; } +sub read_request { + my $raw_length; + local $/ = "\015"; + + # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return + my $buffer = ; + if ( defined $buffer ) { + STDIN->flush(); # clear an extra linefeed + chomp $buffer; + $raw_length = length $buffer; + $buffer =~ s/^\s*[^A-z0-9]+//s; +# Every line must start with a "real" character. Not whitespace, control chars, etc. + $buffer =~ s/[^A-z0-9]+$//s; + +# Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| + $buffer =~ s/\015?\012//g; # Extra line breaks must die + $buffer =~ s/\015?\012//s; # Extra line breaks must die + $buffer =~ s/\015*\012*$//s; + + # treat as one line to include the extra linebreaks we are trying to remove! + } + else { + syslog( 'LOG_DEBUG', 'EOF returned on read' ); + return; + } + my $len = length $buffer; + if ( $len != $raw_length ) { + my $trim = $raw_length - $len; + syslog( 'LOG_DEBUG', "read_request trimmed $trim character(s) " ); + } + + syslog( 'LOG_INFO', "INPUT MSG: '$buffer'" ); + return $buffer; +} 1; __END__ --- a/C4/SIP/Sip.pm +++ a/C4/SIP/Sip.pm @@ -22,14 +22,13 @@ BEGIN { @ISA = qw(Exporter); @EXPORT_OK = qw(y_or_n timestamp add_field maybe_add add_count - denied sipbool boolspace write_msg read_SIP_packet + denied sipbool boolspace write_msg $error_detection $protocol_version $field_delimiter $last_response); %EXPORT_TAGS = ( all => [qw(y_or_n timestamp add_field maybe_add add_count denied sipbool boolspace write_msg - read_SIP_packet $error_detection $protocol_version $field_delimiter $last_response)]); } @@ -154,59 +153,6 @@ sub boolspace { return $bool ? 'Y' : ' '; } - -# 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 $/ = "\r"; # don't need any of these here. use whatever the prevailing $/ is. - local $/ = "\015"; # proper SPEC: (octal) \015 = (hex) x0D = (dec) 13 = (ascii) carriage return - { # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html - 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; # Every line must start with a "real" character. Not whitespace, control chars, etc. - $record =~ s/[^A-z0-9]+$//s; # Same for the end. Note this catches the problem some clients have sending empty fields at the end, like ||| - $record =~ s/\015?\012//g; # Extra line breaks must die - $record =~ s/\015?\012//s; # Extra line breaks must die - $record =~ s/\015*\012*$//s; # treat as one line to include the extra linebreaks we are trying to remove! - while ( chomp($record) ) { 1; } - - $record and last; # success - } - } - 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')); - } - # - # Cen-Tec self-check terminals transmit '\r\n' line terminators. - # This is actually very hard to deal with in perl in a reasonable - # since every OTHER piece of hardware out there gets the protocol - # right. - # - # The incorrect line terminator presents as a \r at the end of the - # first record, and then a \n at the BEGINNING of the next record. - # So, the simplest thing to do is just throw away a leading newline - # on the input. - # - # This is now handled by the vigorous cleansing above. - # syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record; - syslog("LOG_INFO", "INPUT MSG: '$record'") if $record; - return $record; -} - # # write_msg($msg, $file) # --