#!/usr/bin/perl -w

use strict;

use SNMP_Session;
use BER;
use Socket;

sub print_mroutes ($$);
sub pretty_next_hop_state ($);

my $version = '2c';
my $port = 161;
my $debug = 0;

while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
    if ($ARGV[0] =~ /^-v/) {
	if ($ARGV[0] eq '-v') {
	    shift @ARGV;
	    usage (1) unless defined $ARGV[0];
	} else {
	    $ARGV[0] = substr($ARGV[0], 2);
	}
	if ($ARGV[0] eq '1') {
	    $version = '1';
	} elsif ($ARGV[0] eq '2c') {
	    $version = '2c';
	} else {
	    usage (1);
	}
    } elsif ($ARGV[0] =~ /^-p/) {
	if ($ARGV[0] eq '-p') {
	    shift @ARGV;
	    usage (1) unless defined $ARGV[0];
	} else {
	    $ARGV[0] = substr($ARGV[0], 2);
	}
	if ($ARGV[0] =~ /^[0-9]+$/) {
	    $port = $ARGV[0];
	} else {
	    usage (1);
	}
    } elsif ($ARGV[0] eq '-h') {
	usage (0);
	exit 0;
    } else {
	usage (1);
    }
    shift @ARGV;
}
my $host = shift @ARGV || usage (1);
my $community = shift @ARGV || "public";
my ($group_name, $group, $group_quad);
my ($source_name, $source, $source_quad);
$group_name = shift @ARGV || die ("no source/group given");
if ($#ARGV >= $[) {
    $source_name = $group_name;
    $group_name = shift @ARGV;
}
usage (1) if $#ARGV >= $[;
if (! defined ($group = inet_aton ($group_name))) {
    die ("Cannot parse group $group_name");
}
$group_quad = inet_ntoa ($group);
if (! defined ($source = inet_aton ($source_name))) {
    die ("Cannot parse source $source_name");
}
$source_quad = inet_ntoa ($source);

my $session =
    ($version eq '1' ? SNMPv1_Session->open ($host, $community, $port)
     : $version eq '2c' ? SNMPv2c_Session->open ($host, $community, $port)
     : die "Unknown SNMP version $version")
  || die "Opening SNMP_Session";
print_mroutes ($session, $group);
1;

sub print_mroutes ($$) {
    my $ipMRouteUpstreamNeighbor = [1,3,6,1,3,60,1,1,2,1,4];
    my $ipMRouteInIfIndex = [1,3,6,1,3,60,1,1,2,1,5];
    my $ipMRouteUpTime = [1,3,6,1,3,60,1,1,2,1,6];
    my $ipMRouteExpiryTime = [1,3,6,1,3,60,1,1,2,1,7];
    my $ipMRoutePkts = [1,3,6,1,3,60,1,1,2,1,8];
    my $ipMRouteDifferentInIfPackets = [1,3,6,1,3,60,1,1,2,1,9];
    my $ipMRouteOctets = [1,3,6,1,3,60,1,1,2,1,10];
    my $ipMRouteProtocol = [1,3,6,1,3,60,1,1,2,1,11];

    my $ipMRouteNextHopState = [1,3,6,1,3,60,1,1,3,1,6];
    my $ipMRouteNextHopProtocol = [1,3,6,1,3,60,1,1,3,1,10];
    my ($session, $group) = @_;
    my @group_subids = split (/\./, inet_ntoa ($group), 4);
    my @oids = ([@{$ipMRouteUpstreamNeighbor},@group_subids],
		[@{$ipMRouteProtocol},@group_subids]);
    $session->map_table
	(\@oids,
	 sub () {
	     my ($index, $nbr, $protocol) = @_;
	     my ($source, $mask) = 
		 ($index =~ m/^(\d+\.\d+\.\d+\.\d+)\.(\d+\.\d+\.\d+\.\d+)$/);
	     map { $_ = pretty_print $_ if defined $_ }
	     ($nbr, $protocol);
	     print STDOUT ("$source ($mask) ",inet_ntoa ($group),": ",
			   pretty_next_hop_protocol ($protocol),
			   "\n");
	 });

    @oids = ([@{$ipMRouteNextHopState},@group_subids],
		[@{$ipMRouteNextHopProtocol},@group_subids]);
    $session->map_table
	(\@oids,
	 sub () {
	     my ($index, $state, $protocol) = @_;
	     my ($source, $mask, $if_index, $nexthop) = 
		 ($index =~ m/^(\d+\.\d+\.\d+\.\d+)\.(\d+\.\d+\.\d+\.\d+)\.(\d+)\.(\d+\.\d+\.\d+\.\d+)$/);
	     map { $_ = pretty_print $_ if defined $_ }
	     ($state, $protocol);
	     print STDOUT ("$source ($mask) ",inet_ntoa ($group),": ",
			   pretty_next_hop_state ($state)," ",
			   pretty_next_hop_protocol ($protocol),
			   "\n");
	 });
}

sub pretty_next_hop_state ($ ) {
    return "forwarding(1)" if $_[0] eq 1;
    return "pruned(2)" if $_[0] eq 2;
    return "???($_[0])";
}

sub pretty_next_hop_protocol ($ ) {
    return "other(1)" if $_[0] eq 1;
    return "local(2)" if $_[0] eq 2;
    return "netmgmt(3)" if $_[0] eq 3;
    return "dvmrp(4)" if $_[0] eq 4;
    return "mospf(5)" if $_[0] eq 5;
    return "pimSparseDense(6)" if $_[0] eq 6;
    return "cbt(7)" if $_[0] eq 7;
    return "pimSparseMode(8)" if $_[0] eq 8;
    return "pimDenseMode(9)" if $_[0] eq 9;
    return "igmpOnly(10)" if $_[0] eq 10;
    return "???($_[0])";
}
