netlog

#! /usr/local/system/perl/bin/perl

use warnings;
use strict;

use Donald::Tools;
use Donald::Select;
use IO::Socket;
use Getopt::Long;
use Sys::Syslog;
use Donald::Select::Watchfile;

our ($RCS_REVISION)='$Revision: 1.36 $'=~/([\d.]+)/;

our %options;
our $TCP_MAX=1024;

# --------------------------------------------------------------

package My::RateLimit;

# max,divisor,current,time

sub new {
	my ($class,$max,$divisor)=@_;
	return bless [ $max,$divisor,$max,Donald::Select::time() ],$class;
}

sub can {
	my ($this)=@_;
	my ($max,$divisor,$current,$time)=@$this;
	my $now=Donald::Select::time();

	my $new=$current+($now-$time)*$max/$divisor;
	$new>$max and $new=$max;
	$this->[2]=$new;
	$this->[3]=$now;
	return $new>=1;
}


sub dec {
	my ($this)=@_;
	$this->[2]--;
}

sub as_string {
	my ($this)=@_;

	return sprintf '[max=%s,div=%s,cur=%s,time=%s]',@$this;
}

#---------------------------------------------------------------

package main;

our $send_socket;
our $send_socket_active;		# time last used;

sub check_idle {
	Donald::Select::timeout_requeue(5);
	if ($send_socket && $send_socket_active+5<Donald::Select::time) {
		$send_socket=undef;
	}
}

sub netlog {
	my ($log)=@_;
	unless (defined $send_socket) {
		$send_socket=new IO::Socket::INET(PeerAddr=>'macheteinfach',PeerPort=>1028) or return;
	}
	if ($send_socket->send(pack('n',length($log)).$log)) {
		$send_socket_active=Donald::Select::time();
	} else {
		$send_socket=undef;
	}
}

#-------------------------------------------

# (5,60) means 5 packets in 60 seconds

our %LIMIT=(	# ( class => rate-limit , ... )
	'OVERLOAD'=>new My::RateLimit(1,10800),		# 1 in 3 h
	'DISKFAIL'=>new My::RateLimit(10,10),
	'TEST'=>new My::RateLimit(10,10),
	'HARDERR'=>new My::RateLimit(1,14400),		# 1 in 4 h
	'NACHTWAECHTER' => new My::RateLimit(10,3600),	# 10 in 1 h
	'CPING' => new My::RateLimit(1,86400),		# 1 in 24 h
);

our $GLOBAL_LIMIT=new My::RateLimit(10,60);

sub filter {
	my ($date,$host,$proc,$rest)=@_;

	$_=$rest;

	/^NETLOG/ and return 0;

	if ($proc eq 'clusterd') {
		/DOWN|rebootet/ and return 'STATE';

		return 'CPING' if /failed to ping/;

		if (/pload/)
		{
			my $return = 'OVERLOAD';
			return $return;
		}
	}
	if (/changed hw address/) {
		return 0 if /IP_0\.0\.0\.0/;
		return 0 if /DHCP_169\.254\./;
		return 0 if /00:1f:f3:c5:5d:ad/; # capsule nietfeld
		return 0 if /00:1f:f3:3f:2c:c6/; # capsule lappe
		return 0 if /00:24:36:a1:33:7d/; # capsule bgh
		return 0 if /d8:30:62:47:7c:3e/; # capsule hucho
		return 'ETHER';
	}
	$proc eq 'GNZ optic' and /BAD!/ and return 'GNZ';
	$proc eq 'nachtwaechter' and return 'NACHTWAECHTER';
	if ($proc eq 'kernel') {
		/3w-(9xxx|sas).*ERROR/ and return 'DISKFAIL';
		/3w-(9xxx|sas).*Enclosure added|timed out, resetting card/ and return 'CONTROLLERFAIL';
		/3w-(9xxx|sas).*Battery is (weak|not present)/ and return 'BBUFAIL';
		/3w-(9xxx|sas).*Battery temperature is (high|too high)/ and return 'BBUTEMP';
		# /^Pid:/ and return 'KERNEL';
		/I\/O error in filesystem/ and return 'FSCRASH';
		/I\/O error, dev/ and return 'FSCRASH';
		/hardware error/i and return 'HARDERR';
		/INFO:/i and return 'HARDERR';
		/rpc-srv\/tcp: nfsd/ and return 'NFSOVERLOAD';
		/rcu_sched detected stalls/ and return 'RCUSTALL';
		/invoked oom-killer/ and return 'OOMKILLER';
	}
	if ($proc =~ /^imaps?/) {
		 /bailing out/ and return 'IMAP_MAILBOX';
		/error/ && !/tls_start_servertls/ and return 'IMAP_MAILBOX';
	}
	if ($proc eq 'root') {
		/kvm-event/ and return 'KVM';
	}

	/netlog test/ and return 'TEST';

	/WEBCAM/ and return 'CAM';

	$proc eq 'InRow RC' and return 'INROW';
	if ($proc eq 'UPS') {
		return 'UPS' unless /(Started|Passed) a self-test./;
	}

	/Power supply/ and return 'POWER';

	if ($host=~ /^172.20.2./) {
		return 'MGMT';
	}

	/error: PAM/ and return 'AUTH';

	/>> mount\.nfs: mount system call failed/ and return "MOUNT_SYS_FAILED";

	/remote fault/ and return 'REMOTE_FAULT';

	if ($proc eq 'logwatcher' && /block IP/) { # /project/admin/tools/logwatcher.pl on geniux
		return 'LOGWATCHER';
	}

	if ($proc eq 'smtpwatcher' && /block IP/) { # /project/admin/tools/smtpwatcher.pl on tldr
		return 'LOGWATCHER';
	}

	/scheduling restart/ and return 'SERVICE_RESTART';

	/RPC request reserved/ and return 'NFS_41_PROBLEM';
	/VFS: file-max limit/ and return 'VFS_FILE_MAX';

	return 0;
}

