#!/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.
#
#%# 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;
}




# 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
                                           );

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

    if ($tool eq 'snr')
    {
        print "graph_title Powerline signal-to-noise ($interface: $net->{'label'})\n";
        print "graph_vlabel signal-to-noise (dB)\n";
        print "graph_category network\n";
    }
    else
    {
        print "graph_title Powerline network speed ($interface: $net->{'label'})\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 ($tool eq 'rate' && !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.
    my @plc_ifs = grep {
                      (`ampstat -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)
sub getnetworktopology
{
    my ($interface) = @_;
    my $cmd = "ampstat -i $interface -m";

    ##
    # The ampstat 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: $cmd\n" if ($debug);
    my $output = `$cmd`;
    my $details = {};

    my @lines = split /\n/, $output;
    my $lastnetwork = undef;
    my $laststation = undef;
    my $ndevices = 0;
    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)
            {
                $laststation = {
                    'type' => $type,
                    'tei' => $tei,
                    'mac' => $stationmac,
                    'name' => $station,
                    'label' => undef,
                    'bda' => $stationbda,
                    'txbps' => undef,
                    'rxbps' => undef,
                };
                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)
#
# @return hashref containing:
#           'tone'      => hashref keyed by the tone number, with values
#                          a arrayref containing the 6 time slot modulations
#           'avgtone'   => hashref keyed by the tone number, with the value
#                          the mean square modulation.
#           '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) = @_;
    my $cmd = "amptone -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
    

    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 ];
            }
        }
    }
    
    return $details;
}