#!/usr/bin/perl -w
##
# Report on the data rate used by the powerline devices, and the SNR.
# The tool is able to report on multiple powerline networks connected to
# the same ethernet network interface, and/or multiple networks on different
# interfaces.
#
# For each connected network, there will be a local device, and a number
# of remote devices. Each local device can report the speed between it
# and the remote devices.
# Networks may be located on different interfaces.
# If the interfaces change, the networks will be treated differently -
# this may seem less useful, but allows you to access the same logical
# network through two different interfaces (as the OpenPLC documentation
# suggests for testing purposes).
# Under non-test circumstances, it is highly unlikely that you would move
# the devices from one interface to another. Or if you did, you would know
# enough to not worry about the implications with a mere munin plugin.
#
# Copy this into /usr/share/munin/plugins/
# and then run 'munin-node-configure --suggest --shell' to get the command
# to install it.
#
# The plugin supports autoconfiguration within Munin, and will suggest
# the interfaces and networks on which it runs.
#
# You may need to ensure that 'ampstat' and 'amptone' are in your path by
# updating the /etc/munin/plugin-conf.d/munin-node file (or similar) to
# contain a PATH variable which contains some a reference to the location
# of the tool.
#
# You can also include an optional label for each of the devices, using
# their MAC address (in upper case without the colons). The network can be
# labelled in the same way.
#
#   [plc*]
#   env.PATH /usr/bin:/usr/local/bin/
#   env.DEVICE_F81A671234AB Upstairs
#   env.NETWORK_8FDFA543989506 Powerline

# Version 1.00 (11/08/2013)
#   Automatically locates the ethernet devices with powerline present
#   and suggests the correct settings.
# Version 1.01 (12/08/2013)
#   Added support for labelling the devices nicely.
# Version 1.02 (12/08/2013)
#   Added support for reporting the signal-to-noise ratio as well as the
#   data rate.
# Version 1.03 (20/08/2013)
#   Restructured significantly; the way that the network topology was
#   determined was based on incorrect assumptions (such as that the
#   controller was the device that reported its state first). The code
#   has been reworked so that it understands how devices are reported
#   and can properly support multiple networks.
# Version 1.04 (30/01/2014)
#   Tentative support for swiching the tool to use based on the type of
#   devices present on the network. If you have older 6x00 devices on
#   the network, they would not respond to the 'ampstat' tool's requests.
#   If we queried new devices using 'int6kstat' we would saturate the
#   speed at 255Mbps. So we need to use the correct tools - and if the
#   network has a mixture of local devices with different versions, we
#   must query with both int6k and amp tools. This complicates things
#   slightly, but we now compensate for this by detecting what is connected.
#   We could have just indicated the tool types in the configuration, but
#   where's the fun in that? (plus it would mean that 'suggest' would need
#   hints in order to work).
#   Thanks to Alex Macfarlane-Smith for testing this.
#
#%# family=auto
#%# capabilities=autoconf suggest
#

use strict;

use Data::Dumper;
use File::Which;
use Net::Interface qw/:constants/;

my $arg = shift || 'fetch';
my $interface = "eth0";
my $tool = 'snr';
my $network = '';

my $debug = 1;

# We have symlinks such as:
#    plc_rate_eth0_ABCDEF12345678
if ($0 =~ /plc_([a-z]+)_([a-z][a-z0-9]*)_([A-Fa-f0-9]+)$/)
{
    $tool = $1;
    $interface = $2;
    $network = $3;
}

##
# Define the types of chipsets we know about, and the tools we need to use
# for each.
# If we don't know anything, the '*' value will be used.
my %commandset = (
        'AR7400'  => 'amp',
        'INT6400' => 'int6k',
        '*'       => 'int6k',
    );
##
# The tools used for each commandset, keyed by the commandset name, with
# values:
#   'stat'  => 'int6kstat' or 'ampstat'
#   'tone'  => 'int6ktone' or 'amptone'
#   'order' => the order in which this query should be performed
my %tools = (
        'int6k'   => {
                        'stat'  => 'int6kstat',
                        'tone'  => 'int6ktone',
                        'order' => 1,
                     },
        'amp'     => {
                        'stat'  => 'ampstat',
                        'tone'  => 'amptone',
                        'order' => 2,
                     }
    );


# A regular expression for matching MAC addresses
my $macre = "[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}";

