diff --git a/tools/mesh/beacontrace.pl b/tools/mesh/beacontrace.pl
new file mode 100755
index 0000000..c23fd8a
--- /dev/null
+++ b/tools/mesh/beacontrace.pl
@@ -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();
diff --git a/tools/mesh/r0ket.pm b/tools/mesh/r0ket.pm
index 1161690..26a94cc 100755
--- a/tools/mesh/r0ket.pm
+++ b/tools/mesh/r0ket.pm
@@ -145,6 +145,45 @@ sub nice_mesh{
     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{
     my $pkt=shift;
     my $out;