ctdo
/
crashtest-r0ket
16
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
crashtest-r0ket/tools/mesh/dbg.pl

368 lines
9.2 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/perl
#
# vim:set ts=4 sw=4:
use strict;
use IO::Select;
use Digest::CRC qw(crcccitt);
use POSIX qw(strftime);
$|=1;
my @fh;
my $read;
sub sprint{
return join("",map {
if (ord($_)>30 && ord($_)<127){
$_;
}else{
"[x".unpack("H*",$_)."]";
}
}split(//,shift));
};
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);
};
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;
$sel->add(\*SER);
my $cmd=shift;
if($cmd =~ /^r/){
readbeacon();
$cmd=~s/r//;
$cmd=100 if $cmd+0==0;
my $fmt=shift;
my $arg=shift || undef;
my $read="";
while($cmd>0){
if(length($read)>2 && $read !~ /^\\1/){
$read=~s/^(.[^\\]*)//s;
print "Unparseable stuff: <",sprint($1),">\n";
# print "Rest was: ",sprint($read),"!\n";
};
if ($read !~ s/^\\1(.*?)\\0//s){
my $rr="";
sysread(SER,$rr,1024);
$read.=$rr;
}else{
my $str=$1;
$str=~s/\\\\/\\/g; # dequote
my $pkt_crc= unpack("n",substr($str,length($str)-2,2));
my $calc_crc= crcccitt(substr($str,0,length($str)-2));
if($fmt eq "m"){
my $i=substr($str,0,1);
next if(defined $arg && $arg ne $i);
print "M [$i] ";
print "g=",unpack("C",substr($str,1,1))," ";
if($i eq "T"){
print "t=";
# print unpack("N",substr($str,2,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 " rel=",unpack("H*",substr($str,24,2));
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"){
print "<",unpack("H*",$str),">";
}else{
print "<", sprint($str), ">\n";
};
print "CRCFAIL" if ($pkt_crc ne $calc_crc);
print "\n";
$cmd--;
next;
};
if($read !~ /^\\1/){
};
};
if(length($read)>0){
print "rest: <", sprint($read), ">\n";
};
exit;
}elsif ($cmd eq "pM"){
syswrite(SER, '\3ORBIT\0');
syswrite(SER, '\4ORBIT\0');
syswrite(SER, '\5S\0');
syswrite(SER, '\6'.pack("H*","20").'\0');
}elsif ($cmd eq "pB"){
syswrite(SER, '\3'.pack("H*","0102030201").'\0');
syswrite(SER, '\4'.pack("H*","0102030201").'\0');
syswrite(SER, '\5Q\0');
syswrite(SER, '\6'.pack("H*","10").'\0');
}elsif ($cmd eq "mt"){
my $par=pack("H*",shift);
print "Write: <", sprint($par),">\n";
syswrite(SER, '\3'.$par.'\0');
}elsif ($cmd eq "mta"){
my $par=shift;
print "Write: <", sprint($par),">\n";
print "len: ",length($par),"\n";
syswrite(SER, '\3'.$par.'\0');
}elsif ($cmd eq "mr"){
my $par=pack("H*",shift);
print "Write: <", sprint($par),">\n";
syswrite(SER, '\4'.$par.'\0');
}elsif ($cmd eq "mra"){
my $par=shift;
print "Write: <", sprint($par),">\n";
syswrite(SER, '\4'.$par.'\0');
}elsif ($cmd eq "ch"){
my $par=pack("H*",shift);
print "Write: <", sprint($par),">\n";
syswrite(SER, '\5'.$par.'\0');
}elsif ($cmd eq "len"){
my $par=pack("H*",shift);
print "Write: <", sprint($par),">\n";
syswrite(SER, '\6'.$par.'\0');
}elsif ($cmd =~ /^S/){
$cmd=~s/S//;
$cmd+=1;
my $par="";
my $scmd=shift||"t";
if($scmd eq "t"){
$par.="T";
$par.=chr(shift); #gen
$par.=pack("N",scalar(time)+1*60*60);
$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 "rrr"){
$par.="G";
$par.=chr(shift); #gen
# $par.=pack("N",scalar(time)+300);
$par.=pack("N",1325250000);
$par.="r0ket mass p0ng";
$par.=pack("C",0);
$par.=pack("C",0);
$par.=pack("C",0);
$par.=pack("C",0);
$par.=pack("C",0);
$par.=pack("C",0);
$par.=pack("C",0);
$par.=pack("C",0);
$par.=pack("C",0);
print length($par),"\n";
}elsif($scmd eq "a"){
$par.="A";
$par.=chr(shift); #gen
$par.=pack("N",scalar(time)+1*60*60+ 300);
$par.= pack("C",shift||0);
$par.= pack("C",0);
$par.= pack("C",0);
$par.= pack("C",0);
$par.=pack("N",0);
$par.=pack("N",0);
$par.=pack("N",0);
$par.=pack("N",0);
$par.=pack("N",0);
}elsif($scmd eq "b"){
$par.="B";
$par.=chr(shift); #gen
$par.=pack("N",scalar(time)+1*60*60+ 600);
$par.= pack("C",shift||0);
$par.= pack("C",0);
$par.= pack("C",0);
$par.= pack("C",0);
$par.=pack("N",0);
$par.=pack("N",0);
$par.=pack("N",0);
$par.=pack("N",0);
$par.=pack("N",0);
}elsif($scmd eq "c"){
$par.="\x1";
$par.=chr(shift); #gen
$par.=pack("N",scalar(time)+1*60*60+ 600);
$par.= pack("C",shift||0);
$par.= pack("C",0);
$par.= pack("C",0);
$par.= pack("C",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{
die;
};
$par.=pack("n",crcccitt($par));
# $par.="00";
print "Write: <", sprint($par),">\n";
while($cmd-->0){
syswrite(SER, '\1'.$par.'\0');
print "len: ",length($par),"\n" if($cmd==0);
my $read="";
while($read !~ /\\2.*\\0/){
my $rr="";
if (@fh = $sel->can_read(100)) {
sysread($fh[0],$rr,1024);
$read.=$rr;
}
};
if($cmd==0){
print "Send: <". sprint($read) , ">\n";
};
};
}elsif ($cmd =~ /^s/){
$cmd=~s/s//;
$cmd+=1;
my $par=pack("H*",shift);
$par.=pack("n",crcccitt($par));
print "Write: <", sprint($par), ">\n";
while($cmd-->0){
syswrite(SER, '\1'.$par.'\0');
print "len: ",length($par),"\n";
my $read="";
while($read !~ /\\2.*\\0/){
my $rr="";
if (@fh = $sel->can_read(100)) {
sysread($fh[0],$rr,1024);
$read.=$rr;
}
};
print "Send: <", sprint($read) , ">\n";
};
}else{
die "Option not understood\n";
};
if (@fh = $sel->can_read(10)) {
sysread($fh[0],$read,1024);
}
print "PostRead: <", sprint($read), ">\n";
Reference in New Issue View Git Blame Copy Permalink