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

tools/mesh/meshtrace.pl

@@ -37,9 +37,15 @@ $win_top->addstr(1,0,"-"x20);
 $win_top->refresh;
 
 my $beaconctr=0;
+my $crcerr=0;
 while(1){
     $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}}){
         $bdata{$p->{beacon}}=++$beaconctr;
     };

tools/mesh/r0ket.pm

@@ -9,8 +9,9 @@ package r0ket;
 
 use Digest::CRC qw(crcccitt);
 use POSIX qw(strftime);
+use Time::HiRes;
 
-our $verbose=1;
+our $verbose=0;
 our $bridge; # Open device
 
 ### Utility
@@ -19,11 +20,32 @@ sub sprint{
 		if (ord($_)>30 && ord($_)<127){
 			$_;
 		}else{
-			"[x".unpack("H*",$_)."]";
+#			"[x".unpack("H*",$_)."]";
+			"\\".unpack("C",$_);
 		}
         }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
 our %beacon;
 sub readbeacon{
@@ -69,32 +91,39 @@ sub writebeacon{
 ### Packet mgmt
 
 our $buffer;
+our $firstpkt=2;
 sub get_packet{
     sub _get_bytes{
         my $rr;
         sysread($bridge,$rr,1024);
         if(length($rr)<=1){
-            select(undef,undef,undef,0.1);
+            select(undef,undef,undef,0.05);
         };
         $buffer.=$rr;
     };
 
     my $cnt=0;
-    while(++$cnt<50){
+    while(++$cnt<100){
         if(length($buffer)<2){
             _get_bytes();
         }elsif($buffer !~ /^\\[12]/){
             $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
             return $str;
         }else{
             _get_bytes();
         };
     };
-    die "No packets for >1sec?\n";
+    die "No packets for 5seconds?\n";
 };
 
 sub rest{
@@ -120,7 +149,7 @@ sub nice_mesh{
 
         $out->{string}.=sprintf " t=%s (%+4d) rel=%s beacon=%s",
             strftime("%Y-%m-%d %H:%M:%S",gmtime $out->{time}),
-            $out->{time}-(time+3600),
+            $out->{time}-(Time::HiRes::time+3600),
             $out->{release},
             resolvebeacon($out->{beacon});
     }elsif($type eq "i"){
@@ -142,6 +171,65 @@ sub nice_mesh{
     }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;
+};
+
+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;
 };
 
@@ -194,25 +282,6 @@ sub nice_beacon{
     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{
     my $ser;
     if ($ARGV[0] eq "-s"){
@@ -263,4 +332,14 @@ sub set_rxlen {
     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;

tools/mesh/rf

@@ -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";