Move all the reader stuff to a new subdir

tools/reader/beacon-udp.pl

@@ -10,6 +10,7 @@ use Digest::CRC qw(crcccitt);
 
 use FindBin;
 use lib "$FindBin::Bin/lib";
+use lib "$FindBin::Bin/../mesh/lib";
 use r0ket;
 
 $|=1;
@@ -162,14 +163,15 @@ while(1){
 
     if(length($pkt) != 16){  # Sanity check
         $errors++;
+        print STDERR "Length check\n";
         next;
     };
     $ctr++;
 
     my $idoff=0;
-    if(substr($pkt,12,1) eq "\xee"){
+#    if(substr($pkt,12,1) eq "\xee"){
-         $idoff=1000;
+#         $idoff=1000;
-    };
+#    };
 
     my $hdr= pack("CCnnNN",
             1,         # proto (BEACONLOG_SIGHTING)
@@ -198,8 +200,8 @@ while(1){
     }else{
         $typeunknown++;
     };
-    if($idoff){
+#    if($idoff){
-        $typeunknown++;
+#        $typeunknown++;
-    };
+#    };
 };
 r0ket::rest();

tools/reader/listen-log.pl

@@ -0,0 +1,32 @@
+#!/usr/bin/perl
+#
+# vim:set ts=4 sw=4:
+
+use strict;
+use warnings;
+use Socket;
+
+our $port=514;
+my  $hispaddr;
+
+my $socket;
+
+my($iaddr,$proto,$paddr);
+$iaddr = pack('C4', 0,0,0,0);
+$proto = getprotobyname('udp');
+$paddr = sockaddr_in($port, $iaddr); # 0 means let kernel pick
+
+socket($socket, PF_INET, SOCK_DGRAM, $proto)   || die "socket: $!";
+bind($socket, $paddr)                          || die "bind: $!";
+
+my ($hisiaddr,$host);
+my $buf;
+while (1){
+    $hispaddr = recv($socket, $buf, 2048, 0)    || die "recv: $!";
+    ($port, $hisiaddr) = sockaddr_in($hispaddr);
+#    $host = gethostbyaddr($hisiaddr, AF_INET);
+    $host=join(".",unpack("CCCC",$hisiaddr));
+    $buf =~ y!a-zA-Z0-9.:,; _()[]{}?-!!cd;
+    print substr(scalar(localtime),11,8)," ",$host," ",$buf,"\n";
+};
+

tools/reader/netlink-notifier.pl

@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+#
+# vim:set ts=4 sw=4:
+
+use strict;
+use POSIX;
+use Socket;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use l0gger;
+
+l0gger::init();
+
+
+use constant AF_NETLINK => 16;
+#use Socket::Netlink;
+
+# Netlink setup
+socket my $sock,AF_NETLINK,SOCK_RAW,0 #(domain, type, bus//protocol)
+	or die "socket: $!\n";
+bind $sock, pack("vvVV",AF_NETLINK,0,0,1) #(domain, zero , pid, group);
+	or die "bind: $!\n";
+
+while(1){
+	sysread($sock,my $msg, 65535) or die "recv: $!";
+	my ($ifname,$state)=(undef,undef);
+
+#	print unpack("H*",substr($message,0,16)),"\n"; # ifi_type etc. 
+	$msg=substr($msg,16);
+
+	my (undef,undef,undef,undef,undef,$type)=unpack("nnnnCC",$msg);
+	$msg=substr($msg,16);
+#	print "Type=$type\n";
+	next if($type!=16); 	# RTM_NEWLINK
+
+	while(length($msg)){
+		my($len,$type)=unpack("vv",$msg);
+#		print "len= $len,type=$type\n";
+		last if($len<4);
+
+		$msg=substr($msg,4);
+		if    ($type ==  3){	# IFLA_IFNAME
+			$ifname=unpack("Z*",$msg);
+		}elsif($type == 16){	# IFLA_OPERSTATE
+			$state=unpack("v",$msg);
+		}else{
+#			print "content=",unpack("H*",substr($msg,0,$len-4)),"\n";
+		};
+
+		$len=(int(($len-1)/4))*4; # 4-byte alignment
+		$msg=substr($msg,$len);
+	};
+	next if(!defined($ifname) || !defined($state));
+#	print "ifname=$ifname, state=$state\n";
+# IF_OPER_UNKNOWN (0):
+#  Interface is in unknown state, neither driver nor userspace has set
+#  operational state. Interface must be considered for user data as
+#  setting operational state has not been implemented in every driver.
+# IF_OPER_NOTPRESENT (1):
+#  Unused in current kernel (notpresent interfaces normally disappear),
+#  just a numerical placeholder.
+# IF_OPER_DOWN (2):
+#  Interface is unable to transfer data on L1, f.e. ethernet is not
+#  plugged or interface is ADMIN down.
+# IF_OPER_LOWERLAYERDOWN (3):
+#  Interfaces stacked on an interface that is IF_OPER_DOWN show this
+#  state (f.e. VLAN).
+# IF_OPER_TESTING (4):
+#  Unused in current kernel.
+# IF_OPER_DORMANT (5):
+#  Interface is L1 up, but waiting for an external event, f.e. for a
+#  protocol to establish. (802.1X)
+# IF_OPER_UP (6):
+#  Interface is operational up and can be used.
+	if($state==6){
+        l0gger::send("$ifname up");
+	};
+}

tools/reader/reader-watchdog.pl

@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+
+use strict;
+use POSIX ":sys_wait_h"; # for nonblocking read
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use lib "$FindBin::Bin/../mesh/lib";
+use r0ket;
+use l0gger;
+
+$|=1;
+
+my $DEV="/dev";
+
+my %run;
+my %childs;
+my %config;
+
+my @exec;
+
+$SIG{CHLD} = sub {
+    # don't change $! and $? outside handler
+    local ($!, $?);
+    my $pid = waitpid(-1, WNOHANG);
+    return if $pid == -1;
+    return unless defined $childs{$pid};
+    delete $run{$childs{$pid}}; # cleanup?
+    delete $childs{$pid};
+};
+
+# read config
+
+sub readcfg{
+    %config=();
+    open(R,"<","reader.cf")|| die "Can't find reader.cf\n";
+    while(<R>){
+        chomp;
+        next unless /(.*?)=(.*)/;
+        $config{$1}=$2;
+    };
+    close(R);
+    @exec=$config{"prog"},split(/\s+/,$config{"args"});
+    delete $config{prog};
+    delete $config{args};
+};
+
+readcfg();
+l0gger::init();
+
+while(1){
+	opendir(my $dh, $DEV);
+	my @paths=grep {/^ttyACM/} readdir($dh);
+	close $dh;
+#	print "f: ",join(",",@files),"\n";
+	for my $path (@paths){
+        next if $run{$path};
+
+        my $id = eval {
+            r0ket::r0ket_init($DEV."/".$path);
+            return r0ket::get_id();
+        };
+#        print "r0id: $id\n";
+        if(!defined $config{$id}){
+            print "No config for r0ket $id @ $path, skipping...\n";
+            next;
+        };
+        $run{$path}=$id;
+
+        my $pid = fork();
+        die "cannot fork" unless defined $pid;
+        if ($pid == 0) {
+            exec @exec,'-d',$DEV."/".$path,'-i',$config{$id};
+        } else {
+            print "Started $path : $id @ $pid\n";
+            l0gger::send("started $path : $id @ $pid");
+            $childs{$pid}=$path;
+        }
+	};
+	sleep(1);
+	print join(",",map {$run{$childs{$_}}."@".$childs{$_}."[$_]"} sort {$childs{$a}cmp$childs{$b}} keys %childs),"\n";
+};