#!/usr/bin/perl
##
## (Ad-Hoc) Host self-health checker
## Copyright (c) 2008 SATOH Fumiyasu @ OSS Technology Corp.
## Copyright (c) 2002-2007 SATOH Fumiyasu
##
## Lisence: GNU General Public License version 2 or later
## Date: 2008-09-16, since 2002-10-22
##
## Supported platforms:
##	Solaris (Solaris 8)
##	Linux (Debian GNU/Linux)
##
## Target:
##	CPU load
##	Virtual memory usage
##	Disk usage (size and inode)
##	DiskSuite / Volume Manager status (Solaris)
##	Listening ports
##	LOMlite (Solaris/SPARC with LOMlite)
##
## FIXME:
##	Support address:port[-range], address:port/program in @TCPPort
##	Rename @{TCP,UDP}PortIngore to @{TCP,UDP}PortOnDemand?
##	Add more comments in script
##	Support to check number of running processes (ps -ef)
##	IPv6? (partially supported)
##	Unix domain socket?
##

use strict;
use warnings;
use English;
use IO::File;

use constant true => 1;
use constant false => 0;

$ENV{'LC_ALL'} = 'C';
$ENV{'PATH'} = '/bin:/usr/bin:/sbin:/usr/sbin';

## Configurations
## ======================================================================

use vars qw(
    $LoadAverageThreshold
    $VirtualMemoryUsageThreshold
    $PhysicalMemoryUsageThreshold
    @DiskMountpointIgnore
    $DiskSizeUsageThreshold
    $DiskInodeUsageThreshold
    $InterfaceReceiveErrorThreshold
    $InterfaceSendErrorThreshold
    @RPCService
    @TCPPort
    @TCPPortIgnore
    @UDPPort
    @UDPPortIgnore
);

## Read external configiration file
## ----------------------------------------------------------------------

my $configfile = shift(@ARGV);
if (!defined($configfile)) {
    print "Usage: $0 CONFIGFILE\n";
    exit(0);
}

eval {
    require $configfile;
};
if ($EVAL_ERROR) {
    die "Cannot evaluate configuration file: $configfile: $EVAL_ERROR";
}

## Startup
## ======================================================================

chomp(my $UName = `uname`);
chomp(my $URel = `uname -r`);

@RPCService = grep(/^\w/, @RPCService);

@TCPPort = grep(/^[\w*]/, @TCPPort);
my %TCPPort = ();
for my $tcp_port (@TCPPort) {
    my ($addr, $port) = $tcp_port =~ m#^([^/]*)[.:]([\w\-]+)(?:/([\w\-.]+))?$#;
    $tcp_port = hostname2address($addr) . ':' . service2port($port, 'tcp');
    $TCPPort{$tcp_port} = true;
}

my @tcp_port_ignore = grep(/^[\w*]/, @TCPPortIgnore);
for my $tcp_port (@tcp_port_ignore) {
    my ($addr, $port, $prog) = $tcp_port =~ m#^([^/]*)[.:]([\w\-]+)(?:/([\w\-.]+))?$#;
    if ($port =~ /^(\d+)-(\d+)$/) {
	my ($port_low, $port_high) = ($1, $2);
	$addr = hostname2address($addr);
	for (my $p = $port_low; $p <= $port_high; $p++) {
	    $tcp_port = $addr . ':' . $p;
	    $tcp_port .=  "/$prog" if (defined($prog));
	    push(@TCPPortIgnore, $tcp_port);
	}
    } else {
	$tcp_port = hostname2address($addr) . ':' . service2port($port, 'tcp');
	$tcp_port .=  "/$prog" if (defined($prog));
	push(@TCPPortIgnore, $tcp_port);
    }
}

@UDPPort = grep(/^[\w*]/, @UDPPort);
my %UDPPort = ();
for my $udp_port (@UDPPort) {
    my ($addr, $port) = $udp_port =~ m#^([^/]*)[.:]([\w\-]+)(?:/([\w\-.]+))?$#;
    $udp_port = hostname2address($addr) . ':' . service2port($port, 'udp');
    $UDPPort{$udp_port} = true;
}

