File Coverage

blib/lib/Net/SNMP/Mixin/CiscoDot1qVlanStaticTrunks.pm
Criterion Covered Total %
statement 59 126 46.8
branch 21 48 43.7
condition 3 6 50.0
subroutine 16 19 84.2
pod 3 3 100.0
total 102 202 50.5


line stmt bran cond sub pod time code
1             package Net::SNMP::Mixin::CiscoDot1qVlanStaticTrunks;
2              
3 4     4   302176 use strict;
  4         7  
  4         122  
4 4     4   17 use warnings;
  4         6  
  4         133  
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   15 use Carp ();
  4         12  
  4         63  
17              
18 4     4   11 use Net::SNMP::Mixin::Util qw/idx2val hex2octet push_error get_init_slot/;
  4         7  
  4         26  
19              
20             #
21             # this module export config
22             #
23             my @mixin_methods;
24              
25             BEGIN {
26 4     4   1392 @mixin_methods = (
27             qw/
28             cisco_vlan_ids2names
29             cisco_vlan_ids2trunk_ports
30             cisco_trunk_ports2vlan_ids
31             /
32             );
33             }
34              
35 4         31 use Sub::Exporter -setup => {
36             exports => [@mixin_methods],
37             groups => { default => [@mixin_methods], },
38 4     4   17 };
  4         3  
39              
40             #
41             # SNMP oid constants from CISCO-VTP-MIB
42             #
43             use constant {
44 4         1176 VLAN_TBL => '1.3.6.1.4.1.9.9.46.1.3.1',
45             VLAN_STATE => '1.3.6.1.4.1.9.9.46.1.3.1.1.2',
46             VLAN_NAME => '1.3.6.1.4.1.9.9.46.1.3.1.1.4',
47              
48             VLAN_TRUNK_PORT_TBL => '1.3.6.1.4.1.9.9.46.1.6.1',
49             VLAN_TRUNK_PORT_VLANS_ENABLED_1K => '1.3.6.1.4.1.9.9.46.1.6.1.1.4',
50             VLAN_TRUNK_PORT_ENCAPS_OPER_TYPE => '1.3.6.1.4.1.9.9.46.1.6.1.1.16',
51             VLAN_TRUNK_PORT_VLANS_ENABLED_2K => '1.3.6.1.4.1.9.9.46.1.6.1.1.17',
52             VLAN_TRUNK_PORT_VLANS_ENABLED_3K => '1.3.6.1.4.1.9.9.46.1.6.1.1.18',
53             VLAN_TRUNK_PORT_VLANS_ENABLED_4K => '1.3.6.1.4.1.9.9.46.1.6.1.1.19',
54 4     4   1275 };
  4         4  