sub parse_date_host_proc_rest {
	my ($line)=@_;

	# Sep  6 09:00:01 lol sshd[3582]: Accepted rsa for root from 141.14.28.170 port 59687

	$line=~/^([A-Z][a-z][a-z] [ \d]\d \d\d:\d\d:\d\d) (\S+) ([^:]+): ?(.*)/ and return ($1,$2,$3,$4);

	# ISO 8601 timetamp extended format
	# 2011-09-06T09:14:15+02:00 theinternet root: netlog test

	$line=~/(^\d\d\d\d-\d\d-\d\dT\S+) (\S+) ([^:]+): ?(.*)/ and return ($1,$2,$3,$4);

	# /package/syslog format
	# 2015-01-09 00:00:18 141.14.16.213 <182>whatever

	$line=~/(^\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d) (\d+\.\d+\.\d+\.\d+) <\d+>\s*(.+)/ and return ($1,$2,'REMOTE',$3);

	# strange remote hosts

	# JAN 09 00:10:51 2015  x506-2 [audit] user=[SYS] src=0.0.0.0 iface=4 access=8 System time is about to be updated by NTP

	$line =~/^([A-Z][A-Z][A-Z] [\d ]\d \d\d:\d\d:\d\d (?:\d\d\d\d)?)\s*(\S+) (.+)/i and return ($1,$2,'',$3);

	# (at-gs950-05)
	# Jan  9 09:50:22 2015:LinkStatus-6:Port 7 link up, 100Mbps FULL duplex

	$line =~ /^([A-Z][a-z][a-z] [\d ]\d \d\d:\d\d:\d\d \d\d\d\d):(.*)/ and return ($1,'','',$2);

	# 0d00h54m17s:icx6430-48-04 MSTP: MST 0 Port 1/1/42 - DISCARDING

	$line =~ /^\dd\d\dh\d\dm\d\ds:(\S+) ([^:]+): ?(.*)/ and return ('',$1,$2,$3);

	# remote:0d00h21m20s:icx6430-24-12 startup-config was changed by admin from ssh client 141.14.31.7

	$line =~ /^\dd\d\dh\d\dm\d\ds:(\S+) ?(.*)/ and return ('',$1,'',$2);

	return ();
}

sub parse_line {
	my ($line)=@_;
	my ($date,$host,$proc,$rest);

	unless ( ($date,$host,$proc,$rest) = parse_date_host_proc_rest($line)) {
		# warn "ignored: $line\n";
		return ();
	}

	if ($proc eq 'REMOTE') {
		if (my ($remote_date,$remote_host,$remote_proc,$remote_rest)=parse_date_host_proc_rest($rest)) {
			($host,$proc,$rest)=($remote_host||$host,$remote_proc,$remote_rest);
		} else {
			# warn "ignored remote:$rest\n";
		}
	}

	$proc=~s/\[.*\]//;		# remove pid

	return ($date,$host,$proc,$rest);
}

sub test_line {
	my ($line)=@_;
	my ($date,$host,$proc,$rest)=parse_line($line) or return;

	#printf "%-10s %-20s %-20s %-20s %s\n",'',$date,$host,$proc,$rest;

	my $class=filter($date,$host,$proc,$rest);
	$class or return;

	printf "%-10s %-20s %-20s %-20s %s\n",$class,$date,$host,$proc,$rest;
}

