# -*- perl -*-

# Copyright (c) 2002 by Jeff Weisberg
# Author: Jeff Weisberg <argus @ tcp4me.com>
# Date: 2002-Apr-03 18:59 (EST)
# Function: testing of SNMP things - support for both v1 and v3
#
# $Id: SNMP.pm,v 1.35 2005/11/25 17:11:40 jaw Exp $

package SNMP;
@ISA = qw(UDP);

use Argus::BER;
use Argus::Encode;
my( $HAVE_MD5, $HAVE_SHA1, $HAVE_HMAC, $HAVE_DES);

BEGIN {
    # these are used for SNMPv3 auth + priv
    eval{ require Digest::MD5;  $HAVE_MD5  = 1; };
    eval{ require Digest::SHA1; $HAVE_SHA1 = 1; };
    eval{ require Digest::HMAC; $HAVE_HMAC = 1; };
    eval{ require Crypt::DES;   $HAVE_DES  = 1; };

    $HAVE_MD5 = $HAVE_SHA1 = undef unless $HAVE_HMAC;
}

use strict qw(refs vars);
use vars qw(@ISA $doc);

my $snmpid = rand( 1000000 );
my $SNMP3_TIME_WINDOW = 150;		# rfc 3414 2.2.3
sub get_request  { 0 | context_flag };

# let user specify some common OIDs by name
my %oids =
(
 AdminStatus   => '.1.3.6.1.2.1.2.2.1.7',
 OperStatus    => '.1.3.6.1.2.1.2.2.1.8',
 ifInErrors    => '.1.3.6.1.2.1.2.2.1.14',
 ifOutErrors   => '.1.3.6.1.2.1.2.2.1.20',
 ifInOctets    => '.1.3.6.1.2.1.2.2.1.10',
 ifOutOctets   => '.1.3.6.1.2.1.2.2.1.16',
 BGPPeerStatus => '.1.3.6.1.2.1.15.3.1.2',
 ciscoEnvMonTemperatureStatusValue => '.1.3.6.1.4.1.9.9.13.1.3.1.3',
 # yeah, it is much shorter to type 'ciscoEnvMonTemperatureStatusValue' ...

 );

# user-friendly names for some common errors
my %errstat =
(
 1 => 'too big',
 2 => 'invalid OID',
 3 => 'bad value',
 4 => 'read only',
 5 => 'general error',
 6 => 'access denied',

 13 => 'resource unavailable',
 16 => 'authorization error',
 
 );

# convert common v3 errors to user-friendly messages
my %v3errs =
(
 '1.3.6.1.6.3.15.1.1.3.0'  => 'wrong username?',
 '1.3.6.1.6.3.15.1.1.4.0'  => 'wrong engine-id?',
 '1.3.6.1.6.3.15.1.1.5.0'  => 'wrong password?',
 '1.3.6.1.6.3.15.1.1.6.0'  => 'wrong privacy password?',
 );

