#!/usr/bin/perl -w
#
#* OSPF linkstate database dumper
#
#  Copyright (C) 2007      Noelle Massar
#
#  This program 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 2 of the License, or
#  (at your option) any later version.
#  
#  This program 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 this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

use strict;
use Net::SNMP;
use POSIX qw(strftime);
use Socket qw(inet_ntoa inet_aton inet_ntop inet_pton AF_INET AF_INET6);
use Data::Dumper;
use vars qw($config $debug);

$Data::Dumper::Sortkeys = 1;
$debug = 0;
$| = 1; select(STDERR); $| = 1; select(STDOUT);
require '/etc/ospfmap.conf';

my $oid = {
	ospfv2                      => ".1.3.6.1.2.1.14",
	ospfLsdbAdvertisement       => ".1.3.6.1.2.1.14.4.1.8",
	ospfv3                      => ".1.3.6.1.2.1.191",
	ospfv3AsLsdbAdvertisement   => ".1.3.6.1.2.1.191.1.3.1.7",
	ospfv3AreaLsdbAdvertisement => ".1.3.6.1.2.1.191.1.4.1.8",
	ospfv3LinkLsdbAdvertisement => ".1.3.6.1.2.1.191.1.5.1.9", ## link-local-only info => not used
};

sub newsnmpsession($) {
	my ($config) = @_;
	
	my ($snmp, $error) = Net::SNMP->session(
		-hostname      => $config->{router},
		-domain        => $config->{domain},
		-maxmsgsize    => 65535,
		( (defined($config->{community}) and length($config->{community}) > 0) ? (
			-version   => 1,
			-community => $config->{community},
		) : (
			-version      => 3,
			-username     => $config->{username},
			-authprotocol => $config->{authproto},
			-privprotocol => $config->{privproto},
			-authpassword => $config->{authpw},
			-privpassword => $config->{privpw},
		))
	);
	
	unless (defined($snmp)) {
		die "failed to create SNMP session: $error";
	}
	
	return $snmp;
}

sub snmphexdecode($) {
	my $data = shift;
	$data =~ s/^0x//;
	return pack "H*", $data;
}