my @udp_port_ignore = grep(/^[\w*]/, @UDPPortIgnore);
for my $udp_port (@udp_port_ignore) {
    my ($addr, $port, $prog) = $udp_port =~ m#^([^/]*)[.:]([\w\-]+)(?:/([\w\-.]+))?$#;
    if ($port =~ /^(\d+)-(\d+)$/) {
	my ($port_low, $port_high) = ($1, $2);
	$addr = hostname2address($addr);
	for (my $p = $port_low; $p <= $port_high; $p++) {
	    $udp_port = $addr . ':' . $p;
	    $udp_port .=  "/$prog" if (defined($prog));
	    push(@UDPPortIgnore, $udp_port);
	}
    } else {
	$udp_port = hostname2address($addr) . ':' . service2port($port, 'udp');
	$udp_port .=  "/$prog" if (defined($prog));
	push(@UDPPortIgnore, $udp_port);
    }
}

## ======================================================================

sub hostname2address
{
    my ($hostname) = @_;

    if ($hostname eq '*') {
	## NOP
    } elsif ($hostname eq '0.0.0.0') {
	$hostname = '*';
    } elsif ($hostname !~ /^\d+\.\d+\.\d+\.\d+$/) {
	if (my @addr = gethostbyname($hostname)) {
	    shift(@addr); shift(@addr); shift(@addr); shift(@addr);
	    for my $addr (@addr) {
		$addr = join('.', unpack('C4', $addr));
	    }
	    if (@addr > 1) {
		die "Hostname has multiple IP address: $hostname: @addr";
	    }
	    $hostname = $addr[0];
	} else {
	    die "Cannot find hostname entry: $hostname";
	}
    }

    return $hostname;
}

sub service2port
{
    my ($service, $proto) = @_;

    if ($service !~ /^\d+$/) {
	if (defined(my $port = (getservbyname($service, $proto))[-2])) {
	    $service = $port;
	}
    }

    return $service;
}

sub is_in_samezone
{
    my ($pid) = @_;

    return true unless ($pid =~ /^\d+$/);

    if ($UName eq 'Linux') {
	my $status_fh = IO::File->new("/proc/$pid/status") || return false;
	my $status = join('', $status_fh->getlines);
	if ($status =~ /^envID:\s+(\d+)$/m) {
	    ## OpenVZ
	    return false if ($1 != 0);
	}
    }

    return true;
}

sub report_load
{
    my @report = ();

    my $out = `uptime`;
    my ($la1, $la5, $la15) = ($out =~ /load average: (\S+), (\S+), (\S+)/);
    if ($la5 > $LoadAverageThreshold) {
	push(@report,
	    "Load average in 5 minutes: $la5 (>$LoadAverageThreshold)\n"
	);
    }

    return @report;
}

sub report_virtualmemory
{
    my @report = ();

    my ($used, $free);
    if ($UName eq 'SunOS') {
	## FIXME: `swap -s` shows virtual swap space except locked memory.
	##        How to get amount of locked memory?
	##        http://www.idg.co.jp/sw/back/series/200102_01_kernel.html
	my $out = `swap -s`;
	($used, $free) = ($out =~ /(\d+)k used, (\d+)k available/);
    } elsif ($UName eq 'Linux') {
	my $out = `free`;
	my ($mem_used, $mem_free) = ($out =~ /cache:\s+(\d+)\s+(\d+)/m);
	my ($cache_used, $cache_free) = ($out =~ /^Swap:\s+\d+\s+(\d+)\s+(\d+)/m);
	$used = $mem_used + $cache_used;
	$free = $mem_free + $cache_free;
    } else {
	die "Unsupported plathome: $UName";
    }

    my $used_pct = int($used / ($free+$used) * 100);
    if ($used_pct > $VirtualMemoryUsageThreshold) {
	push(@report, "Virtual memory usage: $used_pct\% (>$VirtualMemoryUsageThreshold\%)\n");
    }

    return @report;
}