if ($arg eq 'fetch')
{
    my $details = getnetworktopology($interface);

    #print STDOUT "details: ", Dumper($details);
    if ($network eq '' && scalar(keys %$details) > 0)
    {
        # If no network was supplied, we default to the first
        # one, numerically.
        $network = (sort keys %$details)[0];
    }
    my $net = $details->{$network};
    
    if (!defined $net)
    {
        print STDERR "No networks detected. Nothing to do.\n";
        print STDERR "  network : $network\n";
        print STDERR "  networks: ", join(", ", keys %$details), "\n";
        exit;
    }
    if (@{ $net->{'devices'} } == 0)
    {
        print STDERR "No devices detected (but there was a network?).\n";
        exit;
    }

    if ($tool eq 'snr')
    {
        my @devices = @{ $net->{'devices'} };
        # The local device is the first one listed.
        my $from = shift @devices;
        
        # List the devices, in a fixed order
        for my $device (sort { $a->{'name'} cmp $b->{'name'} } @devices)
        {
            my $tonemap = getnetworktonemap($interface,
                                            $from->{'mac'},   # from local
                                            $device->{'mac'}, # to a remote
                                            $from->{'commandset'}
                                           );

            my $value = $tonemap->{'avgSNR'} // 'U';
            print "$device->{'name'}_snr.value $value\n";
        }
    }
    else
    {
        my @devices = @{ $net->{'devices'} };
        # The local device is the first one listed.
        my $from = shift @devices;

        # List the devices, in a fixed order
        for my $device (sort { $a->{'name'} cmp $b->{'name'} } @devices)
        {
            my $txbps = $device->{'txbps'} // 'U';
            my $rxbps = $device->{'rxbps'} // 'U';
            print "$device->{'name'}_tx.value $txbps\n";
            print "$device->{'name'}_rx.value $rxbps\n";
        }
    }
}
elsif ($arg eq 'config')
{
    my $details = getnetworktopology($interface);

    #print STDOUT "details: ", Dumper($details);
    if ($network eq '' && scalar(keys %$details) > 0)
    {
        # If no network was supplied, we default to the first
        # one, numerically.
        $network = (sort keys %$details)[0];
    }
    my $net = $details->{$network};
    
    if (!defined $net)
    {
        print STDERR "No networks detected. Nothing to do.\n";
        exit;
    }

    my $netlabel = defined $net->{'label'} ? ": $net->{'label'}" : '';
    if ($tool eq 'snr')
    {
        print "graph_title Powerline signal-to-noise ($interface$netlabel)\n";
        print "graph_vlabel signal-to-noise (dB)\n";
        print "graph_category network\n";
    }
    else
    {
        print "graph_title Powerline network speed ($interface$netlabel)\n";
        print "graph_vlabel bits per second\n";
        print "graph_category network\n";
        print "graph_args --base 1000\n";
    }
    if (@{ $net->{'devices'} } == 0)
    {
        print STDERR "No devices detected (but there was a network?).\n";
        exit;
    }

    my @devices = @{ $net->{'devices'} };
    # The local device is the first one listed.
    my $from = shift @devices;

    # List the devices, in a fixed order
    for my $device (sort { $a->{'name'} cmp $b->{'name'} } @devices)
    {
        my $label = $device->{'mac'};
        my $more = "";
        if (defined $device->{'label'})
        {
            $more = " ($device->{'label'})";
            $label = $device->{'label'};
        }
        if ($tool eq 'snr')
        {
            print "$device->{'name'}_snr.info Signal-to-noise to $device->{'mac'}$more\n";
            print "$device->{'name'}_snr.label SNR $label\n";
        }
        else
        {
            print "$device->{'name'}_tx.info Transmit rate to $device->{'mac'}$more\n";
            print "$device->{'name'}_rx.info Receive rate to $device->{'mac'}$more\n";
            print "$device->{'name'}_tx.label TX $label\n";
            print "$device->{'name'}_rx.label RX $label\n";
        }
    }
}
elsif ($arg eq 'autoconf')
{
    # Automatic configuration, so work out if we can run or not.
    if (!defined File::Which::which('int6kstat'))
    {
        print "no (cannot find the 'int6kstat' tool)\n";
        exit;
    }
    if (!defined File::Which::which('ampstat'))
    {
        print "no (cannot find the 'ampstat' tool)\n";
        exit;
    }
    if ($tool eq 'snr' && !defined File::Which::which('amptone'))
    {
        print "no (cannot find the 'amptone' tool)\n";
        exit;
    }
    
    # We've got the tool. 
    my ($plc_ifs, $usable_ifs) = plc_interfaces();

    #print Dumper(\@plc_ifs);
    if (@$plc_ifs)
    {
        print "yes\n";
    }
    else
    {
        print "no (no usable interfaces, out of ", join(", ", map { $_->{'name'} } @$usable_ifs), ")\n";
    }
}
elsif ($arg eq 'suggest')
{
    my ($plc_ifs, $usable_ifs) = plc_interfaces();
    my @tools = ( 'rate', 'snr' );
    for my $if (@$plc_ifs)
    {
        my $nets = getnetworktopology($if);
        for my $net (sort keys %$nets)
        {
            for my $tool (@tools)
            {
                print "${tool}_${if}_$net\n";
            }
        }
    }
}


