ArubaOSCX.pm first pass

ArubaOSCX.pm

# SNMP::Info::Layer3::ArubaOSCX
#
# Copyright (c) 2020 Jeroen van Ingen, Jethro R Binks
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
#     * Redistributions of source code must retain the above copyright notice,
#       this list of conditions and the following disclaimer.
#     * Redistributions in binary form must reproduce the above copyright
#       notice, this list of conditions and the following disclaimer in the
#       documentation and/or other materials provided with the distribution.
#     * Neither the name of the University of California, Santa Cruz nor the
#       names of its contributors may be used to endorse or promote products
#       derived from this software without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
# LIABLE FOR # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

package SNMP::Info::Layer3::ArubaOSCX;

use strict;
use warnings;
use Exporter;
use SNMP::Info::Layer3;
use SNMP::Info::IEEE802dot3ad 'agg_ports_lag';

@SNMP::Info::Layer3::ArubaOSCX::ISA = qw/
  SNMP::Info::Layer3
  SNMP::Info::IEEE802dot3ad
  Exporter
/;

@SNMP::Info::Layer3::ArubaOSCX::EXPORT_OK = qw/
  agg_ports
/;

our ($VERSION, %GLOBALS, %MIBS, %FUNCS, %MUNGE);

$VERSION = '1.0';

%MIBS = (
    %SNMP::Info::Layer3::MIBS,
    %SNMP::Info::IEEE802dot3ad::MIBS,
    'ARUBAWIRED-NETWORKING-OID'    =>    'reservedhpeNetworking',
    'ARUBAWIRED-CHASSIS-MIB'       =>    'arubaWiredPowerSupply',
    'ARUBAWIRED-POWERSUPPLY-MIB'   =>    'arubaWiredPSUNotifications',
);
%GLOBALS = (
    %SNMP::Info::Layer3::GLOBALS,

    # This correspondes to the "Base Mac address" the system reports:
    'mac'     => 'dot1dBaseBridgeAddress',
    # The version running on unit 1 in the stack:
    'os_ver'  => 'entPhysicalSoftwareRev.1',
);

# TBD:
#    'fan' => 'hh3cDevMFanStatus.1',
#    'ps1_status' => 'hh3cDevMPowerStatus.1',
#    'ps2_status' => 'hh3cDevMPowerStatus.2',

%FUNCS = (
    %SNMP::Info::Layer3::FUNCS,
    %SNMP::Info::IEEE802dot3ad::FUNCS,
);

# Needed?
#    i_duplex_admin => 'hh3cifEthernetDuplex',

%MUNGE = (
    %SNMP::Info::Layer3::MUNGE,
    %SNMP::Info::IEEE802dot3ad::MUNGE,
    'description'       => \&munge_descr,
);

sub munge_descr {
    # sysDescr: Aruba JL658A 6300M 24SFP+ 4SFP56 Swch FL.10.05.0030
    # I don't like the OS version in there
    # And Swch is spelled curiously incorrectly
    # Some may object to messing around with this and might want it shown honestly

    my $descr = shift;
    return unless defined $descr;
    return unless length $descr;

    $descr =~ s/Swch/Switch/;
    $descr =~ s/ (GL|FL)\.\d+\.\d+\.\d+$//;

    return $descr;
}

sub vendor {
    my $l3 = shift;

    return 'aruba';
}

sub model {
    # Model is usually taken to be the part no like JL658A
    # But that's a bit opaque, and maybe people would like the
    # the friendlier "6300M" instead
    # But descr has the full description and specific details
    # so let's keep this the technical part no
    my $l3 = shift;
    my $id    = $l3->id();
    my $descr = $l3->description();
    my $model;

    if (defined $id) {
        $model = &SNMP::translateObj($id);
        # this gives something ugly like arubaWiredSwitchJL658A
        $model =~ s/arubaWiredSwitch//g;
    } else {
        # I don't expect this method would ever be needed
        # But does help protect against a MIB not being up-to-date
        $model = $descr;
        $model =~ s/^Aruba (.+)/$1/;
    }
    return $model;
}


sub os {
    my $l3 = shift;
    my $descr   = $l3->description();

    return 'arubaos-cx';
}

sub i_ignore {
# TBD
    my $l3      = shift;
    my $partial = shift;

    my $interfaces = $l3->interfaces($partial) || {};

    my %i_ignore;
    foreach my $if ( keys %$interfaces ) {

        # lo0 etc
        if ( $interfaces->{$if} =~ /\blo\d*\b/i ) {
            $i_ignore{$if}++;
        }
    }
    return \%i_ignore;
}

sub agg_ports { return agg_ports_lag(@_) }
# For ArubaOSCX, the ipNetToPhysicalPhysAddress table appears to be of the form:
# $ifindex.$inetaddresstype.$ip_address -> $mac_address
# eg: ipNetToPhysicalPhysAddress.0.ipv4."10.10.90.1" 7a:7a:7a:7a:7a:7a
#     .1.3.6.1.2.1.4.35.1.4. 0.1 .4.10.10.90.1
#
# where:
#
#  $ifindex always appears to be 0?
#  $inetaddresstype = 1(ipv4)
#  4 is the length of the octet string to follow
#
# Using the output of ipNetToPhysicalPhysAddress, we can emulate the other
# functions.
#
# This doesn't really line up to what at_* return, so we munge it

sub at_paddr {
        my ($l3)    = shift;
        my ($partial) = shift;

        my $paddrs   = $l3->n2p_paddr($partial);
        my $n_paddrs = {};

        foreach my $key ( keys %$paddrs ) {
                my $paddr = $paddrs->{$key};
                my @parts = split /\./, $key;
                my ( $ifindex, $addrtype, $length) = splice @parts, 0, 3;
                my $ip = join ".", @parts;

                next if ( $addrtype != "1" );    # at_paddr doesn't support non-IPv4

                $n_paddrs->{"$ifindex.$ip"} = $paddr;
        }
        return $n_paddrs;
}

sub at_netaddr {
        my ($l3)    = shift;
        my ($partial) = shift;

        my $paddrs = $l3->n2p_paddr($partial);

        my $netaddrs = {};

        foreach my $key ( keys %$paddrs ) {
                my $paddr = $paddrs->{$key};
                my @parts = split /\./, $key;
                my ( $ifindex, $addrtype, $len ) = splice @parts, 0, 3;
                my $ip = join ".", @parts;

                next if ( $addrtype != "1" );    # at_netaddr doesn't support non-IPv4

                $netaddrs->{"$ifindex.$ip"} = $ip;
        }
        return $netaddrs;
}

sub at_ifaddr {
        my ($l3)    = shift;
        my ($partial) = shift;

        my $paddrs = $l3->n2p_paddr($partial);

        my $ifaddrs = {};

        foreach my $key ( keys %$paddrs ) {
                my $paddr = $paddrs->{$key};
                my @parts = split /\./, $key;
                my ( $ifindex, $addrtype, $len ) = splice @parts, 0, 3;
                my $ip = join ".", @parts;

                next if ( $addrtype != "1" );    # at_ifaddr doesn't support non-IPv4

                $ifaddrs->{"$ifindex.$ip"} = $ip;
        }
        return $ifaddrs;
}

sub debug_print {
    my $l3 = shift;
    my @arr = @_;

    if ( defined $l3 && $l3->debug() ) {
      foreach ( @arr ) {
        $_ = "(undef)" if ! defined($_);
      }
    print "+=====> ", @arr, "\n";
    }
}



1;
__END__