File Coverage

blib/lib/NetPacket/LACP.pm

Criterion	Covered	Total	%
statement	18	65	27.6
branch	0	6	0.0
condition			n/a
subroutine	6	12	50.0
pod	4	5	80.0
total	28	88	31.8

#
# NetPacket::LACP - Decode and encode Link Aggregation Control Protocol
# packets
#
# Comments/suggestions to [e-mail]
#

package NetPacket::LACP;

#
# Copyright (c) 2002 Chander Ganesan.
#
# This package is free software and is provided "as is" without express
# or implied warranty.  It may be used, redistributed and/or modified
# under the terms of the Perl Artistic License (see
# http://www.perl.com/perl/misc/Artistic.html)
#
# This software and all associated data and documentation
# ('Software') is available free of charge.  You may make copies of the
# Software but you must include all of this notice on any copy.
#
# The Software was developed for research purposes does not
# warrant that it is error free or fit for any purpose.  The author
# disclaims any liability for all claims, expenses, losses, damages
# and costs any user may incur as a result of using, copying or
# modifying the Software.
#

use 5.006;
use strict;
use warnings;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);

my $myclass;
BEGIN {
    $myclass = __PACKAGE__;
    $VERSION = "0.01";
}
sub Version () { "$myclass v$VERSION" }

BEGIN {
    @ISA = qw(Exporter NetPacket);

# Items to export into callers namespace by default
# (move infrequently used names to @EXPORT_OK below)

    @EXPORT = qw(
    );

# Other items we are prepared to export if requested

    @EXPORT_OK = qw(lacp_strip
                    );

# Tags:

    %EXPORT_TAGS = (
    ALL         => [@EXPORT, @EXPORT_OK],
    strip       => [qw(lacp_strip)],
    types       => [qw(
                       )],
);

}

#
# Decode the packet
#

sub decode {
    my $class = shift;
    my($pkt, $parent, @rest) = @_;
    my $self = {};

    # Class fields

    $self->{_parent} = $parent;
    $self->{_frame} = $pkt;

    # Decode LACP packet

    #
    # Here's the format of the packet.  We can pass this in to unpack to
    # unpack it...
    #

    #
    # Perform hex to decimal conversions on these fields..
    #
    my @convert_from_hex = qw(version partner_info_length
                              collector_info_length
                              actor_info_length);
    my $lacp_contents = _get_decoder();

    if (defined($pkt)) {
        my ($key, $rest);
        $rest = $pkt;
        foreach $key (sort numerically keys %$lacp_contents) {
            foreach (keys %{$lacp_contents->{$key}}) {
                ($self->{$_}, $rest) = unpack($lacp_contents->{$key}{$_} .
                                              "a*", $rest);
            }
        }


        ($self->{AS_expired},
         $self->{AS_defaulted},
         $self->{AS_distributing},
         $self->{AS_collecting},
         $self->{AS_synchronization},
         $self->{AS_aggregation},
         $self->{AS_lacp_timeout},
         $self->{AS_lacp_activity}) = split "", $self->{AS};


        ($self->{PS_expired},
         $self->{PS_defaulted},
         $self->{PS_distributing},
         $self->{PS_collecting},
         $self->{PS_synchronization},
         $self->{PS_aggregation},
         $self->{PS_lacp_timeout},
         $self->{PS_lacp_activity}) = split "", $self->{PS};

        #
        # Perform hex to decimal conversion where necessary.
        #

        foreach (@convert_from_hex) {
            $self->{$_} = hex($self->{$_});
        }
    }
    # Return a blessed object
    return undef unless ($self->{version} == 1); # Verion 1 is LACP..
    bless($self, $class);
    return $self;
}

#
# Strip header from packet and return the data contained in it.  Spanning
# Tree packets contain no encapsulated data.
#

undef &lacp_strip;        # Create st_strip alias
*lacp_strip = \&strip;

sub strip {
    return undef;
}

#
# Encode a packet
#

sub encode {
    my ($class, $data)= @_;
    my $self = {};
    my $pkt;
    # Encode LACP packet

    #
    # Set some sensible defaults
    #
    my $defaults = {
        'lacp' => '01' ,
        'version' => '01' ,
        'actor_info' => '01' ,
        'actor_info_length' => '20' ,
        'actor_system_priority' => '25600' ,
        'actor_system' => '000000000000' ,
        'actor_key' => '193' ,
        'actor_port_priority' => '0' ,
        'actor_port' => '1' ,
        'reserved_1' => '0' x 6 ,
        'partner_info' => '02' ,
        'partner_info_length' => '20' ,
        'partner_system_priority' => '0' ,
        'partner_system' => '000000000000' ,
        'partner_key' => '0' ,
        'partner_port_priority' => '0' ,
        'partner_port' => '1' ,
        'reserved_2' => '0' x 6 ,
        'collector_info' => '03' ,
        'collector_info_length' => '16' ,
        'collector_max_delay' => '10000' ,
        'reserved_3' => '0' x 24 ,
        'terminator_info' => '00' ,
        'terminator_length' => '00' ,
        'reserved_4' => '0' x 100,
    };

    foreach (keys %$defaults) {
        if (! defined $data->{$_}) {
            $data->{$_} = $defaults->{$_};
        }
    }
    #
    # Perform decimal to hex conversions on these fields..
    #
    my @convert_from_hex = qw(version partner_info_length
                              collector_info_length
                              actor_info_length);
    my $lacp_contents = _get_decoder();

    #
    # Perform decimal to hex conversion where necessary.
    #
    foreach (@convert_from_hex) {
        $data->{$_} = sprintf("%02lx", $data->{$_});
    }

    $data->{AS} = join "", $data->{AS_expired},
                            $data->{AS_defaulted},
                            $data->{AS_distributing},
                            $data->{AS_collecting},
                            $data->{AS_synchronization},
                            $data->{AS_aggregation},
                            $data->{AS_lacp_timeout},
                            $data->{AS_lacp_activity};


    $data->{PS} = join "", $data->{PS_expired},
                            $data->{PS_defaulted},
                            $data->{PS_distributing},
                            $data->{PS_collecting},
                            $data->{PS_synchronization},
                            $data->{PS_aggregation},
                            $data->{PS_lacp_timeout},
                            $data->{PS_lacp_activity};

    #
    # Encode the data...
    #

    my ($key, $rest);
    $rest = $pkt;
    foreach $key (sort numerically keys %$lacp_contents) {
        foreach (keys %{$lacp_contents->{$key}}) {
            $pkt .= pack($lacp_contents->{$key}{$_},
                         $data->{$_});
        }
    }

    #
    # Perform hex to decimal conversion where necessary.
    #
    foreach (@convert_from_hex) {
        $data->{$_} = hex($data->{$_});
    }
    return $pkt;
}

sub _get_decoder {
    return {
        0 => { 'lacp' => 'H2' },
        1 => { 'version' => 'H2' },
        2 => { 'actor_info' => 'H2' },
        3 => { 'actor_info_length' => 'H2' },
        4 => { 'actor_system_priority' => 'n' },
        5 => { 'actor_system' => 'H12' },
        6 => { 'actor_key' => 'n' },
        7 => { 'actor_port_priority' => 'n' },
        8 => { 'actor_port' => 'n' },
        10 => { 'AS' => 'B8' },
        17 => { 'reserved_1' => 'H6' },
        18 => { 'partner_info' => 'H2' },
        19 => { 'partner_info_length' => 'H2' },
        20 => { 'partner_system_priority' => 'n' },
        21 => { 'partner_system' => 'H12' },
        22 => { 'partner_key' => 'n' },
        23 => { 'partner_port_priority' => 'n' },
        24 => { 'partner_port' => 'n' },
        25 => { 'PS' => 'B8' },
        33 => { 'reserved_2' => 'H6' },
        34 => { 'collector_info' => 'H2' },
        35 => { 'collector_info_length' => 'H2' },
        36 => { 'collector_max_delay' => 'n' },
        37 => { 'reserved_3' => 'H24' },
        38 => { 'terminator_info' => 'H2' },
        39 => { 'terminator_length' => 'H2' },
        40 => { 'reserved_4' => 'H100' },
    };
}
#
# provided for sorting.
#
sub numerically {
    $a <=> $b;
}


#
# Module return value
#
1;

# autoloaded methods go after the END token (&& pod) below

__END__