$doc = {
    package => __PACKAGE__,
    file    => __FILE__,
    isa     => [qw(UDP Service MonEl BaseIO)],
    methods => {},
    html   => 'services',
    fields => {
      snmp::community => {
	  descr => 'SNMP (v1, v2c) community',
	  attrs => ['config', 'inherit'],
      },
      snmp::oid => {
	  descr => 'SNMP OID to query',
	  attrs => ['config'],
      },
      snmp::snmpcalc => {
	  descr => 'deprecated, use calc instead',
	  attrs => ['config'],
	  versn => '3.2',
      },

      # v3 params
      snmp::snmpversion => {
	  # normally this should be specified as Service UDP/SNMPv3
	  descr => 'snmp version, 1, 2c, or 3',
	  attrs => ['config' ],
	  versn => '3.3',
      },
      snmp::snmpuser => {
	  descr => 'SNMPv3 username',
	  attrs => ['config', 'inherit'],
	  versn => '3.3',
      },
      snmp::snmppass => {
	  descr => 'SNMPv3 authentication password',
	  attrs => ['config', 'inherit'],
	  versn => '3.3',
      },
      snmp::snmpauth => {
	  descr => 'SNMPv3 authentication protocol',
	  attrs => ['config', 'inherit'],
	  vals  => ['MD5', 'SHA1', 'none'],
	  versn => '3.3',
      },
      snmp::snmppriv => {
	  descr => 'SNMPv3 privacy (aka encryption) protocol',
	  attrs => ['config', 'inherit'],
	  vals  => ['DES', 'none'],
	  versn => '3.3',
      },
      snmp::snmpprivpass => {
	  descr => 'SNMPv3 privacy password',
	  attrs => ['config', 'inherit'],
	  versn => '3.3',
      },
      snmp::contextname => {
	  descr => 'SNMPv3 context name',
	  attrs => ['config', 'inherit'],
	  versn => '3.3',
      },
      snmp::contextengine => {
	  descr => 'SNMPv3 context engine id',
	  attrs => ['config', 'inherit'],
	  versn => '3.3',
      },
      snmp::authengine => {
	  descr => 'SNMPv3 authentication engine id',
	  attrs => ['config', 'inherit'],
	  versn => '3.3',
      },

      snmp::engineboot => {
	  # RFC 3414  2.2.2
	  descr => 'SNMPv3 remote system snmpEngineBoots value',
      },
      snmp::enginetime => {
	  # RFC 3414  2.2.2
	  descr => 'SNMPv3 remote system snmpEngineTime value',
      },
      snmp::authkey => {
	  # RFC 3414 2.6, etal.
	  descr => 'SNMPv3 localized authentication key',
      },
      snmp::privkey => {
	  # RFC 3414 2.6, etal.
	  descr => 'SNMPv3 localized privacy key',
      },
      snmp::builttime => {
	  # we intentionally abuse the RFC 3414 2.2.3 Time Window
	  # by replaying messages during the allowed window
	  descr => 'time snmp request packet was built',
      },
      snmp::discovered => {
	  # if we auto-discovered engine-id, we permit re-discovery
	  # if engine-id is user-specified, we do not
	  descr => 'engine-id was auto-discovered',
      },
	
    },
};

sub probe {
    my $name = shift;

    return ( $name =~ /^UDP\/SNMP/ ) ? [ 8, \&config ] : undef;
}

sub config {
    my $me = shift;
    my $cf = shift;

    bless $me;
    $me->init_from_config( $doc, 'snmp' );

    if( $me->{name} =~ /SNMP\w*\/(.*)/i ){
	$me->{snmp}{oid} ||= $1;
    }

    if( $me->{name} =~ /SNMPv?3/ ){
	$me->{snmp}{snmpversion} ||= 3;
    }
    if( $me->{name} =~ /SNMPv?2c/ ){
	$me->{snmp}{snmpversion} ||= '2c';
    }
    
    $me->{snmp}{snmpversion} ||= 1;
    
    if( $me->{snmp}{snmpversion} == 3 ){
	$me->{snmp}{snmpauth} ||= $me->{snmp}{snmppass}     ? 'MD5' : 'none';
	$me->{snmp}{snmppriv} ||= $me->{snmp}{snmpprivpass} ? 'DES' : 'none';
	$me->{snmp}{snmppriv} = 'none' if $me->{snmp}{snmpauth} eq 'none';

	if( $me->{snmp}{snmpauth} !~ /^(MD5|SHA1|none)$/ ){
	    $cf->warning("SNMPv3 unknown authentication protocol");
	    $me->{snmp}{snmpauth} = 'none';
	}
	
	if( $me->{snmp}{snmpauth} eq 'SHA1' && ! $HAVE_SHA1 ){
	    $me->{snmp}{snmpauth} = $HAVE_MD5 ? 'MD5' : 'none';
	    $cf->warning( "SNMPv3 SHA1 not available" );
	}
	
	if( $me->{snmp}{snmpauth} eq 'MD5' && ! $HAVE_MD5 ){
	    $cf->warning( "SNMPv3 MD5 not available" );
	    $me->{snmp}{snmpauth} = 'none';
	}
	
	if( $me->{snmp}{snmppriv} !~ /^(DES|none)$/ ){
	    $cf->warning( "SNMPv3 unknown privacy protocol" );
	    $me->{snmp}{snmppriv} = 'none';
	}

	if( $me->{snmp}{snmppriv} eq 'DES' && ! $HAVE_DES ){
	    $cf->warning( "SNMPv3 DES not available" );
	    $me->{snmp}{snmppriv} = 'none';
	}
	
	if( $me->{snmp}{contextengine} =~ /^(0x)?[0-9a-f]+$/i ){
	    $me->{snmp}{contextengine} =~ s/^0x//i;
	    $me->{snmp}{contextengine} =~ s/(..)/chr(hex($1))/ge;
	}
	if( $me->{snmp}{authengine} =~ /^(0x)?[0-9a-f]+$/i ){
	    $me->{snmp}{authengine} =~ s/^0x//i;
	    $me->{snmp}{authengine} =~ s/(..)/chr(hex($1))/ge;
	}
    }

    $cf->warning( 'snmpcalc was renamed calc' )
	if $me->{snmp}{snmpcalc};
    
    $me->{label_right_maybe} ||= $me->{snmp}{oid};
    $me->{udp}{port} ||= 161;
    $me->SUPER::config($cf);
    $me->snmp_init($cf);
    
    $me->{uname} = "SNMP_$me->{snmp}{oid}_$me->{ip}{hostname}";
    $me;
}

sub snmp_init {
    my $me = shift;
    my $cf = shift;
    my( $req, $oid );

    $oid = $me->{snmp}{oid};

    return $cf->error( "invalid OID ($oid)" )
	unless $oid;

    $oid =~ s/([^\d\.]+)/$oids{$1}||'UNKNOWN'/ge;
    
    return $cf->error( "invalid OID ($oid)" )
	unless( $oid =~ /^[\d\.]+$/ );

    $me->{snmp}{oid} = $oid;

    $me->build_req();
    $me;
}

sub start {
    my $me = shift;

    if( $me->{snmp}{snmpversion} == 3 &&
	# RFC 3414 2.2.3
	($me->{snmp}{snmpauth} ne 'none') &&
	($^T - $me->{snmp}{builttime}) >= $SNMP3_TIME_WINDOW ){

	$me->{snmp}{enginetime} += $^T - $me->{snmp}{builttime};
	$me->build_req();
    }
    $me->SUPER::start();
}

sub build_req {
    my $me = shift;
    my( $req );
    
    $me->{snmp}{builttime} = $^T;
    my $snmppdu = encode_tagged_sequence(
			get_request,
			encode_int( $snmpid++ ),
			encode_int_0,
			encode_int_0,
			encode_sequence(
			    encode_sequence(
			       encode_oid(split /\./, $me->{snmp}{oid}),
			       encode_null())));
    
    if( $me->{snmp}{snmpversion} == 1 ){
	# Why lifts she up her arms in sequence thus?
	#   -- Shakespeare, Titus Andronicus
	# SNMP v1 packet
	$req = encode_sequence(
		    encode_int_0,	# 0 = snmpv1
		    encode_string( $me->{snmp}{community} ),
		    $snmppdu );
	
    }elsif( $me->{snmp}{snmpversion} eq '2c' ){
	$req = encode_sequence(
		    encode_int_1,	# 1 = snmpv2c
		    encode_string( $me->{snmp}{community} ),
		    $snmppdu );
	
    }else{
	# SNMP v3 packet - has a slightly different format from v1
	my( $flags, $secparams, $auth, $priv, $scopedpdu );

	$scopedpdu = encode_sequence(
			    encode_string( $me->{snmp}{contextengine} ),
		            encode_string( $me->{snmp}{contextname}   ),
			    $snmppdu );
	
	if( $me->{snmp}{snmpauth} eq 'none' || !$me->{snmp}{authengine} ){
	    $flags = "\4";     # noAuth, noPriv, Report
	    $auth = $priv = '';
	}else{
	    $auth = "\0" x 12;
	    if( $me->{snmp}{snmppriv} eq 'none' ){
		$flags = "\5"; # Auth, noPriv, Report
		$priv = '';
	    }else{
		$flags = "\7"; # Auth, Priv, Report
		$priv = pack('c*', map{ rand(0xFF) } (1..8) );
	    }
	}
	
	$secparams = encode_sequence( encode_string($me->{snmp}{authengine}),
				      encode_int(   $me->{snmp}{engineboot}||0),
				      encode_int(   $me->{snmp}{enginetime}||0),
				      encode_string($me->{snmp}{snmpuser}),
				      encode_string($auth),
				      encode_string($priv));
	if( $priv ){
	    # priv => encrypt scoped pdu
	    unless( $me->{snmp}{privkey} ){
		$me->{snmp}{privkey} = $me->localized_key( $me->{snmp}{snmpprivpass} );
	    }

	    $scopedpdu = encode_string($me->encrypt( $priv, $scopedpdu ));
	}
	
	$req = encode_sequence( encode_int(3),	 # 3 = snmpv3
				encode_sequence( # msg global header
				       encode_int( $snmpid++ ),
				       encode_int( 1234 ),	# PTOOMA
				       encode_string( $flags ),
				       encode_int( 3 )),	# 3 = USM
				encode_string( $secparams ),
				$scopedpdu
				);

	if( $auth ){
	    # calculate auth, and insert it back in
	    my $offset = length($req) - ( length($scopedpdu) +
		length($auth) + length(encode_string($priv)) );

	    $auth = $me->calc_auth( $req );
	    
	    substr( $req, $offset, length($auth) ) = $auth;
	}
	
    }
    
    $me->{udp}{send} = $req;
    $me;
}