##
# Read the interfaces that we can use interfaces.
#
# Each interface is a Net::Interface object; use $_->{'name'} for the
# interface name.
#
# @return list of interfaces controlled by powerline devices
#         list of interfaces that could be controlled by powerline
sub plc_interfaces
{
    # Let's work out the interfaces.
    my @all_ifs = Net::Interface->interfaces();
    # Select only the interfaces that are up and are not loopback.
    my @usable_ifs = grep {
                        defined $_->flags() &&
                           ($_->flags() & (IFF_UP | IFF_LOOPBACK)) == IFF_UP
                     } @all_ifs;

    # Let's see if we have any PLC devices, by querying the int6kstat,
    # which is the lowest protocol, supported by all the Atheros devices.
    my @plc_ifs = grep {
                      (`int6kstat -i $_->{'name'} -m 2> /dev/null` ne '')
                  } @usable_ifs;

    return (\@plc_ifs, \@usable_ifs);
}


##
# Read details about the network topology.
#
# @param[in] $interface   Interface name
#
# @return hashref containing all the networks that we know about, keyed by
#         the network name. Each network is a hashref description containing:
#           'nid'   => network identifier
#           'name'  => network name identifier without colons, in upper case
#           'label' => network label (readable identifier)
#           'snid'  => short network identifier
#           'devices' => an arrayref containing all the devices that were
#                        found. The local device is the first one in the
#                        list; each subsequent device is remote, and will
#                        include details for the speed between it and the
#                        local device. The hashref is:
#                           'type'  => 'STA' or 'CCO' for station or
#                                      controller systems.
#                           'tei'   => device id
#                           'mac'   => MAC address
#                           'name'  => device MAC without colons
#                           'label' => label for device, or device MAC
#                                      without colons
#                           'bda'   => device BDA
#                           'txbps' => transmit speed in BPS (or undef if
#                                      not known)
#                           'rxbps' => receive speed in BPS (or undef if
#                                      not known)
#                           'chipset' => chipset of the device
#                           'firmware' => version of the firmware
#                           'commandset' => the commandset to use to communicate
sub getnetworktopology
{
    my ($interface) = @_;
    my $cmd = "int6kstat -i $interface -t";
    ##
    # The int6kstat tool is used because it utilises an earlier protocol
    # which is understood by both new and old chips. We use this to determine
    # the version of the commands to issue to get information.
    #
    # We get output like:
    #  P/L NET TEI ------ MAC ------ ------ BDA ------  TX  RX CHIPSET FIRMWARE
    #  LOC CCO 001 F8:1A:67:67:99:84 00:19:D1:FE:6B:21 n/a n/a  AR7400 INT7400-MAC-5-2-5233-02-968-20120209-FINAL-B
    #  REM STA 002 F8:1A:67:67:87:68 00:04:20:8F:B4:77 255 255  AR7400 INT7400-MAC-5-2-5233-02-968-20120209-FINAL-B
    #
    # We use this output to work out which types of devices we need to
    # query - we might need to use both int6kstat and ampstat to get useful
    # details (the int6kstat response will saturate at 255 MBps if used to
    # query the faster devices - need to use ampstat for them).
    # We key %devtype by the MAC address.
    #

    print STDERR "Issuing stat(find-devices): $cmd\n" if ($debug);
    my $output = `$cmd`;
    my %devtype;
    my %setused = ();
    for my $line (split /\n/, $output)
    {
        my ($none, $pl, $net, $tei, $mac, $bda, $tx, $rx, $chipset, $firmware) = split / +/, $line;
        if (defined $pl)
        {
            next if ($pl eq 'P/L');
            my $cs = $commandset{$chipset} // $commandset{'*'};
            $devtype{$mac} = {
                'chipset'    => $chipset,
                'firmware'   => $firmware,
                'commandset' => $cs,
            };
            $setused{ $cs } = 1;
        }
    }

    # Details of the devices and the number of them.
    my $details = {};
    my $ndevices = 0;

    # We go through all the tools, trying to get information.
    for my $cs (sort { $tools{$a}->{'order'} <=> $tools{$b}->{'order'} } keys %setused)
    {
        $cmd = "$tools{$cs}->{'stat'} -i $interface -m";

        ##
        # The ampstat/int6k command outputs something like:
        #
        # NID 8F:DF:34:E5:FF:BE:87 SNID 012
        # CCO TEI 001 MAC F8:1A:67:99:13:24 BDA 00:19:D1:98:6B:3E
        # STA TEI 002 MAC F8:1A:67:87:68:84 BDA 00:04:24:07:A4:28 TX 362 RX 348
        #
        # The output is produced by contacting the servers on the local network.
        # Each device will report the network identification followed by the
        # device's state, and the state of the devices which it is connected to.
        # For each device which is connected, the speed between it and the local
        # device is reported.

        print STDERR "Issuing stat($cs): $cmd\n" if ($debug);
        $output = `$cmd`;

        my @lines = split /\n/, $output;
        my $lastnetwork = undef;
        my $laststation = undef;
        for my $line (@lines)
        {
            # Station?
            my ($type, $tei, $stationmac, $stationbda) = ($line =~ /(CCO|STA) TEI (\d+) MAC ($macre) BDA ($macre)/ig);
            if (defined $tei)
            {
                # Reduce the station to just the name
                my $station = uc($stationmac);
                $station =~ s/://g;
                if (defined $lastnetwork)
                {
                    # If we have already seen this station in this network
                    # (as might happen if we run both int6kstat and ampstat,
                    # for a network which has both old and new chipsets on
                    # the local network), we should remove the earlier
                    # device. The ordering ensures that we keep the more
                    # accurate answer.
                    @{ $lastnetwork->{'devices'} } = grep {
                                                        $_->{'mac'} ne $stationmac
                                                     } @{ $lastnetwork->{'devices'} };

                    $laststation = {
                        'type' => $type,
                        'tei' => $tei,
                        'mac' => $stationmac,
                        'name' => $station,
                        'label' => undef,
                        'bda' => $stationbda,
                        'txbps' => undef,
                        'rxbps' => undef,
                        'chipset' => $devtype{$stationmac}->{'chipset'},
                        'firmware' => $devtype{$stationmac}->{'firmware'},
                        'commandset' => $devtype{$stationmac}->{'commandset'},
                    };
                    if (defined $ENV{'DEVICE_' . $station})
                    {
                        $laststation->{'label'} = $ENV{'DEVICE_' . $station};
                    }
                    push @{ $lastnetwork->{'devices'} }, $laststation;

                    # Keep track of how many devices we've seen
                    $ndevices++;
                }
                else
                {
                    print STDERR "Saw station before the network\n";
                }
            }

            my ($tx, $rx) = ($line =~ /TX (\d+) RX (\d+)/);
            if (defined $tx)
            {
                if (defined $laststation)
                {
                    $laststation->{'txbps'} = $tx * 1000 * 1000, # Convert mbps => bps
                    $laststation->{'rxbps'} = $rx * 1000 * 1000, # Convert mbps => bps
                }
                else
                {
                    print STDERR "Saw speeds before the stations\n";
                }
            }

            # Network details
            my ($nid, $snid) = ($line =~ /NID ([A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}:[A-Fa-f0-9]{2}) SNID (\d+)/);
            if (defined $nid)
            {
                my $name = uc($nid);
                $name =~ s/://g;
                $lastnetwork = {
                        'nid'  => $nid,
                        'name' => $name,
                        'label' => undef,
                        'snid' => $snid,
                        'devices' => [],
                    };
                if (defined $ENV{'NETWORK_' . $name})
                {
                    $lastnetwork->{'label'} = $ENV{'NETWORK_' . $name};
                }
                $details->{$name} = $lastnetwork;
            }
        }
    }
    if ($ndevices == 0 && $debug)
    {
        print STDERR "No stations found. Output was:\n";
        print STDERR map { "  $_\n" } split /\n/, $output;
        print STDERR "Decoded:\n";
        print STDERR map { "  $_\n" } split /\n/, Dumper($details);
    }

    return $details;    
}