55              
56             =head1 NAME
57              
58             Net::SNMP::Mixin::CiscoDot1qVlanStaticTrunks - mixin class for static Cisco IEEE-trunks info
59              
60             =head1 VERSION
61              
62             Version 0.03
63              
64             =cut
65              
66             our $VERSION = '0.03';
67              
68             =head1 SYNOPSIS
69              
70             use Net::SNMP;
71             use Net::SNMP::Mixin;
72              
73             # initialize session and mixin library
74             my $session = Net::SNMP->session( -hostname => 'foo.bar.com' );
75             $session->mixer('Net::SNMP::Mixin::CiscoDot1qVlanStaticTrunks');
76             $session->init_mixins;
77             snmp_dispatcher();
78             $session->init_ok();
79             die $session->errors if $session->errors;
80              
81             # show VLAN IDs and corresponding names
82             my $id2name = $session->cisco_vlan_ids2names();
83             foreach my $vlan_id ( keys %{$id2name} ) {
84             printf "Vlan-Id: %4d => Vlan-Name: %s\n", $vlan_id,
85             $id2name->{$vlan_id};
86             }
87              
88             # show ports for vlan_id
89             my $id2port = $session->cisco_vlan_ids2trunk_ports();
90             foreach my $vlan_id ( keys %{$id2port} ) {
91             printf "Vlan-Id: %4d\n", $vlan_id;
92             printf "\tTagged-Ports: %s\n",
93             ( join ',', @{ $id2port->{$vlan_id} } );
94             }
95              
96             # show tagged vlans for port
97             my $port2id = $session->cisco_trunk_ports2vlan_ids();
98             foreach my $port ( keys %{$port2id} ) {
99             printf "Port: %s\n", $port;
100             printf "\tVLANs: %s\n", ( join ',', @{ $port2id->{$port} } );
101             }
102              
103             =head1 DESCRIPTION
104              
105             A mixin class for vlan related infos from the CISCO-VTP-MIB for IEEE-trunks. The mixin-module provides methods for mapping between vlan-ids and vlan-names und relations between trunk-ports and tagged vlan-ids.
106              
107             =head1 MIXIN METHODS
108              
109             =head2 B<< OBJ->cisco_vlan_ids2names() >>
110              
111             Returns a hash reference with statically configured vlan-ids as keys and the corresponing vlan-names as values:
112              
113             {
114             vlan_id => vlan_name,
115             vlan_id => vlan_name,
116             ... ,
117             }
118              
119             =cut
120              
121             sub cisco_vlan_ids2names {
122 1     1 1 20932 my $session = shift;
123             Carp::croak "'$prefix' not initialized,"
124 1 50       73 unless $session->{$prefix}{__initialized};
125              
126 0         0 return $session->{$prefix}{VlanName};
127             }
128              
129             =head2 B<< OBJ->cisco_vlan_ids2trunk_ports() >>
130              
131             Returns a hash reference with the vlan-ids as keys and tagged port-lists as values:
132              
133             {
134             vlan_id => [port_list],
135             vlan_id => [port_list],
136             ... ,
137             }
138            
139             =cut
140              
141             sub cisco_vlan_ids2trunk_ports {
142 1     1 1 312 my $session = shift;
143             Carp::croak "'$prefix' not initialized,"
144 1 50       67 unless $session->{$prefix}{__initialized};
145              
146 0         0 delete $session->{$prefix}{vlans2ports};
147 0         0 _calc_vlans2ports($session);
148              
149 0         0 return $session->{$prefix}{vlans2ports};
150             }
151              
152             =head2 B<< OBJ->cisco_trunk_ports2vlan_ids() >>
153              
154             Returns a hash reference with the ifIndexes as keys and tagged vlan-ids as values:
155              
156             {
157             ifIndex => [vlan_id_list],
158             ifIndex => [vlan_id_list],
159             ... ,
160             }
161            
162            
163             =cut
164              
165             sub cisco_trunk_ports2vlan_ids {
166 1     1 1 279 my $session = shift;
167             Carp::croak "'$prefix' not initialized,"
168 1 50       66 unless $session->{$prefix}{__initialized};
169              
170 0         0 delete $session->{$prefix}{ports2vlans};
171 0         0 _calc_ports2vlans($session);
172              
173 0         0 return $session->{$prefix}{ports2vlans};
174             }
175              
176             =head1 INITIALIZATION
177              
178             =head2 B<< OBJ->_init($reload) >>
179              
180             Fetch basic Cisco-VTP Dot1Q Vlan related snmp values from the host. Don't call this method direct!
181              
182             =cut
183              
184             #
185             # due to the asynchron nature, we don't know what init job is really the last, we decrement
186             # the value after each callback
187             #
188 4     4   18 use constant THIS_INIT_JOBS => 2;
  4         5  
  4         3524  
