dd1e6d8947d921af00c6fe00a6ccfe920ac24cb6
[dell-switch] / snmp-topology.pl
1 #!/usr/bin/perl
2 use warnings;
3 use strict;
4 use autodie;
5
6 use Data::Dump qw(dump);
7
8 my $dir="/dev/shm/snmp-topology";
9
10 my $stat;
11
12 my @dumps = @ARGV;
13 @dumps = glob("$dir/*") unless @dumps;
14
15 sub macfmt {
16         my $mac = shift;
17         $mac =~ s/^([0-9a-f]):/0$1:/i;
18         while ( $mac =~ s/:([0-9a-f]):/:0$1:/ig ) {};
19         $mac =~ s/:([0-9a-f])$/:0$1/i;
20         return $mac;
21 }
22
23 foreach my $file ( @dumps ) {
24
25         open(my $fh, '<', $file);
26         my $sw = $file; $sw =~ s/^.*\///;
27         while(<$fh>) {
28                 chomp;
29                 if ( m/^SNMPv2-MIB::(sysName|sysDescr)\.0 = STRING: (.+)/ ) {
30                         $stat->{$sw}->{$1} = $2;
31 =for xxx
32                 } elsif ( m/^(IF-MIB)::(ifPhysAddress)\.0 = (\w+): (.+)/ ) {
33                         my ($name,$oid,$type,$value) = ($1,$2,$3,$4);
34                         #$value =~ s/\(\d+\)$// if $type eq 'INTEGER';
35                         $stat->{$sw}->{$name}->{$oid} = $value;
36 =cut
37                 } elsif ( m/^(IF-MIB)::(ifPhysAddress)\[(\d+)\] = (\w+): (.+)/ ) {
38                         my ($name,$oid,$i,$type,$value) = ($1,$2,$3,$4,$5);
39                         #warn "# $sw ",dump($name,$oid,$i,$type,$value),$/;
40                         #$stat->{$sw}->{$name}->{$oid}->[$i] = $value;
41                         $stat->{_mac2sw}->{$value} = $sw;
42                 } elsif ( m/^BRIDGE-MIB::dot1dTpFdbPort\[STRING: ([^\]]+)\] = INTEGER: (\d+)/ ) {
43                         my ( $mac, $port ) = ($1,$2);
44                         push @{ $stat->{_sw_mac_port_vlan}->{$sw}->{$mac}->{$port} }, '';
45                 } elsif ( m/^Q-BRIDGE-MIB::dot1qTpFdbPort\[(\d+)\]\[STRING: ([^\]]+)\] = INTEGER: (\d+)/ ) {
46                         my ( $vlan, $mac, $port ) = ($1,$2,$3);
47                         push @{ $stat->{_sw_mac_port_vlan}->{$sw}->{$mac}->{$port} }, $vlan;
48                 }
49         }
50         #warn "# $sw ",dump( $stat->{$sw} );
51 }
52 #warn "# stat = ",dump($stat);
53
54 open(my $fh, '>', '/dev/shm/mac2sw');
55 open(my $fh2, '>', '/dev/shm/mac2sw.snmp');
56 foreach my $mac ( keys %{ $stat->{_mac2sw} } ) {
57         print $fh macfmt($mac), " ", $stat->{_mac2sw}->{$mac}, "\n";
58         print $fh $mac, " ", $stat->{_mac2sw}->{$mac}, "\n";
59 };
60
61 # XXX inject additional mac in filter to include wap devices
62 my $mac_include = '/dev/shm/mac.wap';
63 if ( -e $mac_include ) {
64         my $count = 0;
65         open(my $fh, '<', $mac_include);
66         while(<$fh>) {
67                 chomp;
68                 my ($mac,$host) = split(/\s+/,$_,2);
69                 $mac =~ s/^0//; $mac =~ s/:0/:/g; # mungle mac to snmp format without leading zeros
70                 $stat->{_mac2sw}->{$mac} = $host;
71                 $count++;
72         }
73 #       warn "# $mac_include added to _mac2sw = ",dump($stat->{_mac2sw}),$/;
74         warn "# $mac_include added to _mac2sw $count hosts\n";
75 }
76
77 my $s = $stat->{_sw_mac_port_vlan};
78 foreach my $sw ( keys %$s ) {
79         foreach my $mac ( keys %{ $s->{$sw} } ) {
80                 if ( my $mac_name = $stat->{_mac2sw}->{ $mac } ) {
81                         next if $sw eq $mac_name; # mikrotik seems to see itself
82                         foreach my $port ( keys %{ $s->{$sw}->{$mac} } ) {
83                                 #$stat->{_sw_port_sw}->{$sw}->{$port}->{$mac_name} = $s->{$sw}->{$mac}->{$port};
84                                 push @{ $stat->{_sw_port_sw}->{$sw}->{$port} }, $mac_name;
85                                 push @{ $stat->{_sw_sw_port}->{$sw}->{$mac_name} }, $port;
86                         }
87                 }
88         }
89 }
90
91 warn "# _sw_port_sw = ",dump($stat->{_sw_port_sw});
92 warn "# _sw_sw_port = ",dump($stat->{_sw_sw_port});
93
94
95 my $s = $stat->{_sw_port_sw};
96 our $later;
97 my $last_later;
98
99 our @single_sw_port_visible;
100 sub single_sw_port_visible {
101         @single_sw_port_visible = ();
102         my $s = {};
103         foreach my $sw ( keys %$later ) {
104                 if ( exists $stat->{_found}->{$sw} ) {
105                         my @d = delete $later->{$sw};
106                         warn "REMOVED $sw from later it's _found! later was = ",dump( \@d );
107                         next;
108                 }
109                 my @ports = sort keys %{ $later->{$sw} };
110                 foreach my $port ( @ports ) {
111                         my @visible = uniq_visible( @{ $later->{$sw}->{$port} } );
112                         if ( $#visible < 0 ) {
113                                 warn "REMOVED $sw $port from later it's empty";
114                                 delete $later->{$sw}->{$port};
115                                 next;
116                         }
117                         $s->{$sw}->{$port} = [ @visible ];
118                         push @single_sw_port_visible, [ $sw, $port, $visible[0] ] if $#visible == 0; # single
119                 }
120         }
121         my $d_s = dump($s);
122         my $d_l = dump($later);
123         if ( $d_s ne $d_l ) {
124                 $later = $s;
125                 warn "# single_sw_port_visible = ",dump( \@single_sw_port_visible );
126                 warn "# reduced later = ",dump( $later );
127         }
128 }
129
130 sub uniq {
131         my @visible = @_;
132         my $u; $u->{$_}++ foreach @visible;
133         @visible = sort keys %$u;
134         return @visible;
135 }
136
137 sub uniq_visible {
138         my @visible = uniq(@_);
139         @visible = grep { ! exists $stat->{_found}->{$_} } @visible;
140         return @visible;
141 }
142
143 sub to_later {
144         my $sw = shift;
145         my $port = shift;
146         my @visible = uniq_visible(@_);
147         warn "# to_later $sw $port visible = ",dump( \@visible ),"\n";
148         $later->{$sw}->{$port} = [ @visible ];
149         return @visible;
150 }
151
152 while ( ref $s ) {
153 #warn "## s = ",dump($s);
154 foreach my $sw ( sort keys %$s ) {
155
156         #warn "## $sw s = ",dump($s->{$sw}),$/;
157
158         my @ports = sort { $a <=> $b } uniq( keys %{ $s->{$sw} } );
159
160         foreach my $port ( @ports ) {
161                 warn "## $sw $port => ",join(' ', @{$s->{$sw}->{$port}}),$/;
162         }
163
164         if ( $#ports == 0 ) {
165                 my $port = $ports[0];
166                 #print "$sw $port TRUNK\n";
167                 push @{$stat->{_trunk}->{$sw}}, $port; # FIXME multiple trunks?
168                 #warn "## _trunk = ",dump( $stat->{_trunk} ).$/;
169
170                 my @visible = uniq_visible( @{ $s->{$sw}->{$port} } );
171                 to_later( $sw, $port, @visible );
172                 next;
173         }
174
175         foreach my $port ( @ports ) {
176                 my @visible = uniq_visible( @{ $s->{$sw}->{$port} } );
177                 warn "### $sw $port visible=",dump(\@visible),$/;
178
179                 if ( $#visible == 0 ) {
180                         warn "++++ $sw $port $visible[0]\n";
181                         #print "$sw $port $visible[0]\n";
182                         $stat->{_found}->{$visible[0]} = "$sw $port";
183                         single_sw_port_visible();
184
185                 } elsif ( $#visible > 0 ) {
186                         to_later( $sw, $port, @visible );
187                 } else {
188                         warn "#### $sw $port doesn't have anything visible, reseting visibility\n";
189                         to_later( $sw, $port, @{ $stat->{_sw_port_sw}->{$sw}->{$port} } );
190                 }
191                         
192         }
193         warn "## _found = ",dump( $stat->{_found} ),$/;
194 }
195
196 warn "NEXT later = ",dump($later),$/;
197
198 single_sw_port_visible();
199
200 my $d = dump($later);
201 if ( $d eq $last_later ) {
202         warn "FIXME later didn't change single_sw_port_visible = ",dump( \@single_sw_port_visible ),$/;
203
204         my $did_patch = 0;
205
206         while ( @single_sw_port_visible ) {
207                 my $single = shift @single_sw_port_visible;
208                 my ( $sw, $port, $visible ) = @$single;
209                 warn "XXX $sw | $port | $visible\n";
210
211                 foreach my $port ( keys %{ $later->{$visible} } ) {
212                         # check back in original full map to see if it was visible
213                         my @visible = @{ $stat->{_sw_port_sw}->{$visible}->{$port} };
214                         if ( scalar grep(/$sw/,@visible) ) {
215                                 warn "PATCH $visible $port -> $sw ONLY";
216                                 $stat->{_found}->{$sw} = "$visible $port";
217
218                                 my @d = delete $later->{$visible}->{$port};
219                                 warn "DELETED $visible $port ",dump(@d);
220                                 $did_patch++;
221
222                                 single_sw_port_visible();
223                         } else {
224                                 warn "FATAL $visible $port NO $sw IN ",dump( \@visible );
225                         }
226                 }
227
228                 if ( ! $did_patch ) {
229                         # OK, we have link from trunk probably, which port was originally visible on?
230
231                         foreach my $port ( keys %{ $stat->{_sw_port_sw}->{$visible} } ) {
232                                 my @visible = grep /$sw/, @{ $stat->{_sw_port_sw}->{$visible}->{$port} };
233                                 if  ( scalar @visible ) {
234                                         warn "PATCH-2 $visible $port -> $sw\n";
235                                         $stat->{_found}->{$sw} = "$visible $port";
236
237                                         my @d = delete $later->{$visible}->{$port};
238                                         warn "DELETED $visible $port ",dump(@d);
239                                         $did_patch++;
240
241                                         single_sw_port_visible();
242                                 } else {
243                                         warn "FATAL $visible $port _sw_port_sw doesn't have $sw";
244                                 }
245                         }
246                 }
247
248         }
249
250         warn "## applied $did_patch patches to unblock\n";
251
252         last if $d eq $last_later;
253         
254 }
255 $last_later = $d;
256
257 $later = undef;
258
259 } # while
260
261 warn "FINAL _found = ",dump( $stat->{_found} ),$/;
262 warn "FINAL _trunk = ",dump( $stat->{_trunk} ),$/;
263 warn "FINAL later  = ",dump( $later ),$/;
264
265
266 my $node;
267 my @edges;
268
269 my $ports = $ENV{PORTS} || 1; # FIXME
270
271
272 open(my $dot, '>', '/tmp/snmp-topology.dot');
273
274 my $shape = $ports ? 'record' : 'ellipse';
275 my $rankdir = 'LR'; #$ports ? 'TB' : 'LR';
276 print $dot <<"__DOT__";
277 digraph topology {
278 graph [ rankdir = $rankdir ]
279 node [ shape = $shape ]
280 edge [ color = "gray" ]
281 __DOT__
282
283 foreach my $to_sw ( keys %{ $stat->{_found} } ) {
284         my ($from_sw, $from_port) = split(/ /,$stat->{_found}->{$to_sw},2);
285         my @to_port = uniq(@{ $stat->{_trunk}->{$to_sw} });
286         my $to_port = $to_port[0];
287         warn "ERROR: $to_sw has ",dump(\@to_port), " ports instead of just one!" if $#to_port > 0;
288         printf "%s %s -> %s %s\n", $from_sw, $from_port, $to_sw, $to_port;
289         push @edges, [ $from_sw, $to_sw, $from_port, $to_port ];
290         push @{ $node->{$from_sw} }, [ $from_port, $to_sw ];
291         push @{ $node->{$to_sw} }, [ $to_port, $from_sw ]
292 }
293
294 warn "# edges = ",dump(\@edges);
295 warn "# node = ",dump($node);
296
297 if ( $ports ) {
298         foreach my $n ( keys %$node ) {
299                 no warnings;
300                 my @port_sw =
301                         sort { $a->[0] <=> $b->[0] }
302                         @{ $node->{$n} };
303 #warn "XXX $n ",dump( \@port_sw );
304                 print $dot qq!"$n" [ label="!.uc($n).'|' . join('|', map { sprintf "<%d>%2d %s", $_->[0], $_->[0], $_->[1] } @port_sw ) . qq!" ];\n!;
305         }
306 }
307
308 foreach my $e ( @edges ) {
309         if (! $ports) {
310                 print $dot sprintf qq{ "%s" -> "%s" [ taillabel="%s" ; headlabel="%s" ]\n}, @$e;
311         } else {
312                 no warnings;
313                 print $dot sprintf qq{ "%s":%d -> "%s":%d\n}, $e->[0], $e->[2], $e->[1], $e->[3];
314         }
315 }
316
317 print $dot "}\n";
318