Move all the reader stuff to a new subdir

This commit is contained in:
Stefan `Sec` Zehl 2012-05-18 13:15:03 +02:00
parent 703e365da4
commit fb77797478
4 changed files with 201 additions and 6 deletions

View File

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

32
tools/reader/listen-log.pl Executable file
View File

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

View File

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

82
tools/reader/reader-watchdog.pl Executable file
View File

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