sub report_physicalmemory
{
    my @report = ();

    my ($used, $free);
    if ($UName eq 'SunOS') {
	## FIXME
	warn "Unsupported plathome: $UName";
    } elsif ($UName eq 'Linux') {
	my $out = `free`;
	($used, $free) = ($out =~ m!^-/\+.*:\s+(\d+)\s+(\d+)!m);
    } else {
	die "Unsupported plathome: $UName";
    }

    my $used_pct = int($used / ($free+$used) * 100);
    if ($used_pct > $PhysicalMemoryUsageThreshold) {
	push(@report, "Physical memory usage: $used_pct\% (>$PhysicalMemoryUsageThreshold\%)\n");
    }

    return @report;
}

sub report_diskusage
{
    my @report = ();

    ## Get mounted filesystems
    my $mnttab = (-f '/etc/mnttab') ? '/etc/mnttab' : '/etc/mtab';
    my $fh_mnttab = IO::File->new($mnttab) || die "Cannot open $mnttab: $OS_ERROR";
    my @dev = ();
    while (defined(my $line = $fh_mnttab->getline)) {
	my ($dev, $point, $type, $options) = split(/\s+/, $line);
	my @options = split(/,/, $options);

	next if ($dev !~ m#^/#);	        	## Special filesystem
	next if ($point !~ m#^/#);	        	## Special filesystem
	next if (grep($_ =~ /^loop=/, @options));	## Loop device (Linux)
	next if (grep($_ eq 'ro', @options));   	## Read-only
	if ($UName eq 'SunOS') {
	    next if ($type eq 'lofs');	## Loopback filesystem
	}

	push(@dev, $dev);
    }
    $fh_mnttab->close;

    my $fh_df_k = IO::File->new('df -k|') || die "Cannot execute df -k: $OS_ERROR";
    while (defined(my $line = $fh_df_k->getline)) {
	if ($line !~ / /) {
	    $line .= $fh_df_k->getline;
	}
	my ($dev, $capacity, $used, $free, $used_pct, $point) = split(/\s+/, $line);
	next if (grep($_ eq $point, @DiskMountpointIgnore));
	next if (!grep($_ eq $dev, @dev));

	$used_pct =~ s/\%$//;
	if ($used_pct > $DiskSizeUsageThreshold) {
	    push(@report,
		"Filesystem $dev (mounted on $point) size usage: $used_pct\% (>$DiskSizeUsageThreshold\%)\n"
	    );
	}
    }
    $fh_df_k->close;

    my $df_i = ($UName eq 'SunOS') ? 'df -oi 2>/dev/null' : 'df -i';
    my $fh_df_i = IO::File->new("$df_i |") || die "Cannot execute df -i: $OS_ERROR";
    while (defined(my $line = $fh_df_i->getline)) {
	my ($dev, $capacity, $used, $free, $used_pct, $point) =
	    $line =~ m#^(/\S+)\s+(?:(\d+)\s+)?(\d+)\s+(\d+)\s+(\d+)\%\s+(/.*)$#;
	next if (!defined($dev) || !grep($_ eq $dev, @dev));

	$capacity = $used + $free if (!defined($capacity));
	if ($used_pct > $DiskInodeUsageThreshold) {
	    push(@report,
		"Filesystem $dev (mounted on $point) inode usage: $used_pct\% (>$DiskInodeUsageThreshold\%)\n"
	    );
	}
    }
    $fh_df_i->close;

    return @report;
}

sub report_port
{
    my @report = ();

    my $fh_rpcinfo = IO::File->new('rpcinfo -p 2>/dev/null |') ||
	die "Cannot execute rpcinfo -p: $OS_ERROR";
    my @rpc_service = @RPCService;
    my @rpc_tcp_port = ();
    my @rpc_udp_port = ();
    while (defined(my $line = $fh_rpcinfo->getline)) {
	$line =~ s/^\s+//;

	my ($prog, $proto, $port, $service) = (split(/\s+/, $line))[0,2,3,4];
	next if ($port !~ /^\d+$/);
	$service = $prog if (!defined($service)); ## Unknown RPC service

	if ($proto eq 'tcp') {
	    push(@rpc_tcp_port, $port);
	} elsif ($proto eq 'udp') {
	    push(@rpc_udp_port, $port);
	}

	@rpc_service = grep($_ ne $service, @rpc_service);
	if (!grep($_ eq $service, @RPCService)) {
	    push(@report, "Disapproved RPC/\U$proto\E service: $service\n");
	}
    }
    $fh_rpcinfo->close;
    for my $service (@rpc_service) {
	push(@report, "Nonexistent RPC service: $service\n");
    }

    my $netstat_an = ($UName eq 'SunOS') ? 'netstat -an' : 'netstat -anptu';
    my $fh_netstat = IO::File->new("$netstat_an 2>/dev/null |") ||
	die "Cannot execute $netstat_an: $OS_ERROR";
    my @tcp_port = ();
    my @udp_port = ();
    while (defined(my $line = $fh_netstat->getline)) {
	$line =~ s/^\s+//;

	my %port = (
	  ip_ver =>	4,
	  proto =>	'?',
	  addr =>	'?',
	  port =>	'?',
	  prog =>	'?',
	  pid =>	'?',
	);
	if ($UName eq 'SunOS') {
	    if ($line =~ /^TCP/ .. $line =~ /^$/) {
		$port{'proto'} = 'tcp';
		($port{'addr'}, my $state) = (split(/\s+/, $line))[0,6];
		next if (!defined($state) || $state ne 'LISTEN');
	    } elsif ($line =~ /^UDP/ .. $line =~ /^$/) {
		$port{'proto'} = 'udp';
		($port{'addr'}, my $state) = split(/\s+/, $line);
		next if (!defined($state) || $state ne 'Idle');
	    } else {
		next;
	    }
	} else {
	    if ($line =~ /^tcp(6?)\s/) {
		$port{'ip_ver'} = $1 if (length($1));
		$port{'proto'} = 'tcp';
		($port{'addr'}, my $state, $port{'prog'}) = (split(/\s+/, $line))[3,5,6];
		next if (!defined($state) || $state ne 'LISTEN');
	    } elsif ($line =~ /^udp(6?)\s/) {
		$port{'ip_ver'} = $1 if (length($1));
		$port{'proto'} = 'udp';
		($port{'addr'}, $port{'prog'}) = (split(/\s+/, $line))[3,5];
		next if ($port{'prog'} =~ /^ESTABLISHED/);
	    } else {
		next;
	    }

	    if ($port{'prog'} =~ s#^(\d+)/##) {
		my $pid = $1;
		next unless (is_in_samezone($pid));
		$port{'pid'} = $pid;
	    }

	    ## Normalize
	    if ($port{'ip_ver'} == 6) {
		$port{'addr'} =~ s/^:::(\d+)$/*:$1/;
		$port{'addr'} =~ s/^::ffff:([\d\.]+):(\d+)$/$1:$2/;
	    }
	    $port{'addr'} =~ s/^0\.0\.0\.0:/*:/;
	    $port{'addr'} =~ s/\.(\d+)$/:$1/;
	}

	($port{'port'}) = $port{'addr'} =~ /:(\d+)$/;
	my $addr_prog = "$port{'addr'}/$port{'prog'}";
	if ($port{'proto'} eq 'tcp') {
	    next if (grep($_ eq $port{'port'}, @rpc_tcp_port));
	    next if (grep($_ eq $port{'addr'} || $_ eq $addr_prog, @TCPPortIgnore));
	    push(@tcp_port, \%port);
	} elsif ($port{'proto'} eq 'udp') {
	    next if (grep($_ eq $port{'port'}, @rpc_udp_port));
	    next if (grep($_ eq $port{'addr'} || $_ eq $addr_prog, @UDPPortIgnore));
	    push(@udp_port, \%port);
	}
    }
    $fh_netstat->close;

    my %tcp_port = ();
    for my $port (@tcp_port) {
	if (!$TCPPort{$port->{'addr'}}) {
	    push(@report, "Disapproved listening TCP port: $port->{'addr'} $port->{'prog'} $port->{'pid'}\n");
	}
	$tcp_port{$port->{'addr'}} = true;
    }
    for my $port (@TCPPort) {
	if (!$tcp_port{$port}) {
	    push(@report, "Nonexistent listening TCP port: $port\n");
	}
    }

    for my $port (@udp_port) {
	if (!$UDPPort{$port->{'addr'}}) {
	    push(@report, "Disapproved listening UDP port: $port->{'addr'} $port->{'prog'} $port->{'pid'}\n");
	}
	$tcp_port{$port->{'addr'}} = true;
    }
    for my $port (@TCPPort) {
	if (!$tcp_port{$port}) {
	    push(@report, "Nonexistent idling UDP port: $port\n");
	}
    }

    return @report;
}

sub report_disksuite
{
    return () if ($UName ne 'SunOS');

    my @report = ();

    my $entry;
    for my $md_cf ('/etc/lvm/md.cf', '/etc/opt/SUNWmd/md.cf') {
	next unless (-f $md_cf);

	my $fh_md_cf = IO::File->new($md_cf) || die "Cannot open $md_cf: $OS_ERROR";
	while (defined(my $line = $fh_md_cf->getline)) {
	    if ($line !~ /^\s*#/ && $line !~ /^\s*$/) {
		$entry = 1;
		last;
	    }
	}
	$fh_md_cf->close;
    }
    return () unless $entry;

    ## Check metadevice status
    my $metastat;
    my $metadb;
    if (-x '/usr/sbin/metastat') {
	## Newer DiskSuite and Volume Manager
	$metastat = '/usr/sbin/metastat';
	$metadb = '/usr/sbin/metadb';
    } elsif ( -x '/usr/opt/SUNWmd/sbin/metastat') {
	## Old DiskSuite
	$metastat = '/usr/opt/SUNWmd/sbin/metastat';
	$metadb = '/usr/opt/SUNWmd/sbin/metadb';
    } else {
	return ();
    }
    my $fh_metastat = IO::File->new("$metastat |") ||
	die "Cannot execute $metastat: $OS_ERROR";
    ## On Perl 5.6.1 and earlier, input_record_separator is ***NOT***
    ## supported on a per-handle basis. :-(
    my $irs = IO::File->input_record_separator("\n\n");
    while (defined(my $line = $fh_metastat->getline)) {
	next if ($line =~ /^\s+$/);

	$line =~ s/^\s+//mg;
	$line =~ s/\s+$//mg;
	for my $status ($line =~ /^State:\s+(.*)$/mg) {
	    if ($status ne 'Okay') {
		my ($md, $desc) = $line =~ /^(\w+):\s(.*)\n/;
		push(@report, "Metadevice $md: $desc status: $status\n");
	    }
	}
    }
    IO::File->input_record_separator($irs);
    $fh_metastat->close;

    ## Check metadevice state database
    my $fh_metadb = IO::File->new("$metadb -i|") ||
	die "Cannot execute $metadb -i: $OS_ERROR";
    my %flags = ();
    my %description = ();
    while (defined(my $line = $fh_metadb->getline)) {
        next if ($line =~ /\s+flags/);

	if ($line =~ /^ (\w) - (.*)$/) {
	    $description{$1} = $2;
	    next;
	}

	my ($flags) = $line =~ /^(.{18})/;
        my ($dev) = $line =~ /(\S+)$/;
	$flags =~ tr/a-z //d; ## Remove non-failure flags and white spaces
	$flags{$dev} = [ split(//, $flags) ];
    }
    for my $dev (keys %flags) {
	for my $flag (@{$flags{$dev}}) {
	    push(@report, "Metadb $dev: $description{$flag} (flag $flag)\n");
	}
    }

    return @report;
}

sub report_interface
{
    my @report = ();

    my $netstat = ($UName eq 'Linux') ? 'ifconfig -a' : 'netstat -in';
    my $fh_netstat = IO::File->new("$netstat |") ||
	die "Cannot execute $netstat: $OS_ERROR";
    my $irs = IO::File->input_record_separator("\n\n") if ($UName eq 'Linux');
    while (defined(my $line = $fh_netstat->getline)) {
	next if ($line !~ /^[a-z]/);

	my ($if, $addr, $rx_ok, $rx_err, $tx_ok, $tx_err);
	if ($UName eq 'Linux') {
	    ($if, $addr) = $line =~ /^(\S+)\s.*\sinet addr:(\S+)\s/s;
	    next if (!defined($if));
	    next if ($if =~ /:/);	## Virtual interface (aka IP alias)

	    my @rx = $line =~ /RX \w+:(\d+) \w+:(\d+) \w+:(\d+) \w+:(\d+)/;
	    $rx_ok = shift(@rx);
	    $rx_err = $rx[0] + $rx[1] + $rx[2];
	    my @tx = $line =~ /TX \w+:(\d+) \w+:(\d+) \w+:(\d+) \w+:(\d+)/;
	    $tx_ok = shift(@tx);
	    $tx_err = $tx[0] + $tx[1] + $tx[2];
	} else {
	    my @col = split(/\s+/, $line);
	    ($if, $addr, $rx_ok, $rx_err, $tx_ok, $tx_err) = @col[0,3..7];
	    next if ($rx_ok !~ /^\d+$/ || $tx_ok !~ /^\d+$/);
	}

	if ($rx_ok + $rx_err > 0) {
	    my $rx_err_pct = int($rx_err / ($rx_ok + $rx_err) * 100);
	    if ($rx_err_pct > $InterfaceReceiveErrorThreshold) {
		push(@report, "Interface $if ($addr) receive error: $rx_err_pct\% (>$InterfaceReceiveErrorThreshold\%)\n");
	    }
	}
	if ($tx_ok + $tx_err > 0) {
	    my $tx_err_pct = int($tx_err / ($tx_ok + $tx_err) * 100);
	    if ($tx_err_pct > $InterfaceSendErrorThreshold) {
		push(@report, "Interface $if ($addr) send error: $tx_err_pct\% (>$InterfaceSendErrorThreshold\%)\n");
	    }
	}
    }
    IO::File->input_record_separator($irs) if (defined($irs));
    $fh_netstat->close;

    return @report;
}

sub report_lom
{
    return () if ($UName ne 'SunOS' || !-c '/dev/lom' || !-x '/usr/sbin/lom');

    my @report = ();

    ## FIXME: Need check if fault LED is 'on' ? (lom -lL)

    my $fh_lom = IO::File->new("lom -pfvt |") || die "Cannot execute lom -pfvt: $OS_ERROR";
    my $target;
    while (defined(my $line = $fh_lom->getline)) {
	if ($line =~ /^([^:]+):$/) {
	    $target = $1;
	    next;
	}
	next if (!defined($target));
	next if ($target eq 'System Temperature Sensors');

	if ($line =~ /^\s(\d+)\s+(.*)\s(status=.*)$/) {
	    my ($num, $what, $status) = ($1, $2, $3);
	    if ($status ne 'status=ok') {
		$target =~ s/s$//;
		push(@report, "LOM: $target $num ($what) failure: $status\n");
	    }
	} elsif ($line =~ /^(\d+)\s(.*)$/) {
	    my ($num, $status) = ($1, $2);
	    if ($status !~ /^OK(\s|$)/) {
		$target =~ s/s$//;
		push(@report, "LOM: $target $num failure: $status\n");
	    }
	}
    }
    $fh_lom->close;

    return @report;
}

my @report = ();
push(@report, report_load());
push(@report, report_virtualmemory());
push(@report, report_physicalmemory());
push(@report, report_diskusage());
push(@report, report_disksuite());
push(@report, report_interface());
push(@report, report_port());
push(@report, report_lom());
print @report;

exit(@report ? 1 : 0);