##
# Read details about the network tone distribution and SnR.
#
# @param[in] $interface   Interface name
# @param[in] $from        Interface to read tone details (source)
# @param[in] $to          Interface to read tone details (destination)
# @param[in] $commmandset Command set (from keys of %tools)
#
# @return hashref containing:
#           'tone'      => hashref keyed by the tone number, with values
#                          a arrayref containing the 6 time slot modulations
#                          (not present in all tools)
#           'avgtone'   => hashref keyed by the tone number, with the value
#                          the mean square modulation. (not present in all
#                          tools)
#           'SNR'       => arrayref containing 6 time slot Signal-to-Noise
#                          ratios.
#           'avgSNR'    => average SNR.
#           'ATN'       => arrayref containing 6 time slot attenuation.
#           'avgATN'    => average attenuation
#           'BPC'       => arrayref containing 6 time slot 'BPC' values
#           'avgBPC'    => average BPC value
#           'AGC'       => arrayref containing 6 time slot 'AGC' values
#           'GIL'       => arrayref containing 6 time slot 'GIL' values
sub getnetworktonemap
{
    my ($interface, $from, $to, $commandset) = @_;
    $commandset //= 'int6k'; # Fall back to int6k tool
    my $cmd = "$tools{$commandset}->{'tone'} -i $interface $from $to -sh";
    
    # The tone output looks like this:
    #
    # ...
    # 2687,01,02,02,02,02,01 018 ###
    # 2688,01,02,02,02,02,01 018 ###
    # 2689,01,02,02,02,02,02 021 ###
    #  SNR,   7.683,  11.479,  12.171,  12.314,  11.433,   9.541,  10.770
    #  ATN, -52.317, -48.521, -47.829, -47.686, -48.567, -50.459, -49.230
    #  BPC,   2.931,   4.207,   4.438,   4.485,   4.191,   3.559,   3.969
    #  AGC,12,12,12,12,12,12
    #  GIL,00,00,00,00,00,00
    #
    # The number of fields appears to change with the traffic - it is often
    # 6 values, but I have seen it reduce to just one value, for example:
    #
    # ...
    # 2687,02 004 ####
    # 2688,02 004 ####
    # 2689,02 004 ####
    #  SNR,  12.480,  12.480
    #  ATN, -47.520, -47.520
    #  BPC,   4.542,   4.542
    #  AGC,14
    #  GIL,00
    #
    # On int6ktone, the format is different; there are no commas and you don't
    # get the tone map:
    #
    #  SNR   12.158   11.721   11.954    9.317   11.319   12.064   11.422
    #  ATN  -47.842  -48.279  -48.046  -50.683  -48.681  -47.936  -48.578
    #  BPC    4.212    4.091    4.149    3.370    3.978    4.186    3.998
    #  AGC 119 119 119 102 119 119
    #  GIL 119 119 119 102 119 119
    #
    

    print STDERR "Tone details: $cmd\n" if ($debug);
    my $output = `$cmd`;
    my $details = {
        'tone'    => {},
        'avgtone' => {},
        'SNR'      => [],
        'avgSNR'   => undef,
        'ATN'      => [],
        'avgATN'   => undef,
        'BPC'      => [],
        'avgBPC'   => undef,
        'AGC'      => [],
        'GIL'      => [],
    };

    my @lines = split /\n/, $output;
    for my $line (@lines)
    {
        my ($tone, $slots, $meansquare) =
            ($line =~ /^(\d+),(\d+,)* (\d+)/);
        if (defined $tone)
        {
            $details->{'tone'}->{$tone} = [ split /,/, $slots ];
            $details->{'avgtone'}->{$tone} = $meansquare;
        }
        
        my ($field, $average);
        ($field, $slots, $average) =
            ($line =~ /^ *(SNR|ATN|BPC),? *([0-9\.\- ,]+)[, ]+([0-9\.\-]+)/);
        
        if (defined $field)
        {
            $details->{$field} = [ map { 0+$_ } split /[, ]+/, $slots ];
            $details->{'avg'.$field} = $average;
        }
        else
        {
            ($field, $slots, $average) =
                ($line =~ /^ *([A-Z]{2,})[, ]+([0-9\.\- ,]+)/);
        
            if (defined $field)
            {
                $details->{$field} = [ map { 0+$_ } split /[, ]+/, $slots ];
            }
        }
    }
    #print Dumper($details);
    
    return $details;
}