File Coverage

blib/lib/Net/SNMP/Mixin/Dot1qVlanStatic.pm
Criterion Covered Total %
statement 59 124 47.5
branch 18 50 36.0
condition 3 6 50.0
subroutine 17 20 85.0
pod 3 3 100.0
total 100 203 49.2


line stmt bran cond sub pod time code
1             package Net::SNMP::Mixin::Dot1qVlanStatic;
2              
3 4     4   230934 use strict;
  4         5  
  4         98  
4 4     4   14 use warnings;
  4         4  
  4         117  
5              
6             #
7             # store this package name in a handy variable,
8             # used for unambiguous prefix of mixin attributes
9             # storage in object hash
10             #
11             my $prefix = __PACKAGE__;
12              
13             #
14             # this module import config
15             #
16 4     4   13 use Carp ();
  4         11  
  4         39  
17 4     4   743 use Net::SNMP ();
  4         58957  
  4         101  
18 4     4   805 use Net::SNMP::Mixin::Util qw/idx2val hex2octet get_init_slot/;
  4         9645  
  4         27  
19              
20             #
21             # this module export config
22             #
23             my @mixin_methods;
24              
25             BEGIN {
26 4     4   1175 @mixin_methods = (
27             qw/
28             map_vlan_static_ports2ids
29             map_vlan_static_ids2ports
30             map_vlan_static_ids2names
31             /
32             );
33             }
34              
35 4         30 use Sub::Exporter -setup => {
36             exports => [@mixin_methods],
37             groups => { default => [@mixin_methods], },
38 4     4   19 };
  4         5  
39              
40             #
41             # SNMP oid constants used in this module
42             #
43             use constant {
44 4         1840 DOT1D_BASE_NUM_PORTS => '1.3.6.1.2.1.17.1.2.0',
45              
46             DOT1Q_VLAN_STATIC_NAME => '1.3.6.1.2.1.17.7.1.4.3.1.1',
47             DOT1Q_VLAN_STATIC_EGRESS_PORTS => '1.3.6.1.2.1.17.7.1.4.3.1.2',
48             DOT1Q_VLAN_STATIC_UNTAGGED_PORTS => '1.3.6.1.2.1.17.7.1.4.3.1.4',
49             DOT1Q_VLAN_STATIC_ROW_STATUS => '1.3.6.1.2.1.17.7.1.4.3.1.5',
50 4     4   1196 };
  4         4  
