Improve my little rf debugging tool a bit. Needs more docs, though
This commit is contained in:
Stefan `Sec` Zehl
parent
020d141995
commit
7ec64c04ad
|
|
@ -5,7 +5,8 @@
|
||||||
use strict;
|
use strict;
|
||||||
|
|
||||||
use IO::Select;
|
use IO::Select;
|
||||||
use Digest::CRC qw(crc16 crcccitt);
|
use Digest::CRC qw(crcccitt);
|
||||||
|
use POSIX qw(strftime);
|
||||||
|
|
||||||
$|=1;
|
$|=1;
|
||||||
|
|
||||||
|
|
@ -13,19 +14,88 @@ my @fh;
|
||||||
my $read;
|
my $read;
|
||||||
|
|
||||||
sub sprint{
|
sub sprint{
|
||||||
my @str=split(//,shift);
|
return join("",map {
|
||||||
for (@str){
|
|
||||||
if (ord($_)>30 && ord($_)<127){
|
if (ord($_)>30 && ord($_)<127){
|
||||||
print $_;
|
$_;
|
||||||
}else{
|
}else{
|
||||||
print "[x",unpack("H*",$_),"]";
|
"[x".unpack("H*",$_)."]";
|
||||||
};
|
}
|
||||||
};
|
}split(//,shift));
|
||||||
};
|
};
|
||||||
|
|
||||||
my $ser=shift || "/dev/ttyS3";
|
my %beacon;
|
||||||
|
sub readbeacon{
|
||||||
|
return if( ! -f "BEACON" );
|
||||||
|
open(B,"<","BEACON") || die "open: $!";
|
||||||
|
while(<B>){
|
||||||
|
/(\w+)\s+(.*)/ && do {
|
||||||
|
$beacon{$1}=$2;
|
||||||
|
};
|
||||||
|
};
|
||||||
|
close(B);
|
||||||
|
};
|
||||||
|
sub resolvebeacon{
|
||||||
|
my $b=shift;
|
||||||
|
if(!$beacon{$b}){
|
||||||
|
return $b;
|
||||||
|
}else{
|
||||||
|
return "$b ($beacon{$b})";
|
||||||
|
};
|
||||||
|
};
|
||||||
|
sub addbeacon{
|
||||||
|
my($b,$n)=@_;
|
||||||
|
if(!$beacon{$b}){
|
||||||
|
$beacon{$b}=$n;
|
||||||
|
};
|
||||||
|
};
|
||||||
|
sub writebeacon{
|
||||||
|
open(B,">","BEACON") || die "write: $!";
|
||||||
|
for(sort keys %beacon){
|
||||||
|
print B "$_ $beacon{$_}\n";
|
||||||
|
};
|
||||||
|
close(B);
|
||||||
|
};
|
||||||
|
|
||||||
open(SER, "+<",$ser) || die "open: $!";
|
my $ser="<undef>";
|
||||||
|
|
||||||
|
do {$ser=$_ if ( -e $_ ) } for qw(/dev/ttyS3 /dev/ttyACM0);
|
||||||
|
|
||||||
|
if ($ARGV[0] eq "-h"){
|
||||||
|
print STDERR "Mini-Help:\n";
|
||||||
|
print STDERR "-s <devicename>\n";
|
||||||
|
print STDERR "\n";
|
||||||
|
print STDERR "r<num> receive (number) pakets\n";
|
||||||
|
print STDERR " - r x : hexdump packets\n";
|
||||||
|
print STDERR " - r m : parse as mesh packet\n";
|
||||||
|
print STDERR " - r m <letter>: and show only <letter>\n";
|
||||||
|
print STDERR "\n";
|
||||||
|
print STDERR "s<num> send packet (number) times\n";
|
||||||
|
print STDERR " - s <hex> : send raw hexdump\n";
|
||||||
|
print STDERR " - S ... : see source \n";
|
||||||
|
print STDERR "\n";
|
||||||
|
print STDERR "p config per preset\n";
|
||||||
|
print STDERR "- pM - preset mesh\n";
|
||||||
|
print STDERR "- pB - preset openbeacon\n";
|
||||||
|
print STDERR "\n";
|
||||||
|
print STDERR "etc...\n";
|
||||||
|
exit(1);
|
||||||
|
};
|
||||||
|
if ($ARGV[0] eq "-s"){
|
||||||
|
shift;
|
||||||
|
$ser=shift;
|
||||||
|
};
|
||||||
|
|
||||||
|
my $writend=0;
|
||||||
|
if ($ARGV[0] eq "-w"){
|
||||||
|
shift;
|
||||||
|
$writend=1;
|
||||||
|
};
|
||||||
|
|
||||||
|
END{
|
||||||
|
writebeacon if($writend);
|
||||||
|
};
|
||||||
|
|
||||||
|
open(SER, "+<",$ser) || die "open serial: $!";
|
||||||
|
|
||||||
my $sel = IO::Select->new;
|
my $sel = IO::Select->new;
|
||||||
|
|
||||||
|
|
@ -34,48 +104,89 @@ $sel->add(\*SER);
|
||||||
my $cmd=shift;
|
my $cmd=shift;
|
||||||
|
|
||||||
if($cmd =~ /^r/){
|
if($cmd =~ /^r/){
|
||||||
|
|
||||||
|
readbeacon();
|
||||||
$cmd=~s/r//;
|
$cmd=~s/r//;
|
||||||
$cmd+=1;
|
$cmd=100 if $cmd+0==0;
|
||||||
my $fmt=shift;
|
my $fmt=shift;
|
||||||
|
my $arg=shift || undef;
|
||||||
my $read="";
|
my $read="";
|
||||||
while($cmd-->0){
|
|
||||||
while($read !~ /\\1.*\\0/){
|
while($cmd>0){
|
||||||
my $rr="";
|
if(length($read)>2 && $read !~ /^\\1/){
|
||||||
if (@fh = $sel->can_read(100)) {
|
$read=~s/^(.[^\\]*)//s;
|
||||||
sysread($fh[0],$rr,1024);
|
print "Unparseable stuff: <",sprint($1),">\n";
|
||||||
$read.=$rr;
|
# print "Rest was: ",sprint($read),"!\n";
|
||||||
}
|
};
|
||||||
};
|
if ($read !~ s/^\\1(.*?)\\0//s){
|
||||||
while ($read =~ s/\\1(.*?)\\0//){
|
my $rr="";
|
||||||
my $str=$1;
|
sysread(SER,$rr,1024);
|
||||||
$str=~s/\\\\/\\/g;
|
$read.=$rr;
|
||||||
my $cs=substr($str,0,length($str)-2);
|
}else{
|
||||||
my $crc=unpack("n",substr($str,length($str)-2,2));
|
my $str=$1;
|
||||||
my $crc2= crcccitt($cs),"\n";
|
$str=~s/\\\\/\\/g; # dequote
|
||||||
if($fmt eq "m"){
|
my $pkt_crc= unpack("n",substr($str,length($str)-2,2));
|
||||||
my $i=substr($str,0,1);
|
my $calc_crc= crcccitt(substr($str,0,length($str)-2));
|
||||||
print "M [",substr($str,0,1),"] ";
|
|
||||||
print "g=",unpack("C",substr($str,1,1))," ";
|
if($fmt eq "m"){
|
||||||
if($i eq "T"){
|
my $i=substr($str,0,1);
|
||||||
print "t=",unpack("N",substr($str,2,4))," ";
|
next if(defined $arg && $arg ne $i);
|
||||||
print "(",scalar gmtime unpack("N",substr($str,2,4)),") ";
|
print "M [$i] ";
|
||||||
print "beacon=",unpack("H*",substr($str,26,4))," ";
|
print "g=",unpack("C",substr($str,1,1))," ";
|
||||||
}elsif($i eq "B"){
|
if($i eq "T"){
|
||||||
print "t=",unpack("N",substr($str,2,4))," ";
|
print "t=";
|
||||||
print "ID=",unpack("c",substr($str,6,1))," ";
|
# print unpack("N",substr($str,2,4))," ";
|
||||||
print "HOP=",unpack("n",substr($str,11,4))," ";
|
print strftime("%Y-%m-%d %H:%M:%S",gmtime unpack("N",substr($str,2,4)));
|
||||||
};
|
printf " (%+3d) ",unpack("N",substr($str,2,4))-(time+3600);
|
||||||
# print "\n";
|
print "beacon=",resolvebeacon(unpack("H*",substr($str,26,4)))," ";
|
||||||
|
}elsif($i eq "i"){
|
||||||
|
print "score=",unpack("N",substr($str,2,4))," ";
|
||||||
|
print "nick=",unpack("Z*",substr($str,6,length($str)-8))," ";
|
||||||
|
}elsif($i eq "B"){
|
||||||
|
print "t=",unpack("N",substr($str,2,4))," ";
|
||||||
|
print "ID=",unpack("c",substr($str,6,1))," ";
|
||||||
|
print "HOP=",unpack("n",substr($str,11,4))," ";
|
||||||
|
}else{
|
||||||
|
print "<??: ",unpack("H*",substr($str,2,length($str)-4)),">";
|
||||||
|
};
|
||||||
|
# print "\n";
|
||||||
|
}elsif($fmt eq "b"){
|
||||||
|
my $i=substr($str,1,1);
|
||||||
|
if($i eq "\x17"){
|
||||||
|
print "BEACON ";
|
||||||
|
print "ln=",unpack("C",substr($str,0,1))," ";
|
||||||
|
print "bt=",unpack("H*",substr($str,2,1))," ";
|
||||||
|
print "str=",unpack("H*",substr($str,3,1))," ";
|
||||||
|
printf "idx=%08d ",unpack("N",substr($str,4,4));
|
||||||
|
print "beacon=",resolvebeacon(unpack("H*",substr($str,8,4)))," ";
|
||||||
|
if(unpack("H*",substr($str,12,2)) ne "ffff"){
|
||||||
|
print "unused=",unpack("H*",substr($str,12,2))," ";
|
||||||
|
};
|
||||||
|
}elsif($i eq "\x23"){
|
||||||
|
print "NICK ";
|
||||||
|
print "beacon=",resolvebeacon(unpack("H*",substr($str,2,4)))," ";
|
||||||
|
print "nick=",unpack("Z*",substr($str,6,length($str)-2))," ";
|
||||||
|
addbeacon(unpack("H*",substr($str,2,4)),unpack("Z*",substr($str,6,length($str)-2)));
|
||||||
|
}else{
|
||||||
|
#<?:1023332ed221312d342e312e3400dddb>
|
||||||
|
print "<?:",unpack("H*",$str),">";
|
||||||
|
};
|
||||||
}elsif($fmt eq "x"){
|
}elsif($fmt eq "x"){
|
||||||
print "<",unpack("H*",$str),">";
|
print "<",unpack("H*",$str),">";
|
||||||
}else{
|
}else{
|
||||||
print "Read: <"; sprint $str; print ">\n";
|
print "<", sprint($str), ">\n";
|
||||||
};
|
};
|
||||||
print "CRCFAIL" if ($crc ne $crc2);
|
print "CRCFAIL" if ($pkt_crc ne $calc_crc);
|
||||||
print "\n";
|
print "\n";
|
||||||
};
|
$cmd--;
|
||||||
};
|
next;
|
||||||
print "rest: <"; sprint $read; print ">\n";
|
};
|
||||||
|
if($read !~ /^\\1/){
|
||||||
|
};
|
||||||
|
};
|
||||||
|
if(length($read)>0){
|
||||||
|
print "rest: <", sprint($read), ">\n";
|
||||||
|
};
|
||||||
exit;
|
exit;
|
||||||
}elsif ($cmd eq "pM"){
|
}elsif ($cmd eq "pM"){
|
||||||
syswrite(SER, '\3ORBIT\0');
|
syswrite(SER, '\3ORBIT\0');
|
||||||
|
|
@ -89,28 +200,28 @@ if($cmd =~ /^r/){
|
||||||
syswrite(SER, '\6'.pack("H*","10").'\0');
|
syswrite(SER, '\6'.pack("H*","10").'\0');
|
||||||
}elsif ($cmd eq "mt"){
|
}elsif ($cmd eq "mt"){
|
||||||
my $par=pack("H*",shift);
|
my $par=pack("H*",shift);
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par),">\n";
|
||||||
syswrite(SER, '\3'.$par.'\0');
|
syswrite(SER, '\3'.$par.'\0');
|
||||||
}elsif ($cmd eq "mta"){
|
}elsif ($cmd eq "mta"){
|
||||||
my $par=shift;
|
my $par=shift;
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par),">\n";
|
||||||
print "len: ",length($par),"\n";
|
print "len: ",length($par),"\n";
|
||||||
syswrite(SER, '\3'.$par.'\0');
|
syswrite(SER, '\3'.$par.'\0');
|
||||||
}elsif ($cmd eq "mr"){
|
}elsif ($cmd eq "mr"){
|
||||||
my $par=pack("H*",shift);
|
my $par=pack("H*",shift);
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par),">\n";
|
||||||
syswrite(SER, '\4'.$par.'\0');
|
syswrite(SER, '\4'.$par.'\0');
|
||||||
}elsif ($cmd eq "mra"){
|
}elsif ($cmd eq "mra"){
|
||||||
my $par=shift;
|
my $par=shift;
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par),">\n";
|
||||||
syswrite(SER, '\4'.$par.'\0');
|
syswrite(SER, '\4'.$par.'\0');
|
||||||
}elsif ($cmd eq "ch"){
|
}elsif ($cmd eq "ch"){
|
||||||
my $par=pack("H*",shift);
|
my $par=pack("H*",shift);
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par),">\n";
|
||||||
syswrite(SER, '\5'.$par.'\0');
|
syswrite(SER, '\5'.$par.'\0');
|
||||||
}elsif ($cmd eq "len"){
|
}elsif ($cmd eq "len"){
|
||||||
my $par=pack("H*",shift);
|
my $par=pack("H*",shift);
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par),">\n";
|
||||||
syswrite(SER, '\6'.$par.'\0');
|
syswrite(SER, '\6'.$par.'\0');
|
||||||
}elsif ($cmd =~ /^S/){
|
}elsif ($cmd =~ /^S/){
|
||||||
$cmd=~s/S//;
|
$cmd=~s/S//;
|
||||||
|
|
@ -192,13 +303,20 @@ if($cmd =~ /^r/){
|
||||||
$par.=pack("N",0);
|
$par.=pack("N",0);
|
||||||
$par.=pack("N",0);
|
$par.=pack("N",0);
|
||||||
$par.=pack("N",0);
|
$par.=pack("N",0);
|
||||||
|
}elsif($scmd eq "i"){
|
||||||
|
$par.="i";
|
||||||
|
$par.=chr(shift); #gen
|
||||||
|
$par.=pack("N",shift||42);
|
||||||
|
|
||||||
|
$par.=shift;
|
||||||
|
$par.="\0"x(30-length($par));
|
||||||
}else{
|
}else{
|
||||||
die;
|
die;
|
||||||
};
|
};
|
||||||
|
|
||||||
$par.=pack("n",crcccitt($par));
|
$par.=pack("n",crcccitt($par));
|
||||||
# $par.="00";
|
# $par.="00";
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par),">\n";
|
||||||
while($cmd-->0){
|
while($cmd-->0){
|
||||||
syswrite(SER, '\1'.$par.'\0');
|
syswrite(SER, '\1'.$par.'\0');
|
||||||
print "len: ",length($par),"\n" if($cmd==0);
|
print "len: ",length($par),"\n" if($cmd==0);
|
||||||
|
|
@ -213,7 +331,7 @@ if($cmd =~ /^r/){
|
||||||
};
|
};
|
||||||
|
|
||||||
if($cmd==0){
|
if($cmd==0){
|
||||||
print "Send: <"; sprint $read; print ">\n";
|
print "Send: <". sprint($read) , ">\n";
|
||||||
};
|
};
|
||||||
};
|
};
|
||||||
}elsif ($cmd =~ /^s/){
|
}elsif ($cmd =~ /^s/){
|
||||||
|
|
@ -221,7 +339,7 @@ if($cmd =~ /^r/){
|
||||||
$cmd+=1;
|
$cmd+=1;
|
||||||
my $par=pack("H*",shift);
|
my $par=pack("H*",shift);
|
||||||
$par.=pack("n",crcccitt($par));
|
$par.=pack("n",crcccitt($par));
|
||||||
print "Write: <"; sprint $par; print ">\n";
|
print "Write: <", sprint($par), ">\n";
|
||||||
while($cmd-->0){
|
while($cmd-->0){
|
||||||
syswrite(SER, '\1'.$par.'\0');
|
syswrite(SER, '\1'.$par.'\0');
|
||||||
print "len: ",length($par),"\n";
|
print "len: ",length($par),"\n";
|
||||||
|
|
@ -235,14 +353,14 @@ if($cmd =~ /^r/){
|
||||||
}
|
}
|
||||||
};
|
};
|
||||||
|
|
||||||
print "Send: <"; sprint $read; print ">\n";
|
print "Send: <", sprint($read) , ">\n";
|
||||||
};
|
};
|
||||||
}else{
|
}else{
|
||||||
die;
|
die "Option not understood\n";
|
||||||
};
|
};
|
||||||
|
|
||||||
if (@fh = $sel->can_read(10)) {
|
if (@fh = $sel->can_read(10)) {
|
||||||
sysread($fh[0],$read,1024);
|
sysread($fh[0],$read,1024);
|
||||||
}
|
}
|
||||||
print "PostRead: <"; sprint $read; print ">\n";
|
print "PostRead: <", sprint($read), ">\n";
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue