751dc1d706b96d061166f9c26d2c0b081fd8fa87
[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/snmpbulkwalk";
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 foreach my $mac ( keys %{ $stat->{_mac2sw} } ) {
56         print $fh macfmt($mac), " ", $stat->{_mac2sw}->{$mac}, "\n";
57 };
58
59 # XXX inject additional mac in filter to include wap devices
60 my $mac_include = '/dev/shm/mac.wap';
61 if ( -e $mac_include ) {
62         open(my $fh, '<', $mac_include);
63         while(<$fh>) {
64                 chomp;
65                 my ($mac,$host) = split(/\s+/,$_,2);
66                 $mac =~ s/^0//; $mac =~ s/:0/:/g; # mungle mac to snmp format without leading zeros
67                 $stat->{_mac2sw}->{$mac} = $host;
68         }
69         warn "# $mac_include added to _mac2sw = ",dump($stat->{_mac2sw}),$/;
70 }
71
72 my $s = $stat->{_sw_mac_port_vlan};
73 foreach my $sw ( keys %$s ) {
74         foreach my $mac ( keys %{ $s->{$sw} } ) {
75                 if ( my $mac_name = $stat->{_mac2sw}->{ $mac } ) {
76                         next if $sw eq $mac_name; # mikrotik seems to see itself
77                         foreach my $port ( keys %{ $s->{$sw}->{$mac} } ) {
78                                 #$stat->{_sw_port_sw}->{$sw}->{$port}->{$mac_name} = $s->{$sw}->{$mac}->{$port};
79                                 push @{ $stat->{_sw_port_sw}->{$sw}->{$port} }, $mac_name;
80                         }
81                 }
82         }
83 }
84
85 warn "# _sw_port_sw = ",dump($stat->{_sw_port_sw});
86
87
88 my $s = $stat->{_sw_port_sw};
89 our $later;
90 my $last_later;
91
92 sub uniq {
93         my @visible = @_;
94         my $u; $u->{$_}++ foreach @visible;
95         @visible = sort keys %$u;
96         return @visible;
97 }
98
99 sub uniq_visible {
100         my @visible = uniq(@_);
101         @visible = grep { ! exists $stat->{_found}->{$_} } @visible;
102         return @visible;
103 }
104
105 sub to_later {
106         my $sw = shift;
107         my $port = shift;
108         my @visible = uniq_visible(@_);
109         warn "# to_later $sw $port visible = ", $#visible + 1, "\n";
110         $later->{$sw}->{$port} = [ @visible ];
111         return @visible;
112 }
113
114 while ( ref $s ) {
115 #warn "## s = ",dump($s);
116 foreach my $sw ( sort keys %$s ) {
117
118         #warn "## $sw s = ",dump($s->{$sw}),$/;
119
120         my @ports = sort { $a <=> $b } uniq( keys %{ $s->{$sw} } );
121
122         foreach my $port ( @ports ) {
123                 warn "## $sw $port => ",join(' ', @{$s->{$sw}->{$port}}),$/;
124         }
125
126         if ( $#ports == 0 ) {
127                 my $port = $ports[0];
128                 #print "$sw $port TRUNK\n";
129                 push @{$stat->{_trunk}->{$sw}}, $port; # FIXME multiple trunks?
130                 #warn "## _trunk = ",dump( $stat->{_trunk} ).$/;
131
132                 my @visible = uniq_visible( @{ $s->{$sw}->{$port} } );
133                 if ( $#visible > 0 ) {
134                         to_later( $sw, $port, @visible );
135                         next;
136                 }
137         }
138
139         foreach my $port ( @ports ) {
140                 my @visible = uniq_visible( @{ $s->{$sw}->{$port} } );
141                 warn "### $sw $port visible=",dump(\@visible),$/;
142
143                 if ( $#visible == 0 ) {
144                         warn "++++ $sw $port $visible[0]\n";
145                         #print "$sw $port $visible[0]\n";
146                         $stat->{_found}->{$visible[0]} = "$sw $port";
147                 
148                 } elsif ( @visible ) {
149                         to_later( $sw, $port, @visible );
150                 } else {
151                         warn "#### $sw $port doesn't have anything visible\n";
152                 }
153                         
154         }
155         warn "## _found = ",dump( $stat->{_found} ),$/;
156 }
157
158 warn "NEXT later = ",dump($later),$/;
159 #$s = $later;
160
161 # remove all found
162 $s = {};
163 foreach my $sw ( keys %$later ) {
164         foreach my $port ( keys %{ $later->{$sw} } ) {
165                 $s->{$sw}->{$port} = [ uniq_visible( @{ $later->{$sw}->{$port} } ) ];
166         }
167 }
168
169 my $d = dump($s);
170 if ( $d eq $last_later ) {
171         warn "FIXME later didn't change, last\n";
172         last;
173 }
174 $last_later = $d;
175
176 $later = undef;
177
178 } # while
179
180 warn "FINAL _found = ",dump( $stat->{_found} ),$/;
181 warn "FINAL _trunk = ",dump( $stat->{_trunk} ),$/;
182
183
184 my $node;
185 my @edges;
186
187 my $ports = $ENV{PORTS} || 1; # FIXME
188
189
190 open(my $dot, '>', '/tmp/snmp-topology.dot');
191
192 my $shape = $ports ? 'record' : 'ellipse';
193 my $rankdir = 'LR'; #$ports ? 'TB' : 'LR';
194 print $dot <<"__DOT__";
195 digraph topology {
196 graph [ rankdir = $rankdir ]
197 node [ shape = $shape ]
198 edge [ color = "gray" ]
199 __DOT__
200
201 foreach my $to_sw ( keys %{ $stat->{_found} } ) {
202         my ($from_sw, $from_port) = split(/ /,$stat->{_found}->{$to_sw},2);
203         my @to_port = uniq(@{ $stat->{_trunk}->{$to_sw} });
204         my $to_port = $to_port[0];
205         warn "ERROR: $to_sw has ",dump(\@to_port), " ports instead of just one!" if $#to_port > 0;
206         printf "%s %s -> %s %s\n", $from_sw, $from_port, $to_sw, $to_port;
207         push @edges, [ $from_sw, $to_sw, $from_port, $to_port ];
208         push @{ $node->{$from_sw} }, [ $from_port, $to_sw ];
209         push @{ $node->{$to_sw} }, [ $to_port, $from_sw ]
210 }
211
212 warn "# edges = ",dump(\@edges);
213 warn "# node = ",dump($node);
214
215 if ( $ports ) {
216         foreach my $n ( keys %$node ) {
217                 my @port_sw =
218                         sort { $a->[0] <=> $b->[0] }
219                         @{ $node->{$n} };
220 #warn "XXX $n ",dump( \@port_sw );
221                 print $dot qq!"$n" [ label="!.uc($n).'|' . join('|', map { sprintf "<%d>%2d %s", $_->[0], $_->[0], $_->[1] } @port_sw ) . qq!" ];\n!;
222         }
223 }
224
225 foreach my $e ( @edges ) {
226         if (! $ports) {
227                 print $dot sprintf qq{ "%s" -> "%s" [ taillabel="%s" ; headlabel="%s" ]\n}, @$e;
228         } else {
229                 print $dot sprintf qq{ "%s":%d -> "%s":%d\n}, $e->[0], $e->[2], $e->[1], $e->[3];
230         }
231 }
232
233 print $dot "}\n";
234