X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FMsg.pm;h=a8db113761392d3ffbcf2dfa740288f9a4f97c98;hb=c912e948dc2207f446c7c8930ab179b4bc3b98d7;hp=d067f27e31c35ee2fec876577a345eb2fb7a274b;hpb=5947a205b3f36462fc1fe5ed5a08c7d8293ab744;p=spider.git diff --git a/perl/Msg.pm b/perl/Msg.pm index d067f27e..a8db1137 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -10,15 +10,12 @@ package Msg; -require Exporter; -@ISA = qw(Exporter); - use strict; use IO::Select; use IO::Socket; -use Carp; +#use DXDebug; -use vars qw (%rd_callbacks %wt_callbacks $rd_handles $wt_handles); +use vars qw(%rd_callbacks %wt_callbacks $rd_handles $wt_handles); %rd_callbacks = (); %wt_callbacks = (); @@ -89,7 +86,7 @@ sub _enqueue { my ($conn, $msg) = @_; # prepend length (encoded as network long) my $len = length($msg); - $msg =~ s/(\x00-\x2f\x7e-\xff%])/sprintf("%%%02X", ord($1))/eg; + $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; push (@{$conn->{queue}}, $msg . "\n"); } @@ -128,6 +125,7 @@ sub _send { } else { # Uh, oh delete $conn->{send_offset}; $conn->handle_send_err($!); + $conn->disconnect; return 0; # fail. Message remains in queue .. } } @@ -231,14 +229,16 @@ sub _rcv { # Complement to _send } FINISH: - if (defined $bytes_read == 0) { - $conn->disconnect(); + if (defined $bytes_read && $bytes_read == 0) { +# $conn->disconnect(); &{$conn->{rcvd_notification_proc}}($conn, undef, $!); + @lines = (); } while (@lines){ $msg = shift @lines; - $msg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; + $msg =~ s/\%([2-9A-F][0-9A-F])/chr(hex($1))/eg; + $msg =~ s/[\x00-\x08\x0a-\x1f\x9b\x8e]/./g; # immutable CSI sequence + control characters &{$conn->{rcvd_notification_proc}}($conn, $msg, $!); $! = 0; }