ctdo
/
crashtest-r0ket
16
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

improve get_pkt() code in bridge perl lib. 

- length filter for received packets
- no more in-band signalling
- allow new packet types
This commit is contained in:
Stefan `Sec` Zehl 2012-04-15 23:01:42 +02:00
parent 2b5341713b
commit 4f859c82a0
1 changed files with 42 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
tools/mesh/lib/r0ket.pm
View File

@ -16,11 +16,17 @@ our $bridge; # Open device
our $quiet=0; our $quiet=0;
our $timediff=60*60*2; our $timediff=60*60*2;
my $rxlen=0; # Filter for get_pkt()
### Utility ### Utility
sub sprint{ sub sprint{
return join("",map { return join("",map {
if (ord($_)>30 && ord($_)<127){ if (ord($_)>30 && ord($_)<127){
$_; if(ord($_)==92){
"\\\\";
}else{
$_;
};
}else{ }else{
# "[x".unpack("H*",$_)."]"; # "[x".unpack("H*",$_)."]";
"\\".unpack("C",$_); "\\".unpack("C",$_);
@ -93,8 +99,9 @@ sub writebeacon{
### Packet mgmt ### Packet mgmt
our $buffer; our $buffer;
our $firstpkt=2; our $firstpkt=1;
sub get_packet{ sub get_data{
my $filter=shift||0;
sub _get_bytes{ sub _get_bytes{
my $rr; my $rr;
sysread($bridge,$rr,1024); sysread($bridge,$rr,1024);
@ -102,25 +109,33 @@ sub get_packet{
select(undef,undef,undef,0.05); select(undef,undef,undef,0.05);
}; };
$buffer.=$rr; $buffer.=$rr;
# print "recv: ",unpack("H*",$rr),"\n";
}; };
my $cnt=0; my $cnt=0;
while(1){ while(1){
if(length($buffer)<2){ if(length($buffer)<2){
_get_bytes(); _get_bytes();
}elsif($buffer !~ /^\\[12]/){ }elsif($buffer !~ /^\\[1-9]/){
$buffer=~s/^(.[^\\]*)//s; if($buffer =~ /[^\\]\\[1-9]/){
$buffer =~ s/^(.*?[^\\])(\\[1-9])/\2/s;
}else{
$buffer = s/(.*)//s;
};
if($firstpkt){ if($firstpkt){
$firstpkt--; $firstpkt--;
}else{ }else{
print STDERR "Unparseable stuff: <",sprint($1),">\n" if(!$quiet); print STDERR "Unparseable stuff: <",sprint($1),">\n" if(!$quiet);
}; };
}elsif ($buffer =~ s/^\\2\\0//s){ }elsif ($buffer =~ s/^\\(\d)(.*?)\\0//s){
return 'ack'; # In-band signalling. Evil %) my ($type,$str)=($1,$2);
}elsif ($buffer =~ s/^\\1(.*?)\\0//s){
my $str=$1;
$str=~s/\\\\/\\/g; # dequote $str=~s/\\\\/\\/g; # dequote
return $str; # print STDERR "ret:pkt[$type]=",(sprint $str),"\n";
if($filter==0){
return ($type,$str);
}elsif($filter==$type){
return $str;
};
}else{ }else{
_get_bytes(); _get_bytes();
}; };
@ -132,6 +147,16 @@ sub get_packet{
}; };
}; };
sub get_packet{
my $pkt;
while(1){
$pkt=get_data(1);
if($rxlen==0 || length($pkt)==$rxlen){
return $pkt;
};
};
};
sub rest{ sub rest{
if(length($buffer)>0){ if(length($buffer)>0){
print "rest: <", sprint($buffer), ">\n" if(!$quiet); print "rest: <", sprint($buffer), ">\n" if(!$quiet);
@ -271,6 +296,7 @@ sub nice_beacon{
$out->{string}=sprintf "NICK beacon=%s nick=%s", $out->{string}=sprintf "NICK beacon=%s nick=%s",
$out->{beacon}, $out->{beacon},
$out->{nick}; $out->{nick};
addbeacon($out->{beacon},$out->{nick});
}else{ }else{
$out->{string}="<?:".unpack("H*",$pkt).">"; $out->{string}="<?:".unpack("H*",$pkt).">";
}; };
@ -332,15 +358,16 @@ sub set_channel {
send_pkt_num(pack("C",shift),5); send_pkt_num(pack("C",shift),5);
}; };
sub set_rxlen { sub set_rxlen {
$rxlen=$_[0];
send_pkt_num(pack("C",shift),6); send_pkt_num(pack("C",shift),6);
}; };
sub wait_ok { sub wait_ok {
my $pkt; my ($type,$pkt);
$pkt=get_packet(); ($type,$pkt)=get_data();
while($pkt ne "ack"){ while($type ne "2"){
print "pkt=",(sprint $pkt),"\n"; print "pkt[$type]=[",length($pkt),"]",(sprint $pkt),"\n";
$pkt=get_packet(); ($type,$pkt)=get_data();
}; };
print "ok!\n"; print "ok!\n";
return 1; return 1;