189              
190             sub _init {
191 4     4   6942 my ( $session, $reload ) = @_;
192              
193 4         10 my $agent = $session->hostname;
194              
195             die "$agent: $prefix already initialized and reload not forced.\n"
196             if exists get_init_slot($session)->{$prefix}
197 4 50 66     22 && get_init_slot($session)->{$prefix} == 0
      33        
198             && not $reload;
199              
200             # set number of async init jobs for proper initialization
201 4         83 get_init_slot($session)->{$prefix} = THIS_INIT_JOBS;
202              
203             # initialize the object for vtp vlan table
204 4         27 _fetch_vtp_vlan_tbl_entries($session);
205 4 100       28 return if $session->error;
206              
207             # initialize the object for vtp vlan trunk port table
208 2         11 _fetch_vtp_vlan_trunk_port_tbl_entries($session);
209 2 50       10 return if $session->error;
210              
211 2         12 return 1;
212             }
213              
214             =head1 PRIVATE METHODS
215              
216             Only for developers or maintainers.
217              
218             =head2 B<< _fetch_vtp_vlan_tbl_entries($session) >>
219              
220             Fetch selected rows from vtpVlanTable during object initialization.
221              
222             =cut
223              
224             sub _fetch_vtp_vlan_tbl_entries {
225 4     4   5 my $session = shift;
226 4         4 my $result;
227              
228             # fetch the vlan state and vlan name from vlanTable
229 4 100       24 $result = $session->get_entries(
    50          
230             -columns => [ VLAN_STATE, VLAN_NAME, ],
231              
232             # define callback if in nonblocking mode
233             $session->nonblocking
234             ? ( -callback => \&_vtp_vlan_tbl_entries_cb )
235             : (),
236              
237             # dangerous for snmp version 2c and 3, big values
238             # snmp-error: Message size exceeded buffer maxMsgSize
239             #
240             $session->version ? ( -maxrepetitions => 3 ) : (),
241             );
242              
243 4 100       2007597 return unless defined $result;
244 2 50       6 return 1 if $session->nonblocking;
245              
246             # call the callback function in blocking mode by hand
247 0         0 _vtp_vlan_tbl_entries_cb($session);
248              
249             }
250              
251             =head2 B<< _vtp_vlan_tbl_entries_cb($session) >>
252              
253             The callback for _fetch_vtp_vlan_tbl_entries.
254              
255             =cut
256              
257             sub _vtp_vlan_tbl_entries_cb {
258 2     2   2003844 my $session = shift;
259 2         6 my $vbl = $session->var_bind_list;
260              
261 2 50       20 unless (defined $vbl) {
262 2 50       8 if (my $err_msg = $session->error) {
263 2         26 push_error($session, "$prefix: $err_msg");
264             };
265 2         53 return;
266             }
267              
268             # mangle result table to get plain
269             # VlanIndex => vlan-state
270             #
271 0         0 $session->{$prefix}{VlanState} = idx2val( $vbl, VLAN_STATE, 1 );
272              
273             # mangle result table to get plain
274             # VlanIndex => vlan-name
275             #
276 0         0 $session->{$prefix}{VlanName} = idx2val( $vbl, VLAN_NAME, 1 );
277              
278 0         0 foreach my $vlan_id ( keys %{ $session->{$prefix}{VlanName} } ) {
  0         0  
279              
280             # delete unless the vlan is operational(1), see CISCO-VTP-MIB
281             delete $session->{$prefix}{VlanName}{$vlan_id}
282 0 0       0 unless $session->{$prefix}{VlanState}{$vlan_id} == 1;
283              
284             }
285              
286             # this init job is finished
287 0         0 get_init_slot($session)->{$prefix}--;
288              
289 0         0 return 1;
290             }
291              
292             =head2 B<< _fetch_vtp_vlan_trunk_port_tbl_entries($session) >>
293              
294             Fetch selected rows from vlanTrunkPortTable during object initialization.
295              
296             =cut
297              
298             sub _fetch_vtp_vlan_trunk_port_tbl_entries {
299 2     2   3 my $session = shift;
300 2         2 my $result;
301              
302             # fetch selected entries from vlanTrunkPortTable
303 2 50       9 $result = $session->get_entries(
    50          
304             -columns => [
305             VLAN_TRUNK_PORT_VLANS_ENABLED_1K, VLAN_TRUNK_PORT_VLANS_ENABLED_2K,
306             VLAN_TRUNK_PORT_VLANS_ENABLED_3K, VLAN_TRUNK_PORT_VLANS_ENABLED_4K,
307             VLAN_TRUNK_PORT_ENCAPS_OPER_TYPE,
308             ],
309              
310             # define callback if in nonblocking mode
311             $session->nonblocking
312             ? ( -callback => \&_vtp_vlan_trunk_port_tbl_entries_cb ) : (),
313              
314             # dangerous for snmp version 2c and 3, big values
315             # snmp-error: Message size exceeded buffer maxMsgSize
316             #
317             $session->version ? ( -maxrepetitions => 3 ) : (),
318             );
319              
320 2 50       1794 return unless defined $result;
321 2 50       4 return 1 if $session->nonblocking;
322              
323             # call the callback function in blocking mode by hand
324 0         0 _vtp_vlan_trunk_port_tbl_entries_cb($session);
325              
326             }
327              
328             =head2 B<< _vtp_vlan_trunk_port_tbl_entries_cb($session) >>
329              
330             The callback for _fetch_vtp_vlan_trunk_port_tbl_entries_cb.
331              
332             =cut
333              
334             sub _vtp_vlan_trunk_port_tbl_entries_cb {
335 2     2   587 my $session = shift;
336 2         6 my $vbl = $session->var_bind_list;
337              
338 2 50       16 unless (defined $vbl) {
339 2 50       6 if (my $err_msg = $session->error) {
340 2         19 push_error($session, "$prefix: $err_msg");
341             };
342 2         77 return;
343             }
344              
345             # mangle result table to get plain
346             # ifIndex => vlans-enabled-bitstring
347             #
348             $session->{$prefix}{VlansEnabled1k} =
349 0           idx2val( $vbl, VLAN_TRUNK_PORT_VLANS_ENABLED_1K, );
350              
351             $session->{$prefix}{VlansEnabled2k} =
352 0           idx2val( $vbl, VLAN_TRUNK_PORT_VLANS_ENABLED_2K, );
353              
354             $session->{$prefix}{VlansEnabled3k} =
355 0           idx2val( $vbl, VLAN_TRUNK_PORT_VLANS_ENABLED_3K, );
356              
357             $session->{$prefix}{VlansEnabled4k} =
358 0           idx2val( $vbl, VLAN_TRUNK_PORT_VLANS_ENABLED_4K, );
359              
360             $session->{$prefix}{VlansEncapsOperType} =
361 0           idx2val( $vbl, VLAN_TRUNK_PORT_ENCAPS_OPER_TYPE, );
362              
363 0           $session->{$prefix}{__initialized}++;
364              
365 0           foreach my $if_idx ( keys %{ $session->{$prefix}{VlansEncapsOperType} } ) {
  0            
366              
367             # delete keys unless the trunk is dot1Q(4), see CISCO-VTP-MIB
368 0 0         if ( $session->{$prefix}{VlansEncapsOperType}{$if_idx} != 4 ) {
369              
370 0           delete $session->{$prefix}{VlansEnabled1k}{$if_idx};
371 0           delete $session->{$prefix}{VlansEnabled2k}{$if_idx};
372 0           delete $session->{$prefix}{VlansEnabled3k}{$if_idx};
373 0           delete $session->{$prefix}{VlansEnabled4k}{$if_idx};
374             }
375              
376             }
377              
378 0           _calc_vlans_enabled($session);
379              
380             # this init job is finished
381 0           get_init_slot($session)->{$prefix}--;
382              
383 0           return 1;
384             }
385              
386             sub _calc_vlans_enabled {
387 0     0     my $session = shift;
388              
389             # prepare fillmask, see below
390 0           my $zeroes_1k = pack( 'B*', 0 x 1024 );
391              
392 0           foreach my $if_idx ( keys %{ $session->{$prefix}{VlansEnabled1k} } ) {
  0            
393              
394             # for all phys interfaces get the tagged vlans
395             # represented in OCTET-STRINGS, maybe already
396             # translated to hex by Net::SNMP
397              
398 0           my $vlans_1k = $session->{$prefix}{VlansEnabled1k}{$if_idx};
399 0           my $vlans_2k = $session->{$prefix}{VlansEnabled2k}{$if_idx};
400 0           my $vlans_3k = $session->{$prefix}{VlansEnabled3k}{$if_idx};
401 0           my $vlans_4k = $session->{$prefix}{VlansEnabled4k}{$if_idx};
402              
403             # It's importend that the returned SNMP OCTET-STRINGs
404             # were untranslated by Net::SNMP!
405             # If already translated, we must convert it back to a
406             # pure OCTET-STRING and fill it with zeroes to a
407             # length of 128-OCTETS = 1024-BITS
408              
409 0           my $vlans_1k_octets = hex2octet($vlans_1k) ^ $zeroes_1k;
410 0           my $vlans_2k_octets = hex2octet($vlans_2k) ^ $zeroes_1k;
411 0           my $vlans_3k_octets = hex2octet($vlans_3k) ^ $zeroes_1k;
412 0           my $vlans_4k_octets = hex2octet($vlans_4k) ^ $zeroes_1k;
413              
414             # unpack it into a bit-string
415              
416 0           my $vlans_1k_bits = unpack( 'B*', $vlans_1k_octets );
417 0           my $vlans_2k_bits = unpack( 'B*', $vlans_2k_octets );
418 0           my $vlans_3k_bits = unpack( 'B*', $vlans_3k_octets );
419 0           my $vlans_4k_bits = unpack( 'B*', $vlans_4k_octets );
420              
421 0           $session->{$prefix}{VlansEnabled}{$if_idx} =
422             $vlans_1k_bits . $vlans_2k_bits . $vlans_3k_bits . $vlans_4k_bits;
423              
424             }
425             }
426              
427             # Process tag information for each phys interface
428             sub _calc_ports2vlans {
429 0     0     my $session = shift;
430              
431             # calculate the tagged vlans for each port
432              
433 0           foreach my $if_idx ( keys %{ $session->{$prefix}{VlansEnabled} } ) {
  0            
434              
435             # preset with empty arrayref
436             $session->{$prefix}{ports2vlans}{$if_idx} = []
437 0 0         unless exists $session->{$prefix}{ports2vlans}{$if_idx};
438              
439 0           foreach my $vlan_id ( keys %{ $session->{$prefix}{VlanName} } ) {
  0            
440              
441 0 0         if (
442             substr( $session->{$prefix}{VlansEnabled}{$if_idx}, $vlan_id, 1 ) eq
443             1 )
444             {
445 0           push @{ $session->{$prefix}{ports2vlans}{$if_idx} }, $vlan_id;
  0            
446             }
447              
448             }
449             }
450             }
451              
452             # Process tag information for each phys interface
453             sub _calc_vlans2ports {
454 0     0     my $session = shift;
455              
456             # calculate the tagged ports for each vlan
457              
458 0           foreach my $if_idx ( keys %{ $session->{$prefix}{VlansEnabled} } ) {
  0            
459              
460 0           foreach my $vlan_id ( keys %{ $session->{$prefix}{VlanName} } ) {
  0            
461              
462             # preset with empty arrayref
463             $session->{$prefix}{vlans2ports}{$vlan_id} = []
464 0 0         unless exists $session->{$prefix}{vlans2ports}{$vlan_id};
465              
466 0 0         if (
467             substr( $session->{$prefix}{VlansEnabled}{$if_idx}, $vlan_id, 1 ) eq
468             1 )
469             {
470 0           push @{ $session->{$prefix}{vlans2ports}{$vlan_id} }, $if_idx;
  0            
471             }
472              
473             }
474             }
475             }
476              
477             =head1 REQUIREMENTS
478              
479             L<< Net::SNMP >>, L<< Net::SNMP::Mixin >>
480              
481             =head1 BUGS, PATCHES & FIXES
482              
483             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.
484              
485             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 .
486              
487             RT: http://rt.cpan.org/Public/Dist/Display.html?Name=Net-SNMP-Mixin-CiscoDot1qVlanStaticTrunks
488              
489             =head1 AUTHOR
490              
491             Karl Gaissmaier
492              
493             =head1 COPYRIGHT & LICENSE
494              
495             Copyright 2011-2016 Karl Gaissmaier, all rights reserved.
496              
497             This program is free software; you can redistribute it and/or modify it
498             under the same terms as Perl itself.
499              
500             =cut
501              
502             unless ( caller() ) {
503             print "$prefix compiles and initializes successful.\n";
504             }
505              
506             1;
507              
508             # vim: sw=2