Add simple beacon tracer.

This commit is contained in:
Stefan `Sec` Zehl 2012-01-27 02:02:51 +01:00
parent a38a5a9874
commit df42d159ed
2 changed files with 103 additions and 0 deletions

64
tools/mesh/beacontrace.pl Executable file
View File

@ -0,0 +1,64 @@
#!/usr/bin/perl
#
# vim:set ts=4 sw=4:
use strict;
use Curses;
use POSIX qw(strftime);
use lib '.';
use r0ket;
$|=1;
my $ser="<undef>";
do {$ser=$_ if ( -e $_ ) } for qw(/dev/ttyS3 /dev/ttyACM0);
if ($ARGV[0] eq "-s"){
shift;
$ser=shift;
};
open(SER, "+<",$ser) || die "open serial: $!";
#r0ket::readbeacon();
my $str;
my %bdata;
initscr;
END{endwin;}
use constant WIDTH => 80;
use constant m_height => 15;
my $win_top=subwin(2,WIDTH,0,0);
my $win=subwin(m_height,WIDTH,2,0);
noecho;
curs_set(0);
$win_top->addstr(0,0,"r0ket Beacon-Trace 0.1");
$win_top->addstr(1,0,"-"x20);
$win_top->refresh;
my $beaconctr=0;
while(1){
$str=r0ket::get_packet(\*SER);
my $p=r0ket::nice_beacon($str);
if(!$bdata{$p->{beacon}}){
$bdata{$p->{beacon}}=++$beaconctr;
};
if($p->{type} eq "beacon"){
$win->addstr($bdata{$p->{beacon}},0,
sprintf "%s | bt=%s str=%s idx=%8s | %s",
$p->{beacon},
$p->{button},
$p->{strength},
$p->{idx},
r0ket::getbeacon($p->{beacon})
);
}else{
$win->addstr($bdata{$p->{beacon}},40,$p->{nick});
};
$win->refresh;
};
r0ket::rest();

View File

@ -145,6 +145,45 @@ sub nice_mesh{
return $out; return $out;
}; };
sub nice_beacon{
my $pkt=shift;
my $out;
my $type=substr($pkt,1,1);
$out->{type}=$type;
if($type eq "\x17"){
$out->{type}= "beacon";
$out->{length}= unpack("C", substr($pkt,0,1));
$out->{button}= unpack("H*",substr($pkt,2,1));
$out->{strength}=unpack("H*",substr($pkt,3,1));
$out->{idx}= unpack("N", substr($pkt,4,4));
$out->{beacon}= unpack("H*",substr($pkt,8,4));
$out->{unused}= unpack("H*",substr($pkt,12,2));
$out->{string}=sprintf "BEACON ln=%d bt=%s str=%s idx=%08x beacon=%s",
$out->{length},
$out->{button},
$out->{strength},
$out->{idx},
$out->{beacon};
if(unpack("H*",substr($pkt,12,2)) ne "ffff"){
print "unused=",unpack("H*",substr($pkt,12,2))," ";
};
}elsif($type eq "\x23"){
$out->{type}= "nick";
$out->{beacon}= unpack("H*",substr($pkt,2,4));
$out->{nick}= unpack("Z*",substr($pkt,6,length($pkt)-2));
$out->{string}=sprintf "NICK beacon=%s nick=%s",
$out->{beacon},
$out->{nick};
}else{
$out->{string}="<?:".unpack("H*",$pkt).">";
};
return $out;
};
sub pkt_beauty{ sub pkt_beauty{
my $pkt=shift; my $pkt=shift;
my $out; my $out;