51              
52             =head1 NAME
53              
54             Net::SNMP::Mixin::Dot1qVlanStatic - mixin class for 802.1-Q static vlan infos
55              
56             =head1 VERSION
57              
58             Version 0.04
59              
60             =cut
61              
62             our $VERSION = '0.04';
63              
64             =head1 SYNOPSIS
65              
66             use Net::SNMP;
67             use Net::SNMP::Mixin qw/mixer init_mixins/;
68              
69             my $session = Net::SNMP->session( -hostname => 'foo.bar.com');
70             $session->mixer('Net::SNMP::Mixin::Dot1qVlanStatic');
71             $session->init_mixins;
72             snmp_dispatcher() if $session->nonblocking;
73             $session->init_ok();
74             die $session->errors if $session->errors;
75              
76             my $vlan_ids2names = $session->map_vlan_static_ids2names();
77             foreach my $vlan_id ( keys %{$vlan_ids2names} ) {
78             printf "Vlan-Id: %4d => Vlan-Name: %s\n",
79             $vlan_id, $vlan_ids2names->{$vlan_id};
80             }
81              
82             # sorted by vlan_id
83             my $vlan_ids2ports = $session->map_vlan_static_ids2ports();
84             foreach my $vlan_id ( keys %{$vlan_ids2ports} ) {
85             printf "Vlan-Id: %4d\n", $vlan_id;
86             printf "\tTagged-Ports: %s\n",
87             ( join ',', @{ $vlan_ids2ports->{$vlan_id}{tagged} } );
88             printf "\tUntagged-Ports: %s\n",
89             ( join ',', @{ $vlan_ids2ports->{$vlan_id}{untagged} } );
90             }
91              
92             # sorted by bridge_port
93             my $vlan_ports2ids = $session->map_vlan_static_ports2ids();
94             foreach my $bridge_port ( keys %{$vlan_ports2ids} ) {
95             printf "Bridge-Port: %4d\n", $bridge_port;
96             printf "\tTagged-Vlans: %s\n",
97             ( join ',', @{ $vlan_ports2ids->{$bridge_port}{tagged} } );
98             printf "\tUntagged-Vlans: %s\n",
99             ( join ',', @{ $vlan_ports2ids->{$bridge_port}{untagged} } );
100             }
101              
102             =head1 DESCRIPTION
103              
104             A mixin class for vlan related infos from the dot1qVlanStaticTable within the Q-BRIDGE-MIB. The mixin-module provides methods for mapping between vlan-ids and vlan-names und relations between bridge-ports and vlan-ids, tagged or untagged on these ports.
105              
106             =head1 MIXIN METHODS
107              
108             =head2 B<< OBJ->map_vlan_static_ids2names() >>
109              
110             Returns a hash reference with statically configured vlan-ids as keys and the corresponing vlan-names as values:
111              
112             {
113             vlan_id => vlan_name,
114             vlan_id => vlan_name,
115             ... ,
116             }
117              
118             =cut
119              
120             sub map_vlan_static_ids2names {
121 1     1 1 23007 my $session = shift;
122 1         7 my $agent = $session->hostname;
123              
124 1 50       9 Carp::croak "$agent: '$prefix' not initialized,"
125             unless $session->init_ok($prefix);
126              
127 0         0 my @active_vlan_ids = @{$session->{$prefix}{activeVlanIds}};
  0         0  
128              
129 0         0 my $result = {};
130 0         0 foreach my $vlan_id (@active_vlan_ids) {
131              
132 0         0 $result->{$vlan_id} = $session->{$prefix}{dot1qVlanStaticNames}{$vlan_id};
133             }
134              
135 0         0 return $result;
136             }
137              
138             =head2 B<< OBJ->map_vlan_static_ids2ports() >>
139              
140             Returns a hash reference with the vlan-ids as keys and tagged and untagged port-lists as values:
141              
142             {
143             vlan_id => {
144             tagged => [port_list],
145             untagged => [port_list],
146             },
147              
148             vlan_id => {
149             tagged => [port_list],
150             untagged => [port_list],
151             },
152              
153             ... ,
154             }
155            
156             =cut
157              
158             sub map_vlan_static_ids2ports {
159 1     1 1 621 my $session = shift;
160 1         5 my $agent = $session->hostname;
161              
162 1 50       7 Carp::croak "$agent: '$prefix' not initialized,"
163             unless $session->init_ok($prefix);
164              
165 0         0 my $num_bridge_ports = $session->{$prefix}{dot1dBaseNumPorts};
166 0         0 my @active_vlan_ids = @{$session->{$prefix}{activeVlanIds}};
  0         0  
167              
168 0         0 my $result;
169              
170             # loop over all active vlan ids
171 0         0 foreach my $vlan_id (@active_vlan_ids) {
172              
173             # tagged/untagged ports for this vlan_id
174 0         0 my @tagged_ports;
175             my @untagged_ports;
176              
177             # loop over all possible bridge-ports
178 0         0 foreach my $bridge_port ( 1 .. $num_bridge_ports ) {
179              
180 0 0       0 push @tagged_ports, $bridge_port
181             if _is_tagged( $session, $bridge_port, $vlan_id );
182              
183 0 0       0 push @untagged_ports, $bridge_port
184             if _is_untagged( $session, $bridge_port, $vlan_id );
185             }
186              
187 0         0 $result->{$vlan_id} =
188             { tagged => \@tagged_ports, untagged => \@untagged_ports };
189             }
190 0         0 return $result;
191             }
192              
193             =head2 B<< OBJ->map_vlan_static_ports2ids() >>
194              
195             Returns a hash reference with the bridge-ports as keys and tagged and untagged vlan-ids as values:
196              
197             {
198             bridge_port => {
199             tagged => [vlan_id_list],
200             untagged => [vlan_id_list],
201             },
202              
203             bridge_port => {
204             tagged => [vlan_id_list],
205             untagged => [vlan_id_list],
206             },
207              
208             ... ,
209             }
210            
211            
212             =cut
213              
214             sub map_vlan_static_ports2ids {
215 1     1 1 639 my $session = shift;
216 1         5 my $agent = $session->hostname;
217              
218 1 50       6 Carp::croak "$agent: '$prefix' not initialized,"
219             unless $session->init_ok($prefix);
220              
221 0         0 my $num_bridge_ports = $session->{$prefix}{dot1dBaseNumPorts};
222 0         0 my @active_vlan_ids = @{$session->{$prefix}{activeVlanIds}};
  0         0  
223              
224 0         0 my $result = {};
225              
226             # loop over all possible bridge-ports
227 0         0 foreach my $bridge_port ( 1 .. $num_bridge_ports ) {
228              
229 0         0 my @tagged_vlans;
230             my @untagged_vlans;
231              
232             # loop over all active vlans
233 0         0 foreach my $vlan_id (@active_vlan_ids) {
234              
235 0 0       0 push @tagged_vlans, $vlan_id
236             if _is_tagged( $session, $bridge_port, $vlan_id );
237              
238 0 0       0 push @untagged_vlans, $vlan_id
239             if _is_untagged( $session, $bridge_port, $vlan_id );
240             }
241              
242 0         0 $result->{$bridge_port} =
243             { tagged => \@tagged_vlans, untagged => \@untagged_vlans };
244             }
245 0         0 return $result;
246             }
247              
248             =head1 INITIALIZATION
249              
250             =head2 B<< OBJ->_init($reload) >>
251              
252             Fetch basic Dot1Q Vlan related snmp values from the host. Don't call this method direct!
253              
254             =cut
255              
256             #
257             # due to the asynchron nature, we don't know what init job is really the last, we decrement
258             # the value after each callback
259             #
260 4     4   16 use constant THIS_INIT_JOBS => 2;
  4         5  
  4         2520  