sub mergelsdb($$) {
	my ($lsdb, $cfg) = @_;
	my $snmp = newsnmpsession($cfg);
	
	printf "quering %s (v2/v3: %d/%d)\n", $cfg->{router}, $cfg->{v2}, $cfg->{v3} if $debug;
	if ($cfg->{v2}) {
		my $result;
		$result = $snmp->get_entries( -columns => [ $oid->{ospfLsdbAdvertisement} ]);
		foreach my $key (keys %$result) {
			next unless (Net::SNMP::oid_base_match($oid->{ospfLsdbAdvertisement}, $key));
			$key =~ m/^\Q$oid->{ospfLsdbAdvertisement}\E\.([0-9]+\.[0-9]+\.[0-9]+\.[0-9]+)\.([0-9]+)\./;
			my ($area, $lsa_type) = ($1,$2);
			if ($lsa_type == 5) {
				$area = 'External';
				$key =~ s/^\Q$oid->{ospfLsdbAdvertisement}\E\.[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+\./$oid->{ospfLsdbAdvertisement}.0.0.0.0./;
			}
			$lsdb->{v2}{$area}{$key} = snmphexdecode $result->{$key};
		}
	}
	
	if ($cfg->{v3}) {
		my $result;
		$result = $snmp->get_entries( -columns => [ $oid->{ospfv3AsLsdbAdvertisement} ]);
		foreach my $key (keys %$result) {
			next unless (Net::SNMP::oid_base_match($oid->{ospfv3AsLsdbAdvertisement}, $key));
			my $area = 'External';
			$lsdb->{v3}{$area}{$key} = snmphexdecode $result->{$key};
		}
		
		$result = $snmp->get_entries( -columns => [ $oid->{ospfv3AreaLsdbAdvertisement} ]);
		foreach my $key (keys %$result) {
			next unless (Net::SNMP::oid_base_match($oid->{ospfv3AreaLsdbAdvertisement}, $key));
			$key =~ m/^\Q$oid->{ospfv3AreaLsdbAdvertisement}\E\.([0-9]+)\./;
			my $area = $1;
			$lsdb->{v3}{$area}{$key} = snmphexdecode $result->{$key};
		}
	}
	
	## $snmp->close();
	return $lsdb;
}

sub mask2len($) {
	my $mask = shift;
	my $len = 32;
	
	$len-- while ($mask + 2**(32-$len) < 2**32);
	
	return $len;
}
sub addr2ord($) {
	my $ip = shift;
	$ip = '::'.$ip unless $ip =~ m/:/;
	return unpack('H*', inet_pton(AF_INET6, $ip));
}
sub ip2num($) {
	my $ip = shift;
	return unpack('N', inet_aton($ip));
}
sub num2ip($) {
	my $num = shift;
	return inet_ntoa(pack('N', $num));
}

sub addtopo($$$$$$$) {
	my ($g, $type, $rtr_id, $int_id, $neigh_rtr_id, $neigh_int_id, $link_type) = @_;
	
	if ($type eq 'router') {
		$g->{topo}{$type}{addr2ord $rtr_id}{id} = $rtr_id;
		$g->{topo}{$type}{addr2ord $rtr_id}{links}{addr2ord $neigh_rtr_id}{addr2ord $int_id} = {
			type => $link_type,
			rtr_id => $rtr_id,
			int_id => $int_id,
			neigh_rtr_id => $neigh_rtr_id,
			neigh_int_id => $neigh_int_id,
		};
	} elsif ($type eq 'network') {
		$g->{topo}{$type}{addr2ord $rtr_id}{addr2ord $int_id}{rtr} = $rtr_id;
		$g->{topo}{$type}{addr2ord $rtr_id}{addr2ord $int_id}{int} = $int_id;
		$g->{topo}{$type}{addr2ord $rtr_id}{addr2ord $int_id}{links}{addr2ord $neigh_rtr_id} = {
			type => 'transit',
			rtr_id => $rtr_id,
			int_id => $int_id,
			neigh_rtr_id => $neigh_rtr_id,
			neigh_int_id => $neigh_int_id,
		};
	} else {
		die "unkown type <$type>!";
	}
}

sub addprefix($$$$$) {
	my ($g, $prefix, $masklen, $rtr_id, $lsa_type) = @_;
	
	$g->{prefix}{addr2ord $prefix}{$masklen}{prefix} = $prefix;
	$g->{prefix}{addr2ord $prefix}{$masklen}{routers}{addr2ord $rtr_id} = {
		type => $lsa_type,
		rtr_id => $rtr_id,
	};
}

sub parselsa2($$) {
	my ($g, $lsa) = @_;
	
	my ($ls_age, $ls_options, $ls_type, $ls_id, $ls_adv_router, $ls_seq, $ls_cksum, $ls_len, $ls_data)
		= unpack("nCCNNNnna*", $lsa);
	my $router  = inet_ntoa(inet_aton($ls_adv_router));
	printf "type:%s, link:%s, router:%s\n", $ls_type, map {inet_ntoa(inet_aton($_))} $ls_id, $ls_adv_router if $debug;
	if ($ls_type == 1) {
		my ($rl_flags, $rl_links);
		($rl_flags, $rl_links, $ls_data) = unpack("Cxna*", $ls_data);
		printf "routerLink: flags:%04x, #links:%s\n", $rl_flags, $rl_links if $debug;
		while (length($ls_data) > 0) {
			my ($rll_id, $rll_data, $rll_type, $rll_ntos, $rll_metric);
			($rll_id, $rll_data, $rll_type, $rll_ntos, $rll_metric, $ls_data) = unpack("NNCCna*", $ls_data);
			printf "link-id: %s, link-data: %s, type: %d, #TOS: %d, metric: %d\n",
				inet_ntoa(inet_aton($rll_id)), inet_ntoa(inet_aton($rll_data)),
				$rll_type, $rll_ntos, $rll_metric if $debug;
			foreach my $i (0 .. $rll_ntos - 1) {
				(undef, undef, $ls_data) = unpack("Cxna*", $ls_data);
			}
			if ($rll_type == 1) {
				# p2p link to other ospf router
				my $peer    = inet_ntoa(inet_aton($rll_id));
				my $link    = inet_ntoa(inet_aton($rll_data));
				addtopo($g, 'router', $router, $link, $peer, $peer, 'p2p');
			} elsif ($rll_type == 2) {
				# link to transit network
				my $network = inet_ntoa(inet_aton($rll_id));
				my $link    = inet_ntoa(inet_aton($rll_data));
				addtopo($g, 'router', $router, $link, $network, $network, 'transit');
			} elsif ($rll_type == 3) {
				my $network = inet_ntoa(inet_aton($rll_id));
				my $masklen = mask2len($rll_data);
				my $router  = inet_ntoa(inet_aton($ls_adv_router));
				addprefix($g, $network, $masklen, $router, 'stub');
			}
		}
	} elsif ($ls_type == 2) {
		my ($nl_mask, @nl_routers) = unpack("NN*", $ls_data);
		my $network = inet_ntoa(inet_aton($ls_id & $nl_mask));
		my $masklen = mask2len($nl_mask);
		printf "networkLink: netmask:%s\n", inet_ntoa(inet_aton($nl_mask)) if $debug;
		print map {sprintf "router: %s\n", inet_ntoa(inet_aton($_))} @nl_routers if $debug;
		addtopo($g, 'network', $router, $ls_id, inet_ntoa(inet_aton($_)), '0.0.0.0', 'transit') foreach @nl_routers;
		addprefix($g, $network, $masklen, $router, 'transit');
	} elsif ($ls_type == 3 or $ls_type == 4) {
		my ($sa_mask, @sa_metrics) = unpack("NN*", $ls_data);
		my $network = inet_ntoa(inet_aton($ls_id));
		my $masklen = mask2len($sa_mask);
		$masklen = 32 if ($ls_type == 4);
		addprefix($g, $network, $masklen, $router, 'summary');
	} elsif ($ls_type == 5) {
		my ($asl_mask);
		($asl_mask, $ls_data) = unpack("Na*", $ls_data);
		printf "as-external: netmask:%s\n", inet_ntoa(inet_aton($asl_mask)) if $debug;
		my $network = inet_ntoa(inet_aton($ls_id));
		my $masklen = mask2len($asl_mask);
		while (length($ls_data) > 0) {
			my ($asl_flags, $asl_metric, $asl_fwd, $asl_tag);
			($asl_flags, $asl_metric, $asl_fwd, $asl_tag, $ls_data)
				= unpack("Ca3NNa*", $ls_data);
			printf "flags: %02x, metric: %d, forward: %s, tag: %d\n",
				$asl_flags, unpack("N", "\0".$asl_metric),
				inet_ntoa(inet_aton($asl_fwd)), $asl_tag if $debug;
			my $router = inet_ntoa(inet_aton(($asl_fwd != 0) ? $asl_fwd : $ls_adv_router));
			addprefix($g, $network, $masklen, $router, 'external');
		}
	} else {
		printf "data: %s\n", unpack("H*", $ls_data) if $debug;
	}
	print "\n" if $debug;
}

# ($prefix, $pref_len, $pref_opts, $misc, $remainder) = parse_prefix($ls_data);
sub parse_prefix($) {
	my ($ls_data) = @_;
	
	my ($pref_len, $pref_opts, $misc, $rem) = unpack("CCna*", $ls_data);
	my $bytes = int(($pref_len + 31) / 32) * 4;
	
	my $pref_bin;
	($pref_bin, $rem) = unpack("a${bytes}a*", $rem);
	$pref_bin .= "\0" x (16 - $bytes);
	my $prefix = inet_ntop AF_INET6, $pref_bin;
	
	return ($prefix, $pref_len, $pref_opts, $misc, $rem);
}

sub parselsa3($$) {
	my ($g, $lsa) = @_;
	
	my ($ls_age, $ls_type, $ls_id, $ls_adv_router, $ls_seq, $ls_cksum, $ls_len, $ls_data)
		= unpack("nnNNNnna*", $lsa);
	my $ls_scope = $ls_type >> 13;
	$ls_type &= 0x1fff;
	$ls_id = inet_ntoa(inet_aton($ls_id));
	$ls_adv_router = inet_ntoa(inet_aton($ls_adv_router));
	my $router  = $ls_adv_router;
	printf "type:%s (%d), link:%s, router:%s\n", $ls_type, $ls_scope, $ls_id, $ls_adv_router if $debug;
	if ($ls_type == 1) {
		my ($rl_flags, $rl_opt1, $rl_opt2, $rl_opt3);
		($rl_flags, $rl_opt1, $rl_opt2, $rl_opt3, $ls_data) = unpack("CCCCa*", $ls_data);
		printf "routerLSA: flags:%02x options:%02x%02x%02x\n", $rl_flags, $rl_opt1, $rl_opt2, $rl_opt3 if $debug;
		while (length($ls_data) > 0) {
			my ($rll_type, $rll_metric, $rll_ifid, $rll_neigh_ifid, $rll_neigh_rtrid);
			($rll_type, undef, $rll_metric, $rll_ifid, $rll_neigh_ifid, $rll_neigh_rtrid, $ls_data)
				= unpack("CCnNNNa*", $ls_data);
			$rll_ifid        = inet_ntoa(inet_aton($rll_ifid));
			$rll_neigh_ifid  = inet_ntoa(inet_aton($rll_neigh_ifid));
			$rll_neigh_rtrid = inet_ntoa(inet_aton($rll_neigh_rtrid));
			printf "rll_type: %d, metric: %d, if-id: %s, neigh-if-id:%s, neigh-rtr-id: %s\n",
				$rll_type, $rll_metric, $rll_ifid, $rll_neigh_ifid, $rll_neigh_rtrid,
				if $debug;
			my $topo_type = (qw(undef p2p transit reserved virtual))[$rll_type];
			addtopo($g, 'router', $router, $rll_ifid, $rll_neigh_rtrid, $rll_neigh_ifid, $topo_type);
		}
	} elsif ($ls_type == 2) {
		my ($nl_options, @nl_routers) = unpack("NN*", $ls_data);
		printf "networkLSA: options:%08x\n", $nl_options if $debug;
		print map {sprintf "router: %s\n", inet_ntoa(inet_aton($_))} @nl_routers if $debug;
		addtopo($g, 'network', $router, $ls_id, inet_ntoa(inet_aton($_)), '0.0.0.0', 'transit') foreach @nl_routers;
	} elsif ($ls_type == 3) { # Inter-Area-Prefix-LSA Format
		my ($iapl_metric);
		($iapl_metric, $ls_data) = unpack("Na*", $ls_data);
		my ($iapl_prefix, $iapl_pref_len, $iapl_pref_opts, $iapl_null, $rem) = parse_prefix($ls_data);
		printf "inter-area-prefix: %s/%d metric:%d pref_opts:%02x\n", $iapl_prefix, $iapl_pref_len, $iapl_metric, $iapl_pref_opts if $debug;
		printf "Tail-data: %s\n", unpack("H*", $rem) if $debug and length($rem) > 0;
		addprefix($g, $iapl_prefix, $iapl_pref_len, $router, 'summary');
	} elsif ($ls_type == 4) { # Inter-Area-Router-LSA Format
		my ($iarl_options, $iarl_metric, $iarl_dst_rtrid) = unpack("NNN", $ls_data);
		$iarl_dst_rtrid = inet_ntoa(inet_aton($iarl_dst_rtrid));
		printf "inter-area-router: options:%06x metric:%06x rtr-id: %s\n", $iarl_options, $iarl_metric, $iarl_dst_rtrid if $debug;
		# ignore topology-data for AS boundary routers in other areas
	} elsif ($ls_type == 5 or $ls_type == 7) { # AS-External-LSA
		my ($ext_flags, $ext_metric, $ext_fwd_addr, $ext_tag, $ext_reflink);
		my ($ext_prefix, $ext_pref_len, $ext_pref_opts, $ext_reflink_type);
		my $router = $ls_adv_router;
		($ext_metric, $ls_data) = unpack("Na*", $ls_data);
		$ext_flags = $ext_metric >> 24;
		$ext_metric &= 0xffffff;
		($ext_prefix, $ext_pref_len, $ext_pref_opts, $ext_reflink_type, $ls_data) = parse_prefix($ls_data);
		if ($ext_flags & 0x4) {
			# E: External-Metric: 0: same-scale as AS, 1: higher than any local metric
		}
		if ($ext_flags & 0x2) {
			# F: Forward address present
			($ext_fwd_addr, $ls_data) = unpack("a16a*", $ls_data);
			$ext_fwd_addr = inet_ntop AF_INET6, $ext_fwd_addr;
			$router = $ext_fwd_addr;
		} else {
			$ext_fwd_addr = "(none)";
		}
		if ($ext_flags & 0x1) {
			# T: Route Tag present
			($ext_tag, $ls_data) = unpack("Na*", $ls_data);
		} else {
			$ext_tag = "(none)";
		}
		if ($ext_reflink_type != 0) {
			($ext_reflink, $ls_data) = unpack("Na*", $ls_data);
		} else {
			$ext_reflink = "(none)";
		}
		printf "AS-External: flags:%1x metric:%d pref_opts:%02x\n%s/%s\n fwd_addr:%s\n tag:>%s<\n reflink-type:%04x reflink:%s\n",
			$ext_flags, $ext_metric, $ext_pref_opts,
			$ext_prefix, $ext_pref_len,
			$ext_fwd_addr, $ext_tag,
			$ext_reflink_type, $ext_reflink,
			if $debug;
		printf "Tail-data: %s\n", unpack("H*", $ls_data) if $debug and length($ls_data) > 0;
		addprefix($g, $ext_prefix, $ext_pref_len, $router, 'external');
	} elsif ($ls_type == 6) { # MOSPF LSA (Deprecated)
		printf "data: %s\n", unpack("H*", $ls_data) if $debug;
	} elsif ($ls_type == 8) { # Link LSA
		my ($link_rtr_prio, $link_options, $link_lladdr, $link_prefix_cnt);
		($link_options, $link_lladdr, $link_prefix_cnt, $ls_data) = unpack("Na16Na*", $ls_data);
		$link_rtr_prio = $link_options >> 24;
		$link_options &= 0xffffff;
		$link_lladdr = inet_ntop AF_INET6, $link_lladdr;
		printf "LinkLSA: rtr-prio:%d options:%06x prefixes:%d\n%s\n",
			$link_rtr_prio, $link_options, $link_prefix_cnt,
			$link_lladdr,
			if $debug;
		while (length($ls_data) > 0) {
			my ($link_prefix, $link_pref_len, $link_pref_opts, $link_null, $rem) = parse_prefix($ls_data);
			$ls_data = $rem;
			printf "%s/%s options:%02x\n",
				$link_prefix, $link_pref_len, $link_pref_opts,
				if $debug;
			# store nothing. only link-local relevance
		}
	} elsif ($ls_type == 9) { # Intra-Area-Prefix LSA
		my ($iapref_cnt, $iapref_ls_type, $iapref_ls_id, $iapref_adv_rtr);
		($iapref_cnt, $iapref_ls_type, $iapref_ls_id, $iapref_adv_rtr, $ls_data) = unpack("nnNNa*", $ls_data);
		$iapref_ls_id   = inet_ntoa(inet_aton($iapref_ls_id));
		$iapref_adv_rtr = inet_ntoa(inet_aton($iapref_adv_rtr));
		printf "PrefixLSA: cnt:%d, ls-type:%04x ls-id:%s, adv-rtr:%s\n",
			$iapref_cnt, $iapref_ls_type,
			$iapref_ls_id,
			$iapref_adv_rtr,
			if $debug;
		while (length($ls_data) > 0) {
			my ($iapref_prefix, $iapref_pref_len, $iapref_pref_opts, $iapref_null, $rem) = parse_prefix($ls_data);
			$ls_data = $rem;
			printf "%s/%s options:%02x\n",
				$iapref_prefix, $iapref_pref_len, $iapref_pref_opts,
				if $debug;
			addprefix($g, $iapref_prefix, $iapref_pref_len, $iapref_adv_rtr, 'stub');
		}
	} else {
		printf "data: %s\n", unpack("H*", $ls_data) if $debug;
	}
	print "\n" if $debug;
}

sub parselsa($$$) {
	my ($g, $vers, $lsa) = @_;
	
	if ($vers eq 'v2') {
		parselsa2($g, $lsa);
	} elsif ($vers eq 'v3') {
		parselsa3($g, $lsa);
	} else {
		die "nope";
	}
}

sub outputarea($$$) {
	my ($g, $vers, $area) = @_;
	
	my $title = sprintf "OSPF%s Area %s", $vers, $area;
	printf "%s\n%s\n\n", $title, "="x(length $title);
	
	my $topo = $g->{topo};
	my $pref = $g->{prefix};
	
	foreach my $num_rtr (sort {$a cmp $b} keys %{$topo->{router}}) {
		my $router = $topo->{router}{$num_rtr};
		printf "%s:\n", lookup($router->{id});
		foreach my $num_neigh_rtr (sort {$a cmp $b} keys %{$router->{links}}) {
			foreach my $num_int_id (sort {$a cmp $b} keys %{$router->{links}{$num_neigh_rtr}}) {
				my $link = $router->{links}{$num_neigh_rtr}{$num_int_id};
				printf "  %-22s -> %s\n",
					lookup($link->{int_id}),
					($link->{type} ne "transit" ? lookup($link->{neigh_rtr_id}) : "Transit-Network//".lookup($link->{neigh_rtr_id})."//".$link->{neigh_int_id});
			}
		}
		print "\n";
	}
	
	foreach my $num_rtr_id (sort {$a cmp $b} keys %{$topo->{network}}) {
		foreach my $num_int_id (sort {$a cmp $b} keys %{$topo->{network}{$num_rtr_id}}) {
			my $net = $topo->{network}{$num_rtr_id}{$num_int_id};
			printf "Transit-Network//%s//%s:\n", lookup($net->{rtr}), lookup($net->{int});
			foreach my $num_neigh (sort {$a cmp $b} keys %{$net->{links}}) {
				my $link = $net->{links}{$num_neigh};
				printf "  %s\n", lookup($link->{neigh_rtr_id});
			}
			print "\n";
		}
	}
	
	foreach my $num_pref (sort {$a cmp $b} keys %{$pref}) {
		foreach my $masklen (sort {$a <=> $b} keys %{$pref->{$num_pref}}) {
			my $prefix = $pref->{$num_pref}{$masklen};
			my $network = $prefix->{prefix};
			my $networklen = "$network/$masklen";
			my $netname = lookup_prefix($network, $masklen);
			printf(
				( ($vers eq 'v3') ? "%-43s   %s  %s\n" : "%-20s   %s  %s\n" ),
				$networklen,
				join(" ",
					map {
						sprintf "[%-10s %s]",
							$prefix->{routers}{$_}{type}.": ",
							lookup($prefix->{routers}{$_}{rtr_id})
					}
					sort {$a cmp $b}
					keys %{$prefix->{routers}}
				),
				"($netname)"
			);
		}
	}
	
	
	print "\n\n\n";
}

## global storage: complete binary link-state-database, output graph data
my $lsdb = {};
my $g = {};

## collect data
foreach my $cfg (@{$config}) {
	mergelsdb($lsdb, $cfg);
}

## parse LSAs
foreach my $vers (sort {$a cmp $b} keys %{$lsdb}) {
	foreach my $area (sort {$a cmp $b} keys %{$lsdb->{$vers}}) {
		foreach my $lsa (sort {$a cmp $b} values %{$lsdb->{$vers}{$area}}) {
			$g->{$vers}{$area} = {} unless exists $g->{$vers}{$area};
			parselsa($g->{$vers}{$area}, $vers, $lsa);
		}
	}
}

## output
foreach my $vers (sort {$a cmp $b} keys %{$g}) {
	foreach my $area (sort {$a cmp $b} keys %{$g->{$vers}}) {
		outputarea($g->{$vers}{$area}, $vers, $area);
	}
}

exit 0;
