Robust string cleaning and flexible CRLF from Socket

diff --git a/SIPServer.pm b/SIPServer.pm
index 7d9cf2e..ac983c5 100644 (file)
--- a/SIPServer.pm
+++ b/SIPServer.pm
@@ -26,7 +26,7 @@ use Sys::Syslog qw(syslog);
 use Net::Server::PreFork;
 use Net::Server::Proto;
 use IO::Socket::INET;
-use Socket;
+use Socket qw(:crlf);
 use Data::Dumper;              # For debugging
 require UNIVERSAL::require;
 
@@ -222,7 +222,7 @@ sub telnet_transport {
             last;
         } else {
             syslog("LOG_WARNING", "Invalid login attempt: '%s'", $uid);
-            print("Invalid login\n");
+            print("Invalid login$CRLF");
         }
     }
     }; # End of eval
@@ -234,7 +234,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;

diff --git a/Sip.pm b/Sip.pm
index ff96815..4e2e09b 100644 (file)
--- a/Sip.pm
+++ b/Sip.pm
@@ -30,6 +30,7 @@ use Encode;
 
 use Sys::Syslog qw(syslog);
 use POSIX qw(strftime);
+use Socket qw(:crlf);
 
 use Sip::Constants qw(SIP_DATETIME);
 use Sip::Checksum qw(checksum);
@@ -160,12 +161,44 @@ sub boolspace {
 # Read a packet from $file, using the correct record separator
 #
 sub read_SIP_packet {
-    my $file = shift;
     my $record;
-    local $/ = "\r";
-
-    $record = readline($file);
-
+    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 $/ = "\012";    # Internet Record Separator (lax version)
+    {    # adapted from http://perldoc.perl.org/5.8.8/functions/readline.html
+        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; # 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
+            } else {
+                if ($!) {
+                    syslog( "LOG_DEBUG", "read_SIP_packet (try #$tries) ERROR: $! $@" );
+                    # die "read_SIP_packet ERROR: $!";
+                    warn "read_SIP_packet ERROR: $! $@";
+                }
+            }
+        }
+    }
+    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
@@ -176,8 +209,8 @@ sub read_SIP_packet {
     # 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.
-    # 
-    $record =~ s/^\012// if $record;
+    #  
+    # This is now handled by the vigorous cleansing above.
     syslog("LOG_INFO", encode_utf8("INPUT MSG: '$record'")) if $record;
     return $record;
 }
@@ -199,20 +232,20 @@ sub write_msg {
 
     $msg = encode_utf8($msg);
     if ($error_detection) {
-       if (defined($self->{seqno})) {
-           $msg .= 'AY' . $self->{seqno};
-       }
-       $msg .= 'AZ';
-       $cksum = checksum($msg);
-       $msg .= sprintf('%04.4X', $cksum);
+        if (defined($self->{seqno})) {
+            $msg .= 'AY' . $self->{seqno};
+        }
+        $msg .= 'AZ';
+        $cksum = checksum($msg);
+        $msg .= sprintf('%04.4X', $cksum);
     }
 
 
     if ($file) {
-       print $file "$msg\r";
+        print $file "$msg$CRLF";
     } else {
-       print "$msg\r";
-       syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
+        print "$msg$CRLF";
+        syslog("LOG_INFO", "OUTPUT MSG: '$msg'");
     }
 
     $last_response = $msg;