261              
262             sub _init {
263 4     4   7067 my ( $session, $reload ) = @_;
264 4         9 my $agent = $session->hostname;
265              
266             die "$agent: $prefix already initialized and reload not forced.\n"
267             if exists get_init_slot($session)->{$prefix}
268 4 50 66     21 && get_init_slot($session)->{$prefix} == 0
      33        
269             && not $reload;
270              
271             # set number of async init jobs for proper initialization
272 4         78 get_init_slot($session)->{$prefix} = THIS_INIT_JOBS;
273              
274             # initialize the object for forwarding databases infos
275 4         26 _fetch_dot1d_base_num_ports($session);
276 4 100       23 return if $session->error;
277              
278             # initialize the object for current vlan tag infos
279 2         11 _fetch_dot1q_vlan_static_tbl_entries($session);
280 2 50       10 return if $session->error;
281              
282 2         13 return 1;
283             }
284              
285             =head1 PRIVATE METHODS
286              
287             Only for developers or maintainers.
288              
289             =head2 B<< _fetch_dot1d_base_num_ports($session) >>
290              
291             Fetch dot1dBaseNumPorts from the dot1dBase group once during object initialization.
292              
293             =cut
294              
295             sub _fetch_dot1d_base_num_ports {
296 4     4   5 my $session = shift;
297 4         4 my $result;
298              
299             # fetch the dot1dBaseNumPorts group
300 4 100       22 $result = $session->get_request(
301             -varbindlist => [ DOT1D_BASE_NUM_PORTS, ],
302              
303             # define callback if in nonblocking mode
304             $session->nonblocking ? ( -callback => \&_dot1d_base_num_ports_cb ) : (),
305             );
306              
307 4 100       2006648 return unless defined $result;
308 2 50       6 return 1 if $session->nonblocking;
309              
310             # call the callback function in blocking mode by hand
311 0         0 _dot1d_base_num_ports_cb($session);
312              
313             }
314              
315             =head2 B<< _dot1d_base_num_ports_cb($session) >>
316              
317             The callback for _fetch_dot1d_base_num_ports.
318              
319             =cut
320              
321             sub _dot1d_base_num_ports_cb {
322 2     2   2003871 my $session = shift;
323 2         14 my $vbl = $session->var_bind_list;
324              
325 2 50       26 return unless defined $vbl;
326              
327 0         0 $session->{$prefix}{dot1dBaseNumPorts} = $vbl->{ DOT1D_BASE_NUM_PORTS() };
328              
329             # this init job is finished
330 0         0 get_init_slot($session)->{$prefix}--;
331              
332 0         0 return 1;
333             }
334              
335             =head2 B<< _fetch_dot1q_vlan_static_tbl_entries() >>
336              
337             Fetch the vlan tag info for current vlans.
338              
339             =cut
340              
341             sub _fetch_dot1q_vlan_static_tbl_entries {
342 2     2   3 my $session = shift;
343 2         2 my $result;
344              
345             # fetch the vlan tag info from dot1qVlanStaticTable
346 2 50       9 $result = $session->get_entries(
    50          
347             -columns => [
348             DOT1Q_VLAN_STATIC_NAME, DOT1Q_VLAN_STATIC_EGRESS_PORTS,
349             DOT1Q_VLAN_STATIC_UNTAGGED_PORTS, DOT1Q_VLAN_STATIC_ROW_STATUS,
350             ],
351              
352             # define callback if in nonblocking mode
353             $session->nonblocking
354             ? ( -callback => \&_dot1q_vlan_static_tbl_entries_cb )
355             : (),
356              
357             # dangerous for snmp version 2c and 3, big values
358             # snmp-error: Message size exceeded buffer maxMsgSize
359             #
360             $session->version ? ( -maxrepetitions => 3 ) : (),
361             );
362              
363 2 50       1958 return unless defined $result;
364 2 50       6 return 1 if $session->nonblocking;
365              
366             # call the callback function in blocking mode by hand
367 0         0 _dot1q_vlan_static_tbl_entries_cb($session);
368              
369             }
370              
371             =head2 B<< _dot1q_vlan_static_tbl_entries_cb($session) >>
372              
373             The callback for _fetch_dot1q_vlan_static_tbl_entries_cb.
374              
375             =cut
376              
377             sub _dot1q_vlan_static_tbl_entries_cb {
378 2     2   661 my $session = shift;
379 2         6 my $vbl = $session->var_bind_list;
380              
381 2 50       15 return unless defined $vbl;
382              
383             # mangle result table to get plain
384             # dot1qVlanIndex => value
385             #
386             $session->{$prefix}{dot1qVlanStaticNames} =
387 0           idx2val( $vbl, DOT1Q_VLAN_STATIC_NAME );
388              
389             # dot1qVlanIndex => dot1qVlanStaticEgressPorts
390             $session->{$prefix}{dot1qVlanStaticEgressPorts} =
391 0           idx2val( $vbl, DOT1Q_VLAN_STATIC_EGRESS_PORTS, );
392              
393             # dot1qVlanIndex => dot1qVlanStaticUntaggedPorts
394             $session->{$prefix}{dot1qVlanStaticUntaggedPorts} =
395 0           idx2val( $vbl, DOT1Q_VLAN_STATIC_UNTAGGED_PORTS, );
396              
397             # dot1qVlanIndex => dot1qVlanStaticRowStatus
398             $session->{$prefix}{dot1qVlanStaticRowStatus} =
399 0           idx2val( $vbl, DOT1Q_VLAN_STATIC_ROW_STATUS, );
400              
401             $session->{$prefix}{activeVlanIds} = [
402 0           grep { $session->{$prefix}{dot1qVlanStaticRowStatus}{$_} == 1 }
403 0           keys %{ $session->{$prefix}{dot1qVlanStaticRowStatus} }
  0            
404             ];
405              
406 0           _calc_tagged_untagged_ports($session);
407              
408             # this init job is finished
409 0           get_init_slot($session)->{$prefix}--;
410              
411 0           return 1;
412             }
413              
414             # Process tag/untag information for each bridge base port
415             # once during object initialization.
416             sub _calc_tagged_untagged_ports {
417 0     0     my $session = shift;
418              
419             # calculate the tagged ports for each vlan
420             # this is a XOR function: egress ^ untagged
421              
422             # for all vlans
423 0           foreach my $vlan ( @{ $session->{$prefix}{activeVlanIds} } ) {
  0            
424              
425             # calculate the tagged ports for each vlan
426             # this is a XOR function: egress ^ untagged
427             #
428 0           my $egress_ports = $session->{$prefix}{dot1qVlanStaticEgressPorts}{$vlan};
429             my $untagged_ports =
430 0           $session->{$prefix}{dot1qVlanStaticUntaggedPorts}{$vlan};
431              
432             # It's importend, that the returned SNMP OCTET_STRINGs
433             # were untranslated by Net::SNMP!
434             # if already translated, we must reconvert it to a
435             # pure OCTET-STRING.
436              
437 0           $egress_ports = hex2octet($egress_ports);
438 0           $untagged_ports = hex2octet($untagged_ports);
439              
440 0           my $tagged_ports = $egress_ports ^ $untagged_ports;
441              
442             # convert to bit-string
443 0           $session->{$prefix}{TaggedPorts}{$vlan} = unpack( 'B*', $tagged_ports );
444 0           $session->{$prefix}{UntaggedPorts}{$vlan} =
445             unpack( 'B*', $untagged_ports );
446             }
447             }
448              
449             # returns true if $vlan_id is tagged on $bride_port
450             sub _is_tagged {
451 0     0     my ( $session, $bridge_port, $vlan_id ) = @_;
452              
453 0 0         die "missing attribute 'bridge_port'" unless defined $bridge_port;
454 0 0         die "missing attribute 'vlan_id'" unless defined $vlan_id;
455              
456             # it's a bitstring, see the subroutine _calc_tagged_untagged_ports
457             # substr() counts from 0, bridge_ports from 1
458             my $is_tagged =
459 0           substr( $session->{$prefix}{TaggedPorts}{$vlan_id}, $bridge_port - 1, 1 );
460              
461 0 0         return 1 if $is_tagged;
462 0           return;
463             }
464              
465             # returns true if $vlan_id is untagged on $bride_port
466             sub _is_untagged {
467 0     0     my ( $session, $bridge_port, $vlan_id ) = @_;
468              
469 0 0         die "missing attribute 'bridge_port'" unless defined $bridge_port;
470 0 0         die "missing attribute 'vlan_id'" unless defined $vlan_id;
471              
472             # it's a bitstring, see the subroutine _calc_tagged_untagged_ports
473             # substr() counts from 0, bridge_ports from 1
474 0           my $is_untagged = substr( $session->{$prefix}{UntaggedPorts}{$vlan_id},
475             $bridge_port - 1, 1 );
476              
477 0 0         return 1 if $is_untagged;
478 0           return;
479             }
480              
481             =head1 SEE ALSO
482              
483             L<< Net::SNMP::Mixin::Dot1dBase >> for a mapping between ifIndexes and dot1dBasePorts.
484              
485             =head1 REQUIREMENTS
486              
487             L<< Net::SNMP >>, L<< Net::SNMP::Mixin >>
488              
489             =head1 BUGS, PATCHES & FIXES
490              
491             There are no known bugs at the time of this release. However, if you spot a bug or are experiencing difficulties that are not explained within the POD documentation, please submit a bug to the RT system (see link below). However, it would help greatly if you are able to pinpoint problems or even supply a patch.
492              
493             Fixes are dependant upon their severity and my availablity. Should a fix not be forthcoming, please feel free to (politely) remind me by sending an email to gaissmai@cpan.org .
494              
495             RT: http://rt.cpan.org/Public/Dist/Display.html?Name=Net-SNMP-Mixin-Dot1qVlanStatic
496              
497             =head1 AUTHOR
498              
499             Karl Gaissmaier
500              
501             =head1 COPYRIGHT & LICENSE
502              
503             Copyright 2008-2016 Karl Gaissmaier, all rights reserved.
504              
505             This program is free software; you can redistribute it and/or modify it
506             under the same terms as Perl itself.
507              
508             =cut
509              
510             unless ( caller() ) {
511             print "$prefix compiles and initializes successful.\n";
512             }
513              
514             1;
515              
516             # vim: sw=2