#!/usr/local/bin/perl -w
###
### Listen for SNMP traps, decode and print them
### Simple example for a trap listener program.
###
### To make this useful, you should probably add some filtering
### capabilities and trap-specific pretty-printing.
###
package main;

use strict;

use SNMP_Session "1.14";	# requires receive_trap_1()
use SNMP_util;
use BER;
use Socket;
use Socket6;

### Forward declarations
sub print_trap ($$);
sub usage ($ );
sub print_ip_addr ($ );
sub pretty_addr ($ );
sub hostname ($ );
sub fromOID ($ );
sub fromOID_aux ($$);
sub really_pretty_oid ($ );

my $port = 162;

my $print_community = 0;
my $print_port = 0;
my $print_hostname = 1;
my $ipv4only = 0;

register_pretty_printer {BER::object_id_tag(), \&really_pretty_oid};

while (defined $ARGV[0] && $ARGV[0] =~ /^-/) {
    if ($ARGV[0] eq '-p') {
	shift @ARGV;
	usage (1) unless defined $ARGV[0];
	$port = $ARGV[0];
	usage (1) unless $port > 0 && $port < 65536;
    } elsif ($ARGV[0] eq '-h') {
	usage (0);
	exit 0;
    } elsif ($ARGV[0] eq '-4') {
	shift @ARGV;
	$ipv4only = 1;
    } else {
	usage (1);
    }
}
snmpLoad_OID_Cache($SNMP_util::CacheFile);
die unless SNMP_util::toOID("mib-2") eq SNMP_util::toOID ("1.3.6.1.2.1");
%SNMP_util::revOIDS = reverse %SNMP_util::OIDS unless %SNMP_util::revOIDS;
my $session = SNMPv2c_Session->open_trap_session ($port, $ipv4only)
    or die "couldn't open trap session";
$SNMP_Session::suppress_warnings = 1; # We print all error messages ourselves.
my ($trap, $sender);

while (($trap, $sender) = $session->receive_trap_1 ()) {
    my $now_string = localtime time;
    print "$now_string ";
    print pretty_addr ($sender);
    print "\n";
    print_trap ($session, $trap);
}
1;

sub print_trap ($$) {
    my ($this, $trap) = @_;
    my ($encoded_pair, $oid, $value);
    my ($community, $ent, $agent, $gen, $spec, $dt, $bindings)
	= $this->decode_trap_request ($trap);
    if (defined $community) {
	my ($binding, $prefix);
	if (defined $community) {
	    print "    community: ".$community."\n"
		if $print_community;
	    if (defined $ent) {
		## SNMPv1 Trap
		print "   enterprise: ".BER::pretty_oid ($ent)."\n";
		print "   agent addr: ".inet_ntoa ($agent)."\n";
		print "   generic ID: $gen\n";
		print "  specific ID: $spec\n";
		print "       uptime: ".BER::pretty_uptime_value ($dt)."\n";
	    }
	    ## Otherwise we have an SNMPv1 Trap which basically just
	    ## consists of bindings.
	    ##
	    $prefix = "     bindings: ";
	    while ($bindings) {
		($binding,$bindings) = decode_sequence ($bindings);
		($oid,$value) = decode_by_template ($binding, "%O%@");
		$oid = fromOID (BER::pretty_oid ($oid));
		print $prefix.$oid.": ".pretty_print ($value)."\n";
		$prefix = "               ";
	    }
	} else {
	    warn "decoding trap request failed:\n".$SNMP_Session::errmsg;
	}
    } else {
	warn "receiving trap request failed:\n".$SNMP_Session::errmsg;
    }
}

sub usage ($) {
    warn <<EOM;
Usage: $0 [-p port]
       $0 -h

  -h       Print this usage message and exit.
  -p port  Listen for traps on a specific UDP port.  The default is 162.
  -4       Listen for IPv4 packets only.

EOM
    exit (1) if $_[0];
}

sub make_sockaddr ($$) {
    my ($af, $addr) = @_;
    if ($af == AF_INET) {
	return pack_sockaddr_in 0, $addr;
    } elsif ($af == AF_INET6) {
	return pack_sockaddr_in6 0, $addr;
    } else {
	die "Unsupported address family $af";
    }
}

### pretty_addr SOCKADDR
###
### Return a pretty representation of the given socket address.
### If $print_hostname is non-zero, try to resolve the host part
### of the address to a hostname.  The numeric form of the address
### will be included in any case.  If $print_port is non-zero, the
### port is also included in numerical form.
###
### For example, assuming that addresses 192.0.2.1 and 2001:db8::1
### both map to hostname "foo.example", this function would return the
### following results:
###
### pretty_addr (sockaddr_in (1234, inet_aton ("192.0.2.1")))
###                                 if $print_hostname $print_port
### => '192.0.2.1'                           ==0          ==0
### => 'foo.example [192.0.2.1]'             !=0          ==0
### => '192.0.2.1.1234'                      ==0          !=0
### => 'foo.example [192.0.2.1].1234'        !=0          !=0
###
### pretty_addr (sockaddr_in6 (1234, inet_pton (AF_INET6, "2001:db8::1")))
###                                 if $print_hostname $print_port
### => '2001:db8::1'                         ==0          ==0
### => 'foo.example [2001:db8::1]'           !=0          ==0
### => '2001:db8::1.1234'                    ==0          !=0
### => 'foo.example [2001:db8::1].1234'      !=0          !=0
###
### Handling of IPv4-mapped IPv6 addresses
###
### When receiving an IPv4-mapped IPv6 address, this routine will
### print the embedded IPv4 address in the numeric part.  The mapping
### to a hostname should also work, because that's what getnameinfo()
### is specified to do.  Therefore,
###
### pretty_addr (sockaddr_in6 (1234, inet_pton (AF_INET6, "::ffff:192.0.2.1")))
### should always return the same string as
### pretty_addr (sockaddr_in (1234, inet_aton ("192.0.2.1")))
###
sub pretty_addr ($ ) {
    my ($sockaddr) = @_;
    my ($hostname, $port, $result);
    ($result, $port) = getnameinfo ($sockaddr, NI_NUMERICHOST | NI_NUMERICSERV);
    $result = $1 if $result =~ /^::ffff:(\d+\.\d+\.\d+\.\d+)$/i;
    ($hostname) = getnameinfo ($sockaddr) if $print_hostname;
    $result = $hostname." [".$result."]" if $hostname;
    $result .= '.'.$port if $print_port;
    return $result;
}

sub fromOID ($ ) {
    my ($oid) = @_;
    return fromOID_aux ($oid, '') || $oid;
}

sub fromOID_aux ($$) {
    my ($pref, $suf) = @_;
    while (1) {
	return $SNMP_util::revOIDS{$pref}.$suf if exists $SNMP_util::revOIDS{$pref};
	return undef unless $pref =~ /(.*)(\.[0-9]+)$/;
	$pref = $1; $suf = $2.$suf;
    }
}

sub really_pretty_oid ($) {
    fromOID (BER::pretty_oid ($_[0]));
}