# RFC 3414 A.2
# the RFC poorly specifies the algorithm; actually it doesn't specify the algorithm,
# it only provides a snippet of sample code
sub localized_key {
    my $me = shift;
    my $pass = shift;
    
    my $mac;
    if( $me->{snmp}{snmpauth} eq 'MD5' ){
	$mac = Digest::MD5->new;
    }elsif( $me->{snmp}{snmpauth} eq 'SHA1' ){
	$mac = Digest::SHA1->new();
    }else{
	return;
    }

    my( $pp, $i, $m, $d );
    $m = length($pass);
    $pp = $pass x (2 + 1024/$m);

    for( $i=0; $i<1024*1024; $i+=1024 ){
	$mac->add( substr($pp, $i % $m, 1024) );
    }

    $d = $mac->digest();
    
    $mac->add($d . $me->{snmp}{authengine} . $d)->digest();
}

sub calc_auth {
    my $me  = shift;
    my $req = shift;
    my( $hmac, $auth );
    
    unless( $me->{snmp}{authkey} ){
	$me->{snmp}{authkey} = $me->localized_key( $me->{snmp}{snmppass} );
    }
    
    if( $me->{snmp}{snmpauth} eq 'MD5' ){
	$hmac = Digest::HMAC->new($me->{snmp}{authkey}, 'Digest::MD5');
    }
    if( $me->{snmp}{snmpauth} eq 'SHA1' ){
        $hmac = Digest::HMAC->new($me->{snmp}{authkey}, 'Digest::SHA1');
    }
    
    $hmac->add($req);
    $auth = substr($hmac->digest(), 0, 12);
    $auth;
}

sub encrypt {
    my $me   = shift;
    my $salt = shift;
    my $pdu  = shift;

    # RFC 3414 8.1.1.2
    my $pk  = $me->{snmp}{privkey};
    my $piv = substr( $pk, 8, 8 );
    my $iv  = $piv ^ $salt;

    my $pad = 8 - length($pdu) % 8;
    $pdu .= chr($pad) x $pad;

    my $c;
    if( $me->{snmp}{snmppriv} eq 'DES' ){
	$c = Crypt::DES->new( substr($pk,0,8) );
    }else{
	return;
    }

    my $d;
    while( $pdu ){
	my $x =  substr($pdu, 0, 8, '');	
	$iv = $c->encrypt( $x ^ $iv );
	$d .= $iv;
    }
    
    $d;
}

