#!/usr/bin/perl

# A Hobbit client-side module to check the local network interface
# states (e.g. "needs to be up", "needs to be in promiscuous mode",
# etc.).
#
# Copyright (C) 2018 Axel Beckert <abe@debian.org>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
use warnings;
use 5.010;
use Hobbit;
use YAML::Tiny;
use Sys::Hostname;
use File::Which;
use IPC::Run qw(run);
use Carp;

my @config_file_locations = qw(
    /etc/xymon/net.yaml
    /etc/xymon-client/net.yaml
    );

# Only do something if a config file is present
my $config_file;
foreach my $location (@config_file_locations) {
    if (-e $location) {
        $config_file = $location;
        last;
    }
}
exit 0 unless -e $config_file;

my $bb = new Hobbit('net');
#my $trends = Hobbit::trends;
my $hostname = hostname;
my $config;

# Look for my hostname in the configuration file and exit if it's not
# in there.
my $config_yaml = YAML::Tiny->read($config_file);
$config = $config_yaml->[0]{$hostname} if ( exists($config_yaml->[0]) and
                                    exists($config_yaml->[0]{$hostname}) and
                                    defined($config_yaml->[0]{$hostname}) );
exit 0 unless $config;

my %if_cache;
my %special_case = (
    'Full' => 'Duplex: Full',
    'Half' => 'Duplex: Half',
    'TP' => 'Port: Twisted Pair',
    'Twisted Pair' => 'Port: Twisted Pair',
    'FIBRE' => 'Port: FIBRE',
    );

# Check if at least one of the two binaries is present
my $ip_bin       = which 'ip';
my $ifconfig_bin = which 'ifconfig';
my $ethtool_bin  = which 'ethtool';
if ($ip_bin or $ifconfig_bin) {
    my @interfaces = ();
    if (ref($config) eq 'ARRAY') {
        @interfaces = @$config;
        foreach my $interface (@interfaces) {
            check_if_state($interface, 'UP');
        }
    } elsif (ref($config) eq 'HASH') {
        @interfaces = sort keys %$config;
        foreach my $interface (@interfaces) {
            #if_exists($interface);
            if (ref($config->{$interface}) eq 'ARRAY') {
                my @states = @{$config->{$interface}};
                foreach my $state (@states) {
                    my $color = 'yellow';
                    if (ref($state) eq 'HASH') {
                        # TODO: Support more than one key value pair per line
                        my $old_state = $state;
                        $state = (keys   %$old_state)[0];
                        $color = (values %$old_state)[0];
                        #use Data::Dumper;
                        #die Dumper [$old_state, $state, $color];
                    }
                    check_if_state($interface, $state, $color);
                }
            } elsif (ref($config->{$interface}) eq 'HASH') {
                my $if_state = $config->{$interface};
                my @states = sort keys %$if_state;
                foreach my $state (@states) {
                    check_if_state($interface, $state, $if_state->{$state});
                }
            } else {
                $bb->color_line(
                    'yellow',
                    "$hostname -> $interface is not a YAML list or hash, skipping.\n"
                    );
            }
        }
    }
} else {
# Neither ifconfig nor ip is found?!? Strange installation, that.
    $bb->color_line(
        'red',
        "$config_file exists, but neither ip nor ifconfig can be found in $ENV{PATH}.\n"
        );
}

#$trends->send;
$bb->send;

###
### Functions
###

sub check_if_state {
    my ($interface, $state, $color) = @_;
    my ($stdin, $stdout, $stderr, @cmd, $exitcode);

    # Special casing
    if (exists $special_case{$state}) {
        $state = $special_case{$state};
    } elsif ($state eq 'DOWN' and not $ip_bin) {
        $state = 'not UP';
    }

    # Generic special cases (sic!)
    $state =~ s{ (\d+) baseT $ }{Speed: ${1}Mb/s}x;
    $state =~ s{ ^ \d+ Mb/s $ }{Speed: $&}x;


    # Some checks need ethtool
    if ($state =~ /Duplex:|Speed:|Auto-negotiation:|Port:|Link detected:/) {
        if (exists $if_cache{"ethtool+$interface"}) {
            ($stdout, $stderr) = @{$if_cache{"ethtool+$interface"}};
            return 0 if (defined($stderr) and
                         $stderr =~ /No such device/);
        } else {
            if ($ethtool_bin) {
                @cmd = ('ethtool', $interface);
            } else {
                $bb->color_line(
                    'yellow',
                    "State '$state' (on '$interface') can only be queried ".
                    "with ethtool, but ethtool seems not available.\n");
            }
            run(\@cmd, \$stdin, \$stdout, \$stderr);
            $exitcode = $? >> 8;

            $if_cache{"ethtool+$interface"} = [ $stdout, $stderr ];
        }


    } else {
    # States being able to read with ip or ifconfig
        if (exists $if_cache{$interface}) {
            ($stdout, $stderr) = @{$if_cache{$interface}};
            return 0 if (defined($stderr) and
                         $stderr =~ /Cannot find device|Device not found/);
        } else {
            if ($ip_bin) {
                # Safeguard because we have to use "sh -c ..."
                croak "Bad interface name '$interface'"
                    if $interface !~ /^[-_a-zA-Z0-9]*$/;
                @cmd = ('sh', '-c',
                        "ip link show dev $interface && ip address show dev $interface");
            } elsif ($ifconfig_bin) {
                @cmd = ('ifconfig', $interface);
            } else {
                croak 'Assertion failed: ip or ifconfig present';
            }
            run(\@cmd, \$stdin, \$stdout, \$stderr);
            $exitcode = $? >> 8;

            $if_cache{$interface} = [ $stdout, $stderr ];
        }
    }

    if (defined($stderr) and $stderr ne '') {
        if ($stderr =~ /Cannot find device|Device not found|No such device/) {
            $bb->color_line(
                'yellow',
                "Interface '$interface' configured, but not found. Skipping.\n");
            return 0;
        }

        # Skip warnings about wake-on-lan settings for now. File a bug
        # report if you need them. Will likely require sudo to get them.
        unless ($stderr =~ /Cannot get wake-on-lan settings: Operation not permitted/) {
            $bb->color_line(
                'yellow',
                "Calling '".join(' ', @cmd)."' caused a warning: $stderr");
        }
    }

    if ($exitcode) {
        $bb->color_line(
            'yellow',
            "Querying $interface exited with $exitcode.\n");
    }

    if (defined($stdout) and $stdout ne '') {
        if ($state =~ /^not\s(.*)$/) {
            $state = $1;
            if ($stdout =~ /\b\Q$state\E\b/) {
                $bb->color_line($color || 'yellow',
                                "$interface is $state (but shouldn't)\n");
            } else {
                $bb->color_line('green',
                                "$interface isn't $state\n");
            }
        } else {
            if ($stdout !~ /\b\Q$state\E\b/) {
                $bb->color_line($color || 'yellow',
                                "$interface isn't $state (but should)\n");
            } else {
                $bb->color_line('green',
                                "$interface is $state\n");
            }
        }
    } else {
        $bb->color_line(
            'yellow',
            "Can't check $state on $interface: Querying $interface resulted in no output.\n");
    }
}