sub do_line {
	my ($line)=@_;

	my ($date,$host,$proc,$rest)=parse_line($line) or return;

	my $class=filter($date,$host,$proc,$rest);
	$class or return;

	my $limit=$LIMIT{$class};
	unless ($limit)
	{
		$limit=$LIMIT{$class}=new My::RateLimit(10,10);
	}
	$limit->can or return warn "THROTTLE $class\n";
	$GLOBAL_LIMIT->can or return warn "THROTTLE GLOBAL\n";
	$limit->dec();
	$GLOBAL_LIMIT->dec();
	netlog("$host $proc $rest");
}

#-------------------------------------------

use IO::File;

sub syslog_new {
	for my $filename (@_) {
		my $ctx={FILENAME=>$filename,IO=>undef,EOF=>0,HALFLINE=>''};
		Donald::Select::timeout(0,\&do_syslog,$ctx);
	}
}

sub do_syslog {
	my ($ctx)=@_;		# { FILENAME=>filename, IO=>io-handle, EOF=>flag, HALFLINE=>'' }

	unless ($ctx->{IO}) {
		$ctx->{IO}=new IO::File $ctx->{FILENAME},'r';
		unless ($ctx->{IO}) {
			warn $ctx->{FILENAME}.": $!\n";
			Donald::Select::timeout_requeue(600);		# retry open after 10 minutes
			return;
		}
		unless ($ctx->{IO}->seek(0,2)) {
			warn $ctx->{FILENAME}.": $!\n";
			$ctx->{IO}=undef;
			Donald::Select::timeout_requeue(600);
			return;
		}
		$ctx->{EOF}=0;
	}

	my $line;
	while (defined (my $line = $ctx->{IO}->getline())) {
		# warn  "R: $line\n";
		unless ($line =~ /\n$/) {
			$ctx->{HALFLINE}.=$line;
			last;
		}
		chomp($line);
		do_line($ctx->{HALFLINE}?$ctx->{HALFLINE}.$line:$line);
		$ctx->{HALFLINE}='';
		$ctx->{EOF}=0;
	}
	$ctx->{EOF}++;
	if ($ctx->{EOF}>600) {					# 10 minutes or so idle - reopen
		$ctx->{IO}=undef;
		Donald::Select::timeout_requeue(0);
		return;
	} else {
		Donald::Select::timeout_requeue(1);		# at eof. next poll in a second
		return;
	}

	die "not reached";
}

#-------------------------------------------

sub USAGE {
	return<<'__EOF__';
usage:
        $0 --kill  # try to kill a running server

        $0 --daemon [options] logfile...
            --kill         # try to kill previous server first
            --foreground   # stay in foreground, log to stderr
            --syslog       # log to syslog instead of stderr

	$0 --test logfile....  # debug: just run filters against files

__EOF__
}


GetOptions (
	'kill' =>   \$options{'kill'},
	'daemon' => \$options{'daemon'},
	'foreground' => \$options{'foreground'},
	'syslog' => \$options{'syslog'},
	'test' =>   \$options{'test'},
) or die USAGE;


if ($options{'test'}) {
	@ARGV>=1 or die USAGE;
	while (<>) {
		chomp;
		test_line($_);
	}
	exit;
} elsif ($options{'daemon'}) {
	@ARGV>=1 or die USAGE;

	$SIG{PIPE}='IGNORE';

	$options{'kill'} and Donald::Tools::kill_previous_server('netlog') and sleep 2;

	unless ($options{'foreground'}) {
		my $pid=fork;
		defined $pid or die "$!\n";
		$pid and exit;
	}

	if ($options{'syslog'} or not $options{'foreground'}) {
		openlog('netlog','pid','daemon');
		Sys::Syslog::setlogsock('unix');                # with 'native' we get EOLs in the logfile, option "noeol" doesn't work
		$SIG{__WARN__} = sub { syslog('warning',@_); };
		$SIG{__DIE__}  = sub { syslog('crit',@_);syslog('crit','exiting');exit 1;};
		open (STDOUT,'>','/dev/null');
		open (STDERR,'>','/dev/null');
		open (STDIN,'<','/dev/null');
	}
	warn "server started\n";
	Donald::Select::Watchfile->new ($0,5,sub {
			system $0,'--kill','--daemon',($options{'foreground'}?'--foreground':()),($options{'syslog'}?'--syslog':()),@ARGV or exit;
			warn "restart failed\n";
		}
	);

	{	# dirty hack
		chomp(my $hostname=`hostname -s`);
		push @ARGV,'/package/syslog/log/current.log' if defined $hostname && $hostname eq 'wtf';
	}

	syslog_new(@ARGV);
	Donald::Select::timeout(5,\&check_idle);
	Donald::Select::run();
} elsif ($options{'kill'}) {
	@ARGV==0 or die USAGE;
	Donald::Tools::kill_previous_server('netlog');
} else {
	die USAGE;
}