Add new "rf" utility. Quite functional rf debugging/dumping util

This commit is contained in:
Stefan `Sec` Zehl 2012-01-28 17:12:43 +01:00
parent 709c402f29
commit 3b04b9e052
3 changed files with 377 additions and 29 deletions

View File

@ -37,9 +37,15 @@ $win_top->addstr(1,0,"-"x20);
$win_top->refresh; $win_top->refresh;
my $beaconctr=0; my $beaconctr=0;
my $crcerr=0;
while(1){ while(1){
$str=r0ket::get_packet(); $str=r0ket::get_packet();
my $p=r0ket::pkt_beauty($str); my $p=r0ket::nice_mesh($str);
if($p->{crc} ne "ok"){
$crcerr++;
next;
};
if(!$bdata{$p->{beacon}}){ if(!$bdata{$p->{beacon}}){
$bdata{$p->{beacon}}=++$beaconctr; $bdata{$p->{beacon}}=++$beaconctr;
}; };

View File

@ -9,8 +9,9 @@ package r0ket;
use Digest::CRC qw(crcccitt); use Digest::CRC qw(crcccitt);
use POSIX qw(strftime); use POSIX qw(strftime);
use Time::HiRes;
our $verbose=1; our $verbose=0;
our $bridge; # Open device our $bridge; # Open device
### Utility ### Utility
@ -19,11 +20,32 @@ sub sprint{
if (ord($_)>30 && ord($_)<127){ if (ord($_)>30 && ord($_)<127){
$_; $_;
}else{ }else{
"[x".unpack("H*",$_)."]"; # "[x".unpack("H*",$_)."]";
"\\".unpack("C",$_);
} }
}split(//,shift)); }split(//,shift));
}; };
sub hprint{
return unpack("H*",shift);
};
sub flagsstr {
my $in=shift;
my @f;
my $f=1;
for (@_){
if($in & $f){
push @f,$_;
};
$f*=2;
};
return join(",",@f);
};
### Nickname/beacon helper functions ### Nickname/beacon helper functions
our %beacon; our %beacon;
sub readbeacon{ sub readbeacon{
@ -69,32 +91,39 @@ sub writebeacon{
### Packet mgmt ### Packet mgmt
our $buffer; our $buffer;
our $firstpkt=2;
sub get_packet{ sub get_packet{
sub _get_bytes{ sub _get_bytes{
my $rr; my $rr;
sysread($bridge,$rr,1024); sysread($bridge,$rr,1024);
if(length($rr)<=1){ if(length($rr)<=1){
select(undef,undef,undef,0.1); select(undef,undef,undef,0.05);
}; };
$buffer.=$rr; $buffer.=$rr;
}; };
my $cnt=0; my $cnt=0;
while(++$cnt<50){ while(++$cnt<100){
if(length($buffer)<2){ if(length($buffer)<2){
_get_bytes(); _get_bytes();
}elsif($buffer !~ /^\\[12]/){ }elsif($buffer !~ /^\\[12]/){
$buffer=~s/^(.[^\\]*)//s; $buffer=~s/^(.[^\\]*)//s;
# print STDERR "Unparseable stuff: <",sprint($1),">\n"; if($firstpkt){
}elsif ($buffer =~ s/^\\([12])(.*?)\\0//s){ $firstpkt--;
my $str=$2; }else{
print STDERR "Unparseable stuff: <",sprint($1),">\n";
};
}elsif ($buffer =~ s/^\\2\\0//s){
return 'ack'; # In-band signalling. Evil %)
}elsif ($buffer =~ s/^\\1(.*?)\\0//s){
my $str=$1;
$str=~s/\\\\/\\/g; # dequote $str=~s/\\\\/\\/g; # dequote
return $str; return $str;
}else{ }else{
_get_bytes(); _get_bytes();
}; };
}; };
die "No packets for >1sec?\n"; die "No packets for 5seconds?\n";
}; };
sub rest{ sub rest{
@ -120,7 +149,7 @@ sub nice_mesh{
$out->{string}.=sprintf " t=%s (%+4d) rel=%s beacon=%s", $out->{string}.=sprintf " t=%s (%+4d) rel=%s beacon=%s",
strftime("%Y-%m-%d %H:%M:%S",gmtime $out->{time}), strftime("%Y-%m-%d %H:%M:%S",gmtime $out->{time}),
$out->{time}-(time+3600), $out->{time}-(Time::HiRes::time+3600),
$out->{release}, $out->{release},
resolvebeacon($out->{beacon}); resolvebeacon($out->{beacon});
}elsif($type eq "i"){ }elsif($type eq "i"){
@ -142,6 +171,65 @@ sub nice_mesh{
}else{ }else{
$out->{string}.= " <??: ".unpack("H*",substr($pkt,2,length($pkt)-4)).">"; $out->{string}.= " <??: ".unpack("H*",substr($pkt,2,length($pkt)-4)).">";
}; };
my $pkt_crc= unpack("n",substr($pkt,length($pkt)-2,2));
my $calc_crc= crcccitt(substr($pkt,0,length($pkt)-2));
if ($pkt_crc eq $calc_crc){
$out->{crc}="ok";
}else{
$out->{crc}="fail";
$out->{string}.= " CRCFAIL";
};
return $out;
};
sub nice_game{
my $pkt=shift;
my $out;
my $type=substr($pkt,2,1);
$out->{proto}=substr($pkt,1,1);
$out->{type} =substr($pkt,2,1);
$out->{id} =unpack("V",substr($pkt,3,4));
$out->{ctr} =unpack("V",substr($pkt,7,4));
$out->{string}=sprintf "G[%s] id=%d ctr=%d",
$out->{type}, $out->{id}, $out->{ctr};
if($type eq "A"){
$out->{mac} = substr($pkt,11,5);
$out->{channel} = unpack("C" ,substr($pkt,16,1));
$out->{id} = unpack("v", substr($pkt,17,2));
$out->{flags} = unpack("C", substr($pkt,19,1));
$out->{flagsstr}=flagsstr($out->{flags},qw(mass short lrecv));
$out->{interval} = unpack("C", substr($pkt,20,1));
$out->{jitter} = unpack("C", substr($pkt,21,1));
$out->{title} = unpack("Z*",substr($pkt,22,10));
$out->{string}.=sprintf " mac=%s ch=%s id=%d fl=<%s> itvl=%d j=%d %s",
sprint($out->{mac}),
$out->{channel},
$out->{id},
$out->{flagsstr},
$out->{interval},
$out->{jitter},
$out->{title};
}else{
$out->{string}.= " <??: ".unpack("H*",substr($pkt,2,length($pkt)-4)).">";
};
my $pkt_crc= unpack("n",substr($pkt,length($pkt)-2,2));
my $calc_crc= crcccitt(substr($pkt,0,length($pkt)-2));
if ($pkt_crc eq $calc_crc){
$out->{crc}="ok";
}else{
$out->{crc}="fail";
$out->{string}.= " CRCFAIL";
};
return $out; return $out;
}; };
@ -194,25 +282,6 @@ sub nice_beacon{
return $out; return $out;
}; };
sub pkt_beauty{
my $pkt=shift;
my $out;
$out=nice_mesh($pkt);
my $pkt_crc= unpack("n",substr($pkt,length($pkt)-2,2));
my $calc_crc= crcccitt(substr($pkt,0,length($pkt)-2));
if ($pkt_crc eq $calc_crc){
$out->{crc}="ok";
}else{
$out->{crc}="fail";
$out->{string}.= " CRCFAIL";
};
return $out;
}
sub r0ket_init{ sub r0ket_init{
my $ser; my $ser;
if ($ARGV[0] eq "-s"){ if ($ARGV[0] eq "-s"){
@ -263,4 +332,14 @@ sub set_rxlen {
send_pkt_num(pack("C",shift),6); send_pkt_num(pack("C",shift),6);
}; };
sub wait_ok {
my $pkt;
$pkt=get_packet();
while($pkt ne "ack"){
print "pkt=",(sprint $pkt),"\n";
$pkt=get_packet();
};
print "ok!\n";
return 1;
};
1; 1;

263
tools/mesh/rf Executable file
View File

@ -0,0 +1,263 @@
#!/usr/bin/perl
#
# vim:set ts=4 sw=4:
use strict;
use IO::Select;
use Digest::CRC qw(crcccitt);
use POSIX qw(strftime);
use lib '.';
use r0ket;
$|=1;
r0ket::r0ket_init();
my @fh;
my $read;
if ($ARGV[0] =~ /^-?-?h/){
print STDERR "Mini-Help:\n";
print STDERR "-s <devicename> (or \$R0KETBRIDGE)\n";
print STDERR "-w write beacon2nick file\n";
print STDERR "\n";
print STDERR "recv<num>: receive (number) pakets\n";
print STDERR " - r hex : hexdump packets\n";
print STDERR " - r ascii : asciidump packets\n";
print STDERR " - r beacon : parse as openbeacon\n";
print STDERR " - r mesh : parse as mesh packet\n";
print STDERR " - r m <letter>: and show only <letter>\n";
print STDERR "\n";
print STDERR "send<num>: send packet (number) times\n";
print STDERR " - s raw <hex>: send raw hex packet\n";
print STDERR " - s hex <hex>: send packet with crc16\n";
print STDERR " - s mesh t <gen>: send mesh time packet\n";
print STDERR " - s mesh <other>, see source :-)\n";
print STDERR "\n";
print STDERR "preset: config per preset\n";
print STDERR "- p m - preset minimesh\n";
print STDERR "- p b - preset openbeacon\n";
print STDERR "config: config rf chip\n";
print STDERR "- c rx - set rxmac\n";
print STDERR "- c tx - set txmac\n";
print STDERR "- c len - set rxlength\n";
print STDERR "- c ch - set channel\n";
print STDERR "- c <opt>hex - set any option via hex string\n";
print STDERR "\n";
print STDERR "etc...\n";
exit(1);
};
my $writend=0;
if ($ARGV[0] eq "-w"){
shift;
$writend=1;
};
END{
r0ket::writebeacon if($writend);
};
my $cmd=shift;
if($cmd =~ /^r/){
r0ket::readbeacon();
$cmd=~s/r(ecv)?//;
$cmd=100 if $cmd+0==0;
my $fmt=shift || "_";
my $arg=shift || undef;
my $read="";
my $str;
while($cmd>0){
$str=r0ket::get_packet();
if($fmt =~ /_/){
if(substr($str,0,1)eq "\x10"){
if(substr($str,1,1)eq"G"){
$fmt="g_";
}else{
$fmt="b_";
};
}elsif(substr($str,0,1)eq "\x20"){
$fmt="g_";
}elsif(length($str)==32){
$fmt="m_";
}else{
$fmt="x_";
};
};
if($fmt =~ /^m/){
my $p=r0ket::nice_mesh($str);
print $p->{string};
}elsif($fmt =~ /^b/){
my $p=r0ket::nice_beacon($str);
print $p->{string};
}elsif($fmt =~ /^g/){
my $p=r0ket::nice_game($str);
print $p->{string};
}elsif($fmt =~ /^(x|hex)/){
my $pkt_crc= unpack("n",substr($str,length($str)-2,2));
my $calc_crc= crcccitt(substr($str,0,length($str)-2));
print "<",unpack("H*",$str),">";
if($pkt_crc ne $calc_crc){
print " CRCFAIL";
};
}elsif($fmt =~ /^a/){
print "<", r0ket::sprint($str), ">";
}else{
die "Unknown packet format: $fmt\n";
};
print "\n";
$cmd--;
next;
};
r0ket::rest();
}elsif ($cmd =~ /^p/){ # Preset
my $sub=shift;
if ($sub =~/^m/i){ # Default mesh settings.
r0ket::set_txmac("ORBIT");
r0ket::set_rxmac("ORBIT");
r0ket::set_channel(83);
r0ket::set_rxlen(32);
}elsif ($sub =~/^b/i){ # Default OpenBeacon settings
r0ket::set_txmac(pack("H*","0102030201"));
r0ket::set_rxmac(pack("H*","0102030201"));
r0ket::set_channel(81);
r0ket::set_rxlen(16);
}elsif ($sub =~/^a/i){ # Default rem0te announce settings
r0ket::set_txmac("REM0T");
r0ket::set_rxmac("REM0T");
r0ket::set_channel(87);
r0ket::set_rxlen(32);
}elsif ($sub =~/^r/i){ # Default bpong game settings
r0ket::set_txmac("BPONG");
r0ket::set_rxmac("BPONG");
r0ket::set_channel(91);
r0ket::set_rxlen(32);
}else{
die "Unkown preset $sub\n";
};
}elsif ($cmd =~ /^c/){
my $set=shift;
if($set=~s/hex//){
$ARGV[0]=pack("H*",$ARGV[0]);
};
if ($set =~ /^tx/){
r0ket::set_txmac(shift);
}elsif ($set =~ /^rx/){
r0ket::set_rxmac(shift);
}elsif ($set =~ /^ch/){
r0ket::set_channel(shift);
}elsif ($set =~ /^len/){
r0ket::set_rxlen(shift);
}else{
die "Unknown config argument $set\n";
};
r0ket::wait_ok();
}elsif ($cmd =~ /^s/){
$cmd=~s/^//;
$cmd=1 if $cmd==0;
my $pkt;
my $sub=shift;
if($sub =~ /^raw/){
$pkt=pack("H*",shift);
}elsif($sub =~ /^hex/){
$pkt=pack("H*",shift);
$pkt.=pack("n",crcccitt($pkt));
}elsif($sub =~ /^m/){
my $scmd=shift;
if($scmd eq "t"){
$pkt.="T";
$pkt.=chr(shift); #gen
$pkt.=pack("N",scalar(time)+1*60*60);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
}elsif($scmd eq "a"){
$pkt.="A";
$pkt.=chr(shift); #gen
$pkt.=pack("N",scalar(time)+1*60*60+ 300);
$pkt.= pack("C",shift||0);
$pkt.= pack("C",0);
$pkt.= pack("C",0);
$pkt.= pack("C",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
}elsif($scmd eq "b"){
$pkt.="B";
$pkt.=chr(shift); #gen
$pkt.=pack("N",scalar(time)+1*60*60+ 600);
$pkt.= pack("C",shift||0);
$pkt.= pack("C",0);
$pkt.= pack("C",0);
$pkt.= pack("C",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
}elsif($scmd eq "c"){
$pkt.="\x1";
$pkt.=chr(shift); #gen
$pkt.=pack("N",scalar(time)+1*60*60+ 600);
$pkt.= pack("C",shift||0);
$pkt.= pack("C",0);
$pkt.= pack("C",0);
$pkt.= pack("C",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
$pkt.=pack("N",0);
}elsif($scmd eq "i"){
$pkt.="i";
$pkt.=chr(shift); #gen
$pkt.=pack("N",shift||42);
$pkt.=shift;
$pkt.="\0"x(30-length($pkt));
}else{
die "Unknown mesh subtype: $scmd\n";
};
$pkt.=pack("n",crcccitt($pkt));
}else{
die "Unknown send subtype: $sub\n";
};
print "Write: <", sprint($pkt),">, ";
print "crc: ",unpack("n",substr($pkt,length($pkt)-2,2))," ";
print "len: ",length($pkt),"\n";
while($cmd-->0){
r0ket::send_pkt($pkt);
r0ket::wait_ok;
};
}else{
die "Option not understood\n";
};
#if (@fh = $sel->can_read(10)) {
# sysread($fh[0],$read,1024);
#}
#print "PostRead: <", sprint($read), ">\n";