sub decrypt {
    my $me   = shift;
    my $salt = shift;
    my $pdu  = shift;
    
    my $pk  = $me->{snmp}{privkey};
    my $piv = substr( $pk, 8, 8 );
    my $iv  = $piv ^ $salt;
    
    my $c;
    if( $me->{snmp}{snmppriv} eq 'DES' ){
	$c = Crypt::DES->new( substr($pk,0,8) );
    }else{
	return;
    }

    my $d;
    while( $pdu ){
	my $x =  substr($pdu, 0, 8, '');
	$d .= $c->decrypt( $x ) ^ $iv;
	$iv = $x;
    }

    $d;
}

sub readable {
    my $me = shift;
    my( $fh, $i, $l, $value );

    $fh = $me->{fd};
    $i = recv($fh, $l, 8192, 0);
    return $me->isdown( "SNMP recv failed: $!", 'recv failed' )
	unless defined($i);

    $me->debug( "SNMP recv data" );
    $me->{udp}{rbuffer} = $l;		# for debugging

    $Argus::BER::errmsg = '';

    if( $me->{snmp}{snmpversion} == 1 || $me->{snmp}{snmpversion} eq '2c' ){
	my( $ver, $comm, $reqid, $errst, $errin, $oid, $val ) =
	    decode_by_template($l, "%{%i%s%*{%i%i%i%{%{%O%@", 162 );
	if( $Argus::BER::errmsg ){
	    return $me->isdown( "BER error: $Argus::BER::errmsg", 'BER error' );
	}
	if( $errst ){
	    return $me->isdown( "SNMP error - " . $errstat{$errst} || $errst, 'SNMP error' );
	}
	$value = pretty_print($val);
    }else{
	# v3
	my $discov;
	
	my( $ver, $msgid, $maxsz, $flags, $secmodel,
	    $secparam, $more ) = 
		decode_by_template($l, "%{%i%{%i%i%s%i%s%@");
	
	if( $Argus::BER::errmsg ){
	    return $me->isdown( "BER error: $Argus::BER::errmsg", 'BER error' );
	}

	my( $aeng,  $eboot, $etime, $name, $authp, $privp ) =
	    decode_by_template( $secparam, "%{%s%i%i%s%s%s" );
	
	if( $Argus::BER::errmsg ){
	    return $me->isdown( "BER error: $Argus::BER::errmsg", 'BER error' );
	}
	
	# auto-discover engine-id
	if( $aeng && ! $me->{snmp}{authengine} ){
	    $me->{snmp}{authengine}    ||= $aeng;
	    $me->{snmp}{contextengine} ||= $aeng;
	    # also try to auto-discover boots+time
	    # but not all systems will send these
	    # in an invalid-engine-id report
	    $me->{snmp}{engineboot} = $eboot;
	    $me->{snmp}{enginetime} = $etime;
	    $me->{snmp}{discovered} = 1;

	    $discov = 1;
	    $me->debug( "SNMPv3 auto-discovered engine-id" );
	}
	
	# decrypt
	if( $privp ){
	    my( $pdu ) = Argus::BER::decode_string( $more );
	    $more = $me->decrypt( $privp, $pdu );
	    # remove padding
	    my( $len, $np ) = Argus::BER::decode_length( substr($more, 1) );
	    $more = encode_sequence( substr($np, 0, $len));
	}
	
	my( $ceng, $cname, $pdu ) =
	    decode_by_template($more, "%{%s%s%@");
	
	if( $Argus::BER::errmsg ){
	    return $me->isdown( "BER error: $Argus::BER::errmsg", 'BER error' );
	}

	my $pdutype = ord(substr($pdu, 0, 1));
	
	if( $pdutype == 162 ){
	    # response
	    my( $reqid, $errst, $errin, $oid, $val ) =
		decode_by_template($pdu, "%*{%i%i%i%{%{%O%@", 162);
	    if( $Argus::BER::errmsg ){
		return $me->isdown( "BER error: $Argus::BER::errmsg", 'BER error' );
	    }

	    if( $errst ){
		return $me->isdown( "SNMP error - " . $errstat{$errst} || $errst, 'SNMP error' );
	    }
	    
	    $value = pretty_print($val);
	}elsif( $pdutype == 168 ){
	    # report
	    # if we auto-discovered engine-ids
	    # regenerate req with new engine id
	    if( $discov ){
		$me->build_req();
		return $me->done();
	    }
	    my( $reqid, $errst, $errin, $oid, $val ) =
		decode_by_template($pdu, "%*{%i%i%i%{%{%O%@", 168);
	    if( $Argus::BER::errmsg ){
		return $me->isdown( "BER error: $Argus::BER::errmsg", 'BER error' );
	    }
	    $oid = Argus::BER::pretty_oid($oid);
	    if( $oid eq '1.3.6.1.6.3.15.1.1.2.0' ){
		# need to update boot/time
		$me->{snmp}{engineboot} = $eboot;
		$me->{snmp}{enginetime} = $etime;

		$me->debug( "SNMPv3 updating boots/time" );
		$me->build_req();
		return $me->done();
		
		# re-send request, 
		# start over without rescheduling
		# $me->shutdown();
		# return $me->start();
	    }

	    if( $oid eq '1.3.6.1.6.3.15.1.1.4.0' && $me->{snmp}{discovered} ){
		# if we previously auto-discovered the engine-id,
		# re-auto-discover it.
		# NB: ucd choses a new engine id when it restarts
		$me->{snmp}{authengine}    = $aeng;
		$me->{snmp}{contextengine} = $aeng;
		$me->{snmp}{engineboot} = $eboot;
		$me->{snmp}{enginetime} = $etime;
		delete $me->{snmp}{authkey};
		delete $me->{snmp}{privkey};
		
		# make noise
		$me->loggit( tag => 'SNMPv3',
			     msg => "remote system changed engine-id.", 
			     objlog => 1,
			     );

		$me->build_req();
		return $me->done();
	    }

	    if( $v3errs{$oid} ){
		return $me->isdown( "SNMPv3 error report. $v3errs{$oid}", 'SNMP error' );
	    }
	    
	    return $me->isdown( "SNMPv3 report. possibly misconfigured? ($oid)", 'SNMP error' );
	}else{
	    return $me->isdown( "SNMPv3 unknown reply type ($pdutype)", 'SNMP error' );
	}
    }
    
    if( $Argus::BER::errmsg ){
	return $me->isdown( "BER error: $Argus::BER::errmsg", 'BER error' );
    }

    if( $value =~ /^\#<(.*)>/ ){
	return $me->isdown( "BER error: $1 (no such OID?)", 'OID error' );
    }
    
    $me->debug( "SNMP recv - raw value $value" );
    $me->generic_test($value, 'SNMP');
}

sub webpage_more {
    my $me = shift;
    my $fh = shift;
    my( $k, $v );
    
    $me->SUPER::webpage_more($fh);
    
    foreach $k (qw(oid contextname)){
	$v = $me->{snmp}{$k};
	print $fh "<TR><TD>SNMP $k</TD><TD>$v</TD></TR>\n" if defined($v);
    }
}

sub about_more {
    my $me = shift;
    my $ctl = shift;
    my( $k, $v );

    $me->SUPER::about_more($ctl);
    $me->more_about_whom($ctl, 'snmp');
}


Doc::register( $doc );
push @Service::probes, \&probe;

1;

# NOTE: ucd replies with error = 'NO ERROR', value = 'NOSUCHINSTANCE' for invalid oid

