vtysh_bgp_to_dot

#!/usr/bin/perl
#
# vtysh_bgp_to_dot - print a network graph of routing information
# 
# Copyright (C) 2011, 2014, 2015, 2018 Christian Garbs <mitch@cgarbs.de>
# Licensed under GNU GPL 3 or later.
# 
# bgpgraph is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# bgpgraph is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with bgpgraph.  If not, see <http://www.gnu.org/licenses/>.
#
use strict;
use warnings;

### global configuration
my $ALLOW_SELF = 1;  # set to 0 to remove self-references, eg. in lines like AS1 AS2 AS2 AS2 AS3 skip the 'AS2 AS2' pairs

### subroutines

sub show_help()
# print help text
{
    print<<"EOF";
usage:  vtysh_bgp_to_dot [local AS]
        vtysh_bgp_to_dot [-h|--help]

vtysh_bgp_to_dot expects the output of `vtysh -c 'show ip bgp'` on stdin.
vtysh_bgp_to_dot writes a dot(1) file describing the graph to stdout.
When no local AS is given, the local node will not be included in the graph.

example:
   vtysh -c 'show ip bgp' | vtysh_bgp_to_dot 12207 | dot -Tpng > graph.png
EOF
    ;
}


### parse commandline arguments

if (@ARGV > 1)
{
    show_help();
    exit 1;
}

if (@ARGV == 1 and $ARGV[0] =~ /^(-h|--help)$/)
{
    show_help;
    exit 0;
}

if (@ARGV == 1 and $ARGV[0] =~ /^-/)
{
    show_help;
    exit 1;
}

my $my_as = $ARGV[0];


### read configuration

my %config;
if ( -r 'info.conf')
{
    open my $config, '<', 'info.conf' or die "can't open `info.conf': $!";
    while (my $line = <$config>)
    {
	$line =~ s/^\s+//;
	$line =~ s/\s+$//;
	next if $line eq '';
	next if $line =~ /^#/;
	my ($as, $name, $type) = split /\s+/, $line;
	$config{$as}->{NAME} = $name if defined $name;
	$config{$as}->{TYPE} = $type if defined $type;
    }
    close $config or die "can't close `info.conf': $!";
}


### parse vtysh output

my @lines;

my $startcol = 0;
while (my $line = <STDIN>)
{
    if ($line =~ /^((\*>?)\s.*) i/)
    {
	next if length($1) < $startcol;
	
	# check whether that line is active
	my $active = $2 eq '*>';
	
	my $as = substr($1, $startcol);
	# skip initial whitespace
	$as =~ s/^\s+//;
	
	push @lines, { ACTIVE => $active, PATH => $as };
    }
    elsif ($line =~ /Path/)
    {
	# figure out on which column the paths begin
	$startcol = index $line, 'Path';
    }
}


### prepend local AS if present

if (defined $my_as)
{
    foreach my $line (@lines) {
	$line->{PATH} = "$my_as " . $line->{PATH};
    }
}


### parse paths

my %peering;
my %as;
my %active;

foreach my $line (@lines)
{
    my $last_as = undef;
    my @path = split (/ /, $line->{PATH});
    foreach my $as (@path)
    {
	$as{$as}++;
	
	if (defined $last_as)
	{
	    # undirected peerings are sorted to skip duplicates
	    my ($from, $to) = sort ($as, $last_as);
	    
	    # skip self-references (eg. prepended paths to downgrade a route)
	    if ($ALLOW_SELF or $from ne $to)
	    {
		$peering{"$from:$to"}++;
	    }

	    # active peerings are directed, they can exist only once
	    $active{"${last_as}:${as}"}++ if $line->{ACTIVE};
	}
	    
	$last_as = $as;
    }
}


### print graph

print "strict digraph {\n";

foreach my $as (sort keys %as)
{
    my ($node_id, $label, $fillcolor);

    $node_id = $as;
    $label = "$as\n$config{$as}->{NAME}" if exists $config{$as}->{NAME};
    $fillcolor = 'lightgrey' if exists $config{$as}->{TYPE};
    $fillcolor = 'lightblue' if defined $my_as and $as eq $my_as;

    my $attr_list = '';

    if (defined $label) {
	 $attr_list .= sprintf ' label="%s"', $label;
    }

    if (defined $fillcolor) {
	$attr_list .= sprintf ' style="filled" fillcolor="%s"', $fillcolor;
    }

    $attr_list = ' [' . $attr_list . ' ]' if $attr_list;

    printf "  %s%s;\n", $node_id, $attr_list;
}

print "\n";

foreach my $peering (sort keys %peering)
{
    die unless $peering =~ /(.*):(.*)/;
    if (exists $active{$peering})
    {
	printf "  %s -> %s;\n", $1, $2;
    }
    elsif (exists $active{"$2:$1"})
    {
	printf "  %s -> %s;\n", $2, $1;
    }
    else
    {
	printf "  %s -> %s [ dir=\"none\" weight=0 color=\"0, 0, 0.5\" ];\n", $1, $2;
    }
}

print "}\n";