#!/usr/bin/perl -w
##
# Report on the data rate used by the powerline devices, and the SNR.
# Every device (except the local one) can report the data rate for the
# devices.
#
# Copy this into /usr/share/munin/plugins/
# and then run 'munin-node-configure --suggest --shell' to get the command
# to install it.
#
# The plugin will work as autoconfiguration within Munin, and will suggest
# the interfaces 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).
#
#   [plc*]
#   env.PATH /usr/bin:/usr/local/bin/
#   env.LABEL_F81A671234AB Upstairs
#
# 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.
#
#%# 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 = 'rate';

if ($0 =~ /plc_([a-z]+)_/)
{
    $tool = $1;
}
if ($0 =~ /_([^_]+?)$/)
{
    $interface = $1;
}




# 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 = getnetworkrate($interface);
    
    #print STDOUT "details: ", Dumper($details);
    if (!defined $details->{'nid'})
    {
        print STDERR "No networks detected. Nothing to do.\n";
        exit;
    }
    if (@{ $details->{'stations'} } == 0)
    {
        print STDERR "No stations detected.\n";
        exit;
    }

    if ($tool eq 'snr')
    {
        my $from = $details->{'controller'}->{'mac'};
        my $to = $details->{'stations'}->[0]->{'mac'};
        
        # List the stations, in a fixed order
        for my $station (sort { $a->{'name'} cmp $b->{'name'} } @{ $details->{'stations'} })
        {
            my $tonemap = getnetworktonemap($interface, $from, $to);
            
            print "$station->{'name'}_snr.value $tonemap->{'avgSNR'}\n";
        }
    }
    else
    {
        # List the stations, in a fixed order
        for my $station (sort { $a->{'name'} cmp $b->{'name'} } @{ $details->{'stations'} })
        {
            print "$station->{'name'}_tx.value $station->{'txbps'}\n";
            print "$station->{'name'}_rx.value $station->{'rxbps'}\n";
        }
    }
}
elsif ($arg eq 'config')
{
    if ($tool eq 'snr')
    {
        print "graph_title Powerline signal-to-noise ($interface)\n";
        print "graph_vlabel signal-to-noise (dB)\n";
        print "graph_category network\n";
    }
    else
    {
        print "graph_title Powerline network speed ($interface)\n";
        print "graph_vlabel bits per second\n";
        print "graph_category network\n";
        print "graph_args --base 1000\n";
    }
    my $details = getnetworkrate($interface);
    if (!defined $details->{'nid'})
    {
        print STDERR "No networks detected. Nothing to do.\n";
        exit;
    }
    if (@{ $details->{'stations'} } == 0)
    {
        print STDERR "No stations detected.\n";
        exit;
    }

    # List the stations, in a fixed order
    for my $station (sort { $a->{'name'} cmp $b->{'name'} } @{ $details->{'stations'} })
    {
        my $label = $station->{'mac'};
        my $more = "";
        if (defined $ENV{ "LABEL_" .$station->{'name'} })
        {
            $label = $ENV{ "LABEL_" .$station->{'name'} };
            $more = " ($label)";
        }
        if ($tool eq 'snr')
        {
            print "$station->{'name'}_snr.info Signal-to-noise at $station->{'mac'}$more\n";
            print "$station->{'name'}_snr.label SNR $label\n";
        }
        else
        {
            print "$station->{'name'}_tx.info Transmit rate at $station->{'mac'}$more\n";
            print "$station->{'name'}_rx.info Receive rate at $station->{'mac'}$more\n";
            print "$station->{'name'}_tx.label TX $label\n";
            print "$station->{'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 $tool (@tools)
    {
        print map { "${tool}_$_\n" } @$plc_ifs;
    }
}


##
# 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 speed.
#
# @param[in] $interface   Interface name
#
# @return hashref containing:
#           'controller' => Details about the controller device, as hashref
#                           'tei'   => device id
#                           'mac'   => MAC address
#                           'name'  => device MAC without colons
#                           'bda'   => device BDA
#           'stations'   => Details about the stations, as an arrayref which
#                           contains a hashref:
#                           'tei'   => device id
#                           'mac'   => MAC address
#                           'name'  => device MAC without colons
#                           'bda'   => device BDA
#                           'txbps' => transmit speed in BPS
#                           'rxbps' => receive speed in BPS
#           'nid'        => Network identifier
#           'snid'       => Not sure
sub getnetworkrate
{
    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
    #
    # Since I don't know what the format is like when there are more than 2
    # devices, we'll only handle that case.

    my $output = `$cmd`;
    my @stations;
    my $details = {
        'controller' => undef,
        'nid'        => undef,
        'snid'       => undef,
        'stations'   => \@stations,
    };

    my @lines = split /\n/, $output;
    for my $line (@lines)
    {
        # Station?
        my ($tei, $stationmac, $stationbda, $tx, $rx) = ($line =~ /STA TEI (\d+) MAC ($macre) BDA ($macre) TX (\d+) RX (\d+)/ig);
        if (defined $tei)
        {
            my $station = $stationmac;
            # Reduce the station to just the name
            $station =~ s/://g;
            push @stations, {
                'tei' => $tei,
                'mac' => $stationmac,
                'name' => $station,
                'bda' => $stationbda,
                'txbps' => $tx * 1000 * 1000, # Convert mbps => bps
                'rxbps' => $rx * 1000 * 1000, # Convert mbps => bps
            };
        }
        
        # Controller?
        ($tei, $stationmac, $stationbda) = ($line =~ /CCO TEI (\d+) MAC ($macre) BDA ($macre)/ig);
        if (defined $tei)
        {
            my $station = $stationmac;
            # Reduce the station to just the name
            $station =~ s/://g;
            $details->{'controller'} = {
                'tei' => $tei,
                'mac' => $stationmac,
                'name' => $station,
                'bda' => $stationbda,
            };
        }
        
        # 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)
        {
            $details->{'nid'} = $nid;
            $details->{'snid'} = $snid;
        }
    }

    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

    
    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, $slot1, $slot2, $slot3, $slot4, $slot5, $slot6, $meansquare) =
            ($line =~ /^(\d+),(\d+),(\d+),(\d+),(\d+),(\d+),(\d+) (\d+)/);
        if (defined $tone)
        {
            $details->{'tone'}->{$tone} = [ $slot1, $slot2, $slot3, $slot4, $slot5, $slot6 ];
            $details->{'avgtone'}->{$tone} = $meansquare;
        }
        
        my ($field);
        ($field, $slot1, $slot2, $slot3, $slot4, $slot5, $slot6, $meansquare) =
            ($line =~ /^ *([A-Z]+), *([0-9\.\-]+), *([0-9\.\-]+), *([0-9\.\-]+), *([0-9\.\-]+), *([0-9\.\-]+), *([0-9\.\-]+)(?:, *([0-9\.\-]+))?/);
        
        if (defined $field)
        {
            $details->{$field} = [$slot1, $slot2, $slot3, $slot4, $slot5, $slot6];
            $details->{'avg'.$field} = $meansquare;
        }
    }
    
    return $details;
}