Make Protoutils decoder frame correctly, make test suite more paranoid

darcs-hash:20080827071522-4d648-3af2a6541cee43d27a03d0de019c6a80c6b9b892.gz

diff --git a/Protoutils.pm b/Protoutils.pm
index 12c562443e97c0562a66d5795069a35b0d1b5006..9364121dc1405870d37387693cd768a810ed41be 100644 (file)
--- a/Protoutils.pm
+++ b/Protoutils.pm
@@ -43,8 +43,21 @@ sub tlvs_to_message($){
 sub run_callbacks($$$) {
     my ($coder, $cbs, $msg) = @_;
 
-    return if (0 ne index $msg, $MESSAGE_START);
-    $msg = substr($msg, length $MESSAGE_START);
+    my $regex = "^$MESSAGE_START(["
+              . (join ("",@{$$coder{'code_chars'}}))
+              ."]+)$MESSAGE_END(.*)\$";
+
+    my $rest;
+        # Note how this regex works: it will greedily consume into
+        # what we think is the message, and may have to backtrack out
+        # to find MESSAGE_END.  It will never prematurely terminate
+        # the encoded message if it sees MESSAGE_END inside the message.
+    if ( $msg =~ /$regex/ ) {
+        $msg = $1;
+        $rest = $2;
+    } else {
+        return (0, $msg);
+    }
 
     while( $msg ne "" )
     {
@@ -68,7 +81,7 @@ sub run_callbacks($$$) {
         }
     }
 
-    return $msg eq "";
+    return ($msg eq "", $rest);
 }
 
 sub dump_message($$) {

diff --git a/Protoutils_test.pl b/Protoutils_test.pl
index 08913fa5ca405f232aa579047fcf61b6f821ab58..73c53ae563713e0b515dd0727ab25bf5ff093761 100644 (file)
--- a/Protoutils_test.pl
+++ b/Protoutils_test.pl
@@ -23,7 +23,8 @@ foreach my $ts (@test_strings) {
   print "ENCODED '", $ts, "' into hc ", $enc, " and tlv ", $tlv, "\n";
 }
 
-my $mesg = tlvs_to_message(\@tlvs);
+my $mesg_suffix = "This is some normal text.";
+my $mesg = tlvs_to_message(\@tlvs) . $mesg_suffix;
 
 dump_message($mc, $mesg);
 
@@ -44,8 +45,11 @@ sub def_cb ($$) {
     die "Unanticipated message of type $t: $v";
 }
 
-run_callbacks($mc,
+my ($res, $rest) = run_callbacks($mc,
               { 'default' => \&def_cb,
                 $known_types{'InstanceLabelHuffman1'} => \&ilf_cb,
               },
               $mesg );
+
+die unless $res eq 1;
+die unless $rest eq $mesg_suffix;