| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | # | 
| 2 |  |  |  |  |  |  | # $Id: v3Report.pm 49 2009-05-31 13:15:34Z VinsWorldcom $ | 
| 3 |  |  |  |  |  |  | # | 
| 4 |  |  |  |  |  |  | package Net::Frame::Layer::IGMP::v3Report; | 
| 5 | 6 |  |  | 6 |  | 9458 | use strict; use warnings; | 
|  | 6 |  |  | 6 |  | 11 |  | 
|  | 6 |  |  |  |  | 227 |  | 
|  | 6 |  |  |  |  | 34 |  | 
|  | 6 |  |  |  |  | 8 |  | 
|  | 6 |  |  |  |  | 201 |  | 
| 6 |  |  |  |  |  |  |  | 
| 7 | 6 |  |  | 6 |  | 1077 | use Net::Frame::Layer qw(:consts :subs); | 
|  | 6 |  |  |  |  | 118743 |  | 
|  | 6 |  |  |  |  | 1496 |  | 
| 8 | 6 |  |  | 6 |  | 40 | use Exporter; | 
|  | 6 |  |  |  |  | 11 |  | 
|  | 6 |  |  |  |  | 797 |  | 
| 9 |  |  |  |  |  |  | our @ISA = qw(Net::Frame::Layer Exporter); | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | our %EXPORT_TAGS = ( | 
| 12 |  |  |  |  |  |  | consts => [qw( | 
| 13 |  |  |  |  |  |  | NF_IGMP_REPORTv3TYPE_MODEINCLUDE | 
| 14 |  |  |  |  |  |  | NF_IGMP_REPORTv3TYPE_MODEEXCLUDE | 
| 15 |  |  |  |  |  |  | NF_IGMP_REPORTv3TYPE_CHANGEINCLUDE | 
| 16 |  |  |  |  |  |  | NF_IGMP_REPORTv3TYPE_CHANGEEXCLUDE | 
| 17 |  |  |  |  |  |  | NF_IGMP_REPORTv3TYPE_ALLOWNEW | 
| 18 |  |  |  |  |  |  | NF_IGMP_REPORTv3TYPE_BLOCKOLD | 
| 19 |  |  |  |  |  |  | )], | 
| 20 |  |  |  |  |  |  | ); | 
| 21 |  |  |  |  |  |  | our @EXPORT_OK = ( | 
| 22 |  |  |  |  |  |  | @{$EXPORT_TAGS{consts}}, | 
| 23 |  |  |  |  |  |  | ); | 
| 24 |  |  |  |  |  |  |  | 
| 25 | 6 |  |  | 6 |  | 32 | use constant NF_IGMP_REPORTv3TYPE_MODEINCLUDE   => 1; | 
|  | 6 |  |  |  |  | 10 |  | 
|  | 6 |  |  |  |  | 395 |  | 
| 26 | 6 |  |  | 6 |  | 30 | use constant NF_IGMP_REPORTv3TYPE_MODEEXCLUDE   => 2; | 
|  | 6 |  |  |  |  | 10 |  | 
|  | 6 |  |  |  |  | 302 |  | 
| 27 | 6 |  |  | 6 |  | 29 | use constant NF_IGMP_REPORTv3TYPE_CHANGEINCLUDE => 3; | 
|  | 6 |  |  |  |  | 11 |  | 
|  | 6 |  |  |  |  | 1747 |  | 
| 28 | 6 |  |  | 6 |  | 29 | use constant NF_IGMP_REPORTv3TYPE_CHANGEEXCLUDE => 4; | 
|  | 6 |  |  |  |  | 10 |  | 
|  | 6 |  |  |  |  | 265 |  | 
| 29 | 6 |  |  | 6 |  | 36 | use constant NF_IGMP_REPORTv3TYPE_ALLOWNEW      => 5; | 
|  | 6 |  |  |  |  | 10 |  | 
|  | 6 |  |  |  |  | 238 |  | 
| 30 | 6 |  |  | 6 |  | 38 | use constant NF_IGMP_REPORTv3TYPE_BLOCKOLD      => 6; | 
|  | 6 |  |  |  |  | 14 |  | 
|  | 6 |  |  |  |  | 6748 |  | 
| 31 |  |  |  |  |  |  |  | 
| 32 |  |  |  |  |  |  | our @AS = qw( | 
| 33 |  |  |  |  |  |  | type | 
| 34 |  |  |  |  |  |  | auxDataLen | 
| 35 |  |  |  |  |  |  | numSources | 
| 36 |  |  |  |  |  |  | multicastAddress | 
| 37 |  |  |  |  |  |  | auxData | 
| 38 |  |  |  |  |  |  | ); | 
| 39 |  |  |  |  |  |  | our @AA = qw( | 
| 40 |  |  |  |  |  |  | sourceAddress | 
| 41 |  |  |  |  |  |  | ); | 
| 42 |  |  |  |  |  |  | __PACKAGE__->cgBuildIndices; | 
| 43 |  |  |  |  |  |  | __PACKAGE__->cgBuildAccessorsScalar(\@AS); | 
| 44 |  |  |  |  |  |  | __PACKAGE__->cgBuildAccessorsArray(\@AA); | 
| 45 |  |  |  |  |  |  |  | 
| 46 |  |  |  |  |  |  | #no strict 'vars'; | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  | sub new { | 
| 49 |  |  |  |  |  |  | shift->SUPER::new( | 
| 50 | 3 |  |  | 3 | 1 | 632 | type             => NF_IGMP_REPORTv3TYPE_MODEINCLUDE, | 
| 51 |  |  |  |  |  |  | auxDataLen       => 0, | 
| 52 |  |  |  |  |  |  | numSources       => 0, | 
| 53 |  |  |  |  |  |  | multicastAddress => '0.0.0.0', | 
| 54 |  |  |  |  |  |  | sourceAddress    => [], | 
| 55 |  |  |  |  |  |  | auxData          => "\0", | 
| 56 |  |  |  |  |  |  | @_, | 
| 57 |  |  |  |  |  |  | ); | 
| 58 |  |  |  |  |  |  | } | 
| 59 |  |  |  |  |  |  |  | 
| 60 |  |  |  |  |  |  | sub getLength { | 
| 61 | 0 |  |  | 0 | 1 | 0 | my $self = shift; | 
| 62 | 0 |  |  |  |  | 0 | my $len = 8 + length($self->auxData); | 
| 63 | 0 |  |  |  |  | 0 | $len += 4 for $self->sourceAddress; | 
| 64 | 0 |  |  |  |  | 0 | return $len; | 
| 65 |  |  |  |  |  |  | } | 
| 66 |  |  |  |  |  |  |  | 
| 67 |  |  |  |  |  |  | sub pack { | 
| 68 | 1 |  |  | 1 | 1 | 312 | my $self = shift; | 
| 69 |  |  |  |  |  |  |  | 
| 70 | 1 | 50 |  |  |  | 5 | my $raw = $self->SUPER::pack('CCna4', | 
| 71 |  |  |  |  |  |  | $self->type, | 
| 72 |  |  |  |  |  |  | $self->auxDataLen, | 
| 73 |  |  |  |  |  |  | $self->numSources, | 
| 74 |  |  |  |  |  |  | inetAton($self->multicastAddress), | 
| 75 |  |  |  |  |  |  | ) or return; | 
| 76 |  |  |  |  |  |  |  | 
| 77 | 1 |  |  |  |  | 122 | for ($self->sourceAddress) { | 
| 78 | 0 |  |  |  |  | 0 | $raw .= inetAton($_); | 
| 79 |  |  |  |  |  |  | } | 
| 80 |  |  |  |  |  |  |  | 
| 81 | 1 | 50 |  |  |  | 23 | if ($self->auxData ne "\0") { | 
| 82 | 0 | 0 |  |  |  | 0 | $raw .= $self->SUPER::pack('a*', | 
| 83 |  |  |  |  |  |  | $self->auxData, | 
| 84 |  |  |  |  |  |  | ) or return; | 
| 85 |  |  |  |  |  |  | } | 
| 86 |  |  |  |  |  |  |  | 
| 87 | 1 |  |  |  |  | 20 | return $self->raw($raw); | 
| 88 |  |  |  |  |  |  | } | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  | sub unpack { | 
| 91 | 1 |  |  | 1 | 1 | 14 | my $self = shift; | 
| 92 |  |  |  |  |  |  |  | 
| 93 | 1 | 50 |  |  |  | 7 | my ($type, $auxDataLen, $numSources, $multicastAddress, $payload) = | 
| 94 |  |  |  |  |  |  | $self->SUPER::unpack('CCna4 a*', $self->raw) | 
| 95 |  |  |  |  |  |  | or return; | 
| 96 |  |  |  |  |  |  |  | 
| 97 | 1 |  |  |  |  | 35 | $self->type($type); | 
| 98 | 1 |  |  |  |  | 12 | $self->auxDataLen($auxDataLen); | 
| 99 | 1 |  |  |  |  | 12 | $self->numSources($numSources); | 
| 100 | 1 |  |  |  |  | 13 | $self->multicastAddress(inetNtoa($multicastAddress)); | 
| 101 |  |  |  |  |  |  |  | 
| 102 | 1 |  |  |  |  | 18 | my @sourceAddress = (); | 
| 103 | 1 |  |  |  |  | 5 | for my $num (0..$numSources-1) { | 
| 104 | 0 | 0 | 0 |  |  | 0 | if (defined($payload) && (length($payload) >= 4)) { | 
| 105 | 0 |  |  |  |  | 0 | my $addr = unpack 'a4', $payload; | 
| 106 | 0 |  |  |  |  | 0 | push @sourceAddress, inetNtoa($addr); | 
| 107 | 0 |  |  |  |  | 0 | $payload = substr $payload, 4; | 
| 108 |  |  |  |  |  |  | } | 
| 109 |  |  |  |  |  |  | } | 
| 110 | 1 |  |  |  |  | 4 | $self->sourceAddress(\@sourceAddress); | 
| 111 | 1 |  |  |  |  | 13 | $self->auxData("\0"); | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  | # auxDataLen is length in 32-bit words so extra math (/4, *4) | 
| 114 | 1 | 0 | 33 |  |  | 19 | if (($self->auxDataLen > 0) && defined($payload) && ((length($payload)/4) >= $self->auxDataLen)) { | 
|  |  |  | 33 |  |  |  |  | 
| 115 | 0 |  |  |  |  | 0 | my $auxData = substr $payload, 0, $self->auxDataLen*4; | 
| 116 | 0 |  |  |  |  | 0 | $self->auxData($auxData); | 
| 117 | 0 |  |  |  |  | 0 | $payload = substr $payload, $self->auxDataLen*4 | 
| 118 |  |  |  |  |  |  | } | 
| 119 |  |  |  |  |  |  |  | 
| 120 | 1 |  |  |  |  | 21 | $self->payload($payload); | 
| 121 |  |  |  |  |  |  |  | 
| 122 | 1 |  |  |  |  | 36 | return $self; | 
| 123 |  |  |  |  |  |  | } | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | sub encapsulate { | 
| 126 | 1 |  |  | 1 | 1 | 7 | my $self = shift; | 
| 127 |  |  |  |  |  |  |  | 
| 128 | 1 | 50 |  |  |  | 10 | return $self->nextLayer if $self->nextLayer; | 
| 129 |  |  |  |  |  |  |  | 
| 130 | 1 | 50 |  |  |  | 17 | if ($self->payload) { | 
| 131 | 0 |  |  |  |  | 0 | return 'IGMP::v3Report'; | 
| 132 |  |  |  |  |  |  | } | 
| 133 |  |  |  |  |  |  |  | 
| 134 | 1 |  |  |  |  | 14 | NF_LAYER_NONE; | 
| 135 |  |  |  |  |  |  | } | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | sub computeLengths { | 
| 138 | 2 |  |  | 2 | 1 | 260 | my $self = shift; | 
| 139 |  |  |  |  |  |  |  | 
| 140 |  |  |  |  |  |  | # Calculate auxDataLen if auxData and auxDataLen = 0 | 
| 141 | 2 | 100 | 66 |  |  | 7 | if (($self->auxData ne "\0") && ($self->auxDataLen == 0)) { | 
| 142 |  |  |  |  |  |  | # auxDataLen is number of 32-bit words | 
| 143 | 1 | 50 |  |  |  | 48 | if (my $mod = (length($self->auxData) * 8) % 32) { | 
| 144 | 1 |  |  |  |  | 17 | my $pad = (32 - $mod)/8; | 
| 145 | 1 |  |  |  |  | 13 | my $auxData = $self->auxData; | 
| 146 |  |  |  |  |  |  | # Add padding if required to make 32-bit flush | 
| 147 | 1 |  |  |  |  | 14 | $auxData .= "\0"x$pad; | 
| 148 | 1 |  |  |  |  | 5 | $self->auxData($auxData) | 
| 149 |  |  |  |  |  |  | } | 
| 150 | 1 |  |  |  |  | 13 | $self->auxDataLen(length($self->auxData)/4) | 
| 151 |  |  |  |  |  |  | } | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | # Calculate numSources from sourceAddress array items | 
| 154 | 2 | 100 | 66 |  |  | 37 | if (scalar($self->sourceAddress) && ($self->numSources == 0)) { | 
| 155 | 1 |  |  |  |  | 47 | $self->numSources(scalar($self->sourceAddress)) | 
| 156 |  |  |  |  |  |  | } | 
| 157 |  |  |  |  |  |  |  | 
| 158 | 2 |  |  |  |  | 34 | return 1; | 
| 159 |  |  |  |  |  |  | } | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | sub print { | 
| 162 | 5 |  |  | 5 | 1 | 24 | my $self = shift; | 
| 163 |  |  |  |  |  |  |  | 
| 164 | 5 |  |  |  |  | 30 | my $l = $self->layer; | 
| 165 | 5 |  |  |  |  | 58 | my $buf = sprintf | 
| 166 |  |  |  |  |  |  | "$l: type:%d  auxDataLen:%d  numSources:%d\n". | 
| 167 |  |  |  |  |  |  | "$l: multicastAddress:%s", | 
| 168 |  |  |  |  |  |  | $self->type, $self->auxDataLen, $self->numSources, | 
| 169 |  |  |  |  |  |  | $self->multicastAddress; | 
| 170 |  |  |  |  |  |  |  | 
| 171 | 5 |  |  |  |  | 252 | for ($self->sourceAddress) { | 
| 172 | 4 |  |  |  |  | 34 | $buf .= sprintf | 
| 173 |  |  |  |  |  |  | "\n$l: sourceAddress:%s", | 
| 174 |  |  |  |  |  |  | $_ | 
| 175 |  |  |  |  |  |  | } | 
| 176 |  |  |  |  |  |  |  | 
| 177 | 5 | 100 |  |  |  | 45 | if ($self->auxData ne "\0") { | 
| 178 | 2 |  |  |  |  | 29 | $buf .= sprintf | 
| 179 |  |  |  |  |  |  | "\n$l: auxData:%s", | 
| 180 |  |  |  |  |  |  | $self->auxData | 
| 181 |  |  |  |  |  |  | } | 
| 182 |  |  |  |  |  |  |  | 
| 183 | 5 |  |  |  |  | 1010 | return $buf; | 
| 184 |  |  |  |  |  |  | } | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | 1; | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | __END__ |