6 use Data::Dump qw(dump);
8 my $dir="/dev/shm/snmp-topology";
13 @dumps = glob("$dir/*") unless @dumps;
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;
23 foreach my $file ( @dumps ) {
25 open(my $fh, '<', $file);
26 my $sw = $file; $sw =~ s/^.*\///;
29 if ( m/^SNMPv2-MIB::(sysName|sysDescr)\.0 = STRING: (.+)/ ) {
30 $stat->{$sw}->{$1} = $2;
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;
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 $stat->{_sw_port_vlan_count}->{$sw}->{$port}->{''}++;
46 } elsif ( m/^Q-BRIDGE-MIB::dot1qTpFdbPort\[(\d+)\]\[STRING: ([^\]]+)\] = INTEGER: (\d+)/ ) {
47 my ( $vlan, $mac, $port ) = ($1,$2,$3);
48 push @{ $stat->{_sw_mac_port_vlan}->{$sw}->{$mac}->{$port} }, $vlan;
49 $stat->{_sw_port_vlan_count}->{$sw}->{$port}->{$vlan}++;
52 #warn "# $sw ",dump( $stat->{$sw} );
54 #warn "# stat = ",dump($stat);
55 warn "# _sw_port_vlan_count = ",dump($stat->{_sw_port_vlan_count});
57 open(my $fh, '>', '/dev/shm/mac2sw');
58 open(my $fh2, '>', '/dev/shm/mac2sw.snmp');
59 foreach my $mac ( keys %{ $stat->{_mac2sw} } ) {
60 print $fh macfmt($mac), " ", $stat->{_mac2sw}->{$mac}, "\n";
61 print $fh $mac, " ", $stat->{_mac2sw}->{$mac}, "\n";
64 # XXX inject additional mac in filter to include wap devices
65 my $mac_include = '/dev/shm/mac.wap';
66 if ( -e $mac_include ) {
68 open(my $fh, '<', $mac_include);
71 my ($mac,$host) = split(/\s+/,$_,2);
72 $mac =~ s/^0//; $mac =~ s/:0/:/g; # mungle mac to snmp format without leading zeros
73 $stat->{_mac2sw}->{$mac} = $host;
76 # warn "# $mac_include added to _mac2sw = ",dump($stat->{_mac2sw}),$/;
77 warn "# $mac_include added to _mac2sw $count hosts\n";
80 my $s = $stat->{_sw_mac_port_vlan};
81 foreach my $sw ( keys %$s ) {
82 foreach my $mac ( keys %{ $s->{$sw} } ) {
83 if ( my $mac_name = $stat->{_mac2sw}->{ $mac } ) {
84 next if $sw eq $mac_name; # mikrotik seems to see itself
85 foreach my $port ( keys %{ $s->{$sw}->{$mac} } ) {
86 #$stat->{_sw_port_sw}->{$sw}->{$port}->{$mac_name} = $s->{$sw}->{$mac}->{$port};
87 push @{ $stat->{_sw_port_sw}->{$sw}->{$port} }, $mac_name;
88 push @{ $stat->{_sw_sw_port}->{$sw}->{$mac_name} }, $port;
94 warn "# _sw_port_sw = ",dump($stat->{_sw_port_sw});
95 warn "# _sw_sw_port = ",dump($stat->{_sw_sw_port});
98 my $s = $stat->{_sw_port_sw};
102 our @single_sw_port_visible;
103 sub single_sw_port_visible {
104 @single_sw_port_visible = ();
106 foreach my $sw ( keys %$later ) {
107 if ( exists $stat->{_found}->{$sw} ) {
108 my @d = delete $later->{$sw};
109 warn "REMOVED $sw from later it's _found! later was = ",dump( \@d );
112 my @ports = sort keys %{ $later->{$sw} };
113 foreach my $port ( @ports ) {
114 my @visible = uniq_visible( @{ $later->{$sw}->{$port} } );
115 if ( $#visible < 0 ) {
116 warn "REMOVED $sw $port from later it's empty";
117 delete $later->{$sw}->{$port};
120 $s->{$sw}->{$port} = [ @visible ];
121 push @single_sw_port_visible, [ $sw, $port, $visible[0] ] if $#visible == 0; # single
125 my $d_l = dump($later);
126 if ( $d_s ne $d_l ) {
128 warn "# single_sw_port_visible = ",dump( \@single_sw_port_visible );
129 warn "# reduced later = ",dump( $later );
135 my $u; $u->{$_}++ foreach @visible;
136 @visible = sort keys %$u;
141 my @visible = uniq(@_);
142 @visible = grep { ! exists $stat->{_found}->{$_} } @visible;
149 my @visible = uniq_visible(@_);
150 warn "# to_later $sw $port visible = ",dump( \@visible ),"\n";
151 $later->{$sw}->{$port} = [ @visible ];
156 #warn "## s = ",dump($s);
157 foreach my $sw ( sort keys %$s ) {
159 #warn "## $sw s = ",dump($s->{$sw}),$/;
161 my @ports = sort { $a <=> $b } uniq( keys %{ $s->{$sw} } );
163 foreach my $port ( @ports ) {
164 warn "## $sw $port => ",join(' ', @{$s->{$sw}->{$port}}),$/;
167 if ( $#ports == 0 ) {
168 my $port = $ports[0];
169 #print "$sw $port TRUNK\n";
170 push @{$stat->{_trunk}->{$sw}}, $port; # FIXME multiple trunks?
171 #warn "## _trunk = ",dump( $stat->{_trunk} ).$/;
173 my @visible = uniq_visible( @{ $s->{$sw}->{$port} } );
174 to_later( $sw, $port, @visible );
178 foreach my $port ( @ports ) {
179 my @visible = uniq_visible( @{ $s->{$sw}->{$port} } );
180 warn "### $sw $port visible=",dump(\@visible),$/;
182 if ( $#visible == 0 ) {
183 warn "++++ $sw $port $visible[0]\n";
184 #print "$sw $port $visible[0]\n";
185 $stat->{_found}->{$visible[0]} = "$sw $port";
186 single_sw_port_visible();
188 } elsif ( $#visible > 0 ) {
189 to_later( $sw, $port, @visible );
191 warn "#### $sw $port doesn't have anything visible, reseting visibility\n";
192 to_later( $sw, $port, @{ $stat->{_sw_port_sw}->{$sw}->{$port} } );
196 warn "## _found = ",dump( $stat->{_found} ),$/;
199 warn "NEXT later = ",dump($later),$/;
201 single_sw_port_visible();
203 my $d = dump($later);
204 if ( $d eq $last_later ) {
205 warn "FIXME later didn't change single_sw_port_visible = ",dump( \@single_sw_port_visible ),$/;
209 while ( @single_sw_port_visible ) {
210 my $single = shift @single_sw_port_visible;
211 my ( $sw, $port, $visible ) = @$single;
212 warn "XXX $sw | $port | $visible\n";
214 foreach my $port ( keys %{ $later->{$visible} } ) {
215 # check back in original full map to see if it was visible
216 my @visible = @{ $stat->{_sw_port_sw}->{$visible}->{$port} };
217 if ( scalar grep(/$sw/,@visible) ) {
218 warn "PATCH $visible $port -> $sw ONLY";
219 $stat->{_found}->{$sw} = "$visible $port";
221 my @d = delete $later->{$visible}->{$port};
222 warn "DELETED $visible $port ",dump(@d);
225 single_sw_port_visible();
227 warn "FATAL $visible $port NO $sw IN ",dump( \@visible );
231 if ( ! $did_patch ) {
232 # OK, we have link from trunk probably, which port was originally visible on?
234 foreach my $port ( keys %{ $stat->{_sw_port_sw}->{$visible} } ) {
235 my @visible = grep /$sw/, @{ $stat->{_sw_port_sw}->{$visible}->{$port} };
236 if ( scalar @visible ) {
237 warn "PATCH-2 $visible $port -> $sw\n";
238 $stat->{_found}->{$sw} = "$visible $port";
240 my @d = delete $later->{$visible}->{$port};
241 warn "DELETED $visible $port ",dump(@d);
244 single_sw_port_visible();
246 warn "FATAL $visible $port _sw_port_sw doesn't have $sw";
253 warn "## applied $did_patch patches to unblock\n";
255 last if $d eq $last_later;
264 warn "FINAL _found = ",dump( $stat->{_found} ),$/;
265 warn "FINAL _trunk = ",dump( $stat->{_trunk} ),$/;
266 warn "FINAL later = ",dump( $later ),$/;
272 my $ports = $ENV{PORTS} || 1; # FIXME
275 open(my $dot, '>', '/tmp/snmp-topology.dot');
277 my $shape = $ports ? 'record' : 'ellipse';
278 my $rankdir = 'LR'; #$ports ? 'TB' : 'LR';
279 print $dot <<"__DOT__";
281 graph [ rankdir = $rankdir ]
282 node [ shape = $shape ]
283 edge [ color = "gray" ]
286 foreach my $to_sw ( keys %{ $stat->{_found} } ) {
287 my ($from_sw, $from_port) = split(/ /,$stat->{_found}->{$to_sw},2);
288 my @to_port = uniq(@{ $stat->{_trunk}->{$to_sw} });
289 my $to_port = $to_port[0];
290 warn "ERROR: $to_sw has ",dump(\@to_port), " ports instead of just one!" if $#to_port > 0;
292 printf "%s %s -> %s %s\n", $from_sw, $from_port, $to_sw, $to_port;
293 push @edges, [ $from_sw, $to_sw, $from_port, $to_port ];
294 push @{ $node->{$from_sw} }, [ $from_port, $to_sw ];
295 push @{ $node->{$to_sw} }, [ $to_port, $from_sw ]
298 warn "# edges = ",dump(\@edges);
299 warn "# node = ",dump($node);
302 foreach my $n ( keys %$node ) {
305 sort { $a->[0] <=> $b->[0] }
307 #warn "XXX $n ",dump( \@port_sw );
308 print $dot qq!"$n" [ label="!.uc($n).'|' . join('|', map { sprintf "<%d>%2d %s", $_->[0], $_->[0], $_->[1] } @port_sw ) . qq!" ];\n!;
312 foreach my $e ( @edges ) {
314 print $dot sprintf qq{ "%s" -> "%s" [ taillabel="%s" ; headlabel="%s" ]\n}, @$e;
317 print $dot sprintf qq{ "%s":%d -> "%s":%d\n}, $e->[0], $e->[2], $e->[1], $e->[3];