# -*- mode: Perl -*-######################################################################### SNMP Request/Response Handling######################################################################### The abstract class SNMP_Session defines objects that can be used### to communicate with SNMP entities.  It has methods to send### requests to and receive responses from an agent.###### Currently it has one subclass, SNMPv1_Session, which implements### the SNMPv1 protocol.######################################################################### Created by:  Simon Leinen  <simon@switch.ch>###### Contributions and fixes by:###### Matthew Trunnell <matter@media.mit.edu>### Tobias Oetiker <oetiker@ee.ethz.ch>### Heine Peters <peters@dkrz.de>### Daniel L. Needles <dan_needles@INS.COM>### Mike Mitchell <mcm@unx.sas.com>### Clinton Wong <clintdw@netcom.com>### Alan Nichols <Alan.Nichols@Ebay.Sun.COM>### Mike McCauley <mikem@open.com.au>######################################################################package SNMP_Session;		require 5.002;use strict qw(vars subs);	# cannot use strict subs here				# because of the way we use				# generated file handlesuse Exporter;use vars qw(@ISA $VERSION @EXPORT $errmsg $suppress_warnings);use Socket;use BER;sub map_table ($$$);sub map_table_4 ($$$$);sub map_table_start_end ($$$$$$);sub index_compare ($$);sub oid_diff ($$);$VERSION = '0.71';@ISA = qw(Exporter);@EXPORT = qw(errmsg suppress_warnings index_compare oid_diff);my $default_debug = 0;### Default initial timeout (in seconds) waiting for a response PDU### after a request is sent.  Note that when a request is retried, the### timeout is increased by BACKOFF (see below).###my $default_timeout = 2.0;### Default number of retries for each SNMP request.  If no response### is received after TIMEOUT seconds, the request is resent and a new### response awaited with a longer timeout (see the documentation on### BACKOFF below).###my $default_retries = 5;### Default backoff factor for SNMP_Session objects.  This factor is### used to increase the TIMEOUT every time an SNMP request is### retried.###my $default_backoff = 1.0;### Default value for maxRepetitions.  This specifies how many table### rows are requested in getBulk requests.  Used when walking tables### using getBulk (only available in SNMPv2(c) and later).  If this is### too small, then a table walk will need unnecessarily many### request/response exchanges.  If it is too big, the agent may### compute many variables after the end of the table.  It is### recommended to set this explicitly for each table walk by using### map_table_4().###my $default_max_repetitions = 12;$SNMP_Session::errmsg = '';$SNMP_Session::suppress_warnings = 2;sub get_request      { 0 | context_flag };sub getnext_request  { 1 | context_flag };sub get_response     { 2 | context_flag };sub set_request      { 3 | context_flag };sub trap_request     { 4 | context_flag };sub getbulk_request  { 5 | context_flag };sub inform_request   { 6 | context_flag };sub trap2_request    { 7 | context_flag };sub standard_udp_port { 161 };sub open{    return SNMPv1_Session::open (@_);}sub timeout { $_[0]->{timeout} }sub retries { $_[0]->{retries} }sub backoff { $_[0]->{backoff} }sub set_timeout {    my ($session, $timeout) = @_;    die "timeout ($timeout) must be a positive number" unless $timeout > 0.0;    $session->{'timeout'} = $timeout;}sub set_retries {    my ($session, $retries) = @_;    die "retries ($retries) must be a non-negative integer"	unless $retries == int ($retries) && $retries >= 0;    $session->{'retries'} = $retries; }sub set_backoff {    my ($session, $backoff) = @_;    die "backoff ($backoff) must be a number >= 1.0"	unless $backoff == int ($backoff) && $backoff >= 1.0;    $session->{'backoff'} = $backoff; }sub encode_request_3 ($$$@){    my($this, $reqtype, $encoded_oids_or_pairs, $i1, $i2) = @_;    my($request);    local($_);    ++$this->{request_id};    foreach $_ (@{$encoded_oids_or_pairs}) {      if (ref ($_) eq 'ARRAY') {	$_ = &encode_sequence ($_->[0], $_->[1])	  || return $this->ber_error ("encoding pair");      } else {	$_ = &encode_sequence ($_, encode_null())	  || return $this->ber_error ("encoding value/null pair");      }    }    $request = encode_tagged_sequence	($reqtype,	 encode_int ($this->{request_id}),	 defined $i1 ? encode_int ($i1) : encode_int_0,	 defined $i2 ? encode_int ($i2) : encode_int_0,	 encode_sequence (@{$encoded_oids_or_pairs}))	  || return $this->ber_error ("encoding request PDU");    return $this->wrap_request ($request);}sub encode_get_request{    my($this, @oids) = @_;    return encode_request_3 ($this, get_request, \@oids);}sub encode_getnext_request{    my($this, @oids) = @_;    return encode_request_3 ($this, getnext_request, \@oids);}sub encode_getbulk_request{    my($this, $non_repeaters, $max_repetitions, @oids) = @_;    return encode_request_3 ($this, getbulk_request, \@oids,			     $non_repeaters, $max_repetitions);}sub encode_set_request{    my($this, @encoded_pairs) = @_;    return encode_request_3 ($this, set_request, \@encoded_pairs);}sub encode_trap_request ($$$$$$@){    my($this, $ent, $agent, $gen, $spec, $dt, @pairs) = @_;    my($request);    local($_);    foreach $_ (@pairs) {      if (ref ($_) eq 'ARRAY') {	$_ = &encode_sequence ($_->[0], $_->[1])	  || return $this->ber_error ("encoding pair");      } else {	$_ = &encode_sequence ($_, encode_null())	  || return $this->ber_error ("encoding value/null pair");      }    }    $request = encode_tagged_sequence	(trap_request, $ent, $agent, $gen, $spec, $dt, encode_sequence (@pairs))	  || return $this->ber_error ("encoding trap PDU");    return $this->wrap_request ($request);}sub decode_get_response{    my($this, $response) = @_;    my @rest;    @{$this->{'unwrapped'}};}sub decode_trap_request ($$) {    my ($this, $trap) = @_;    my ($snmp_version, $community, $ent, $agent, $gen, $spec, $dt,	$bindings);    ($snmp_version, $community, $ent, $agent, $gen, $spec, $dt, $bindings)	= decode_by_template ($trap, "%{%i%s%*{%O%A%i%i%u%{%@",			      SNMP_Session::trap_request			      );    return undef	unless $snmp_version == $this->snmp_version ();    if (!defined $ent) {	warn "BER error decoding trap:\n  ".$BER::errmsg."\n";    }    return ($community, $ent, $agent, $gen, $spec, $dt, $bindings);}sub wait_for_response{    my($this) = shift;    my($timeout) = shift || 10.0;    my($rin,$win,$ein) = ('','','');    my($rout,$wout,$eout);    vec($rin,$this->sockfileno,1) = 1;    select($rout=$rin,$wout=$win,$eout=$ein,$timeout);}sub get_request_response ($@){    my($this, @oids) = @_;    return $this->request_response_5 ($this->encode_get_request (@oids),				      get_response, \@oids, 1);}sub set_request_response ($@){    my($this, @pairs) = @_;    return $this->request_response_5 ($this->encode_set_request (@pairs),				      get_response, \@pairs, 1);}sub getnext_request_response ($@){    my($this,@oids) = @_;    return $this->request_response_5 ($this->encode_getnext_request (@oids),				      get_response, \@oids, 1);}sub getbulk_request_response ($$$@){    my($this,$non_repeaters,$max_repetitions,@oids) = @_;    return $this->request_response_5	($this->encode_getbulk_request ($non_repeaters,$max_repetitions,@oids),	 get_response, \@oids, 1);}sub trap_request_send ($$$$$$@){    my($this, $ent, $agent, $gen, $spec, $dt, @pairs) = @_;    my($req);    $req = $this->encode_trap_request ($ent, $agent, $gen, $spec, $dt, @pairs);    ## Encoding may have returned an error.    return undef unless defined $req;    $this->send_query($req)	|| return $this->error ("send_trap: $!");    return 1;}sub request_response_5 ($$$$$){    my ($this, $req, $response_tag, $oids, $errorp) = @_;    my $retries = $this->retries;    my $timeout = $this->timeout;    my ($nfound, $timeleft);    ## Encoding may have returned an error.    return undef unless defined $req;    $timeleft = $timeout;    $this->send_query ($req)	|| return $this->error ("send_query: $!");    while ($retries > 0) {	($nfound, $timeleft) = $this->wait_for_response($timeleft);	if ($nfound > 0) {	    my($response_length);	    $response_length		= $this->receive_response_3 ($response_tag, $oids, $errorp);	    if ($response_length) {		return $response_length;	    } elsif (defined ($response_length)) {		# A response has been received, but for a different		# request ID.	    } else {		return undef;	    }	} else {	    ## No response received - retry	    --$retries;	    $timeout *= $this->backoff;	    $timeleft = $timeout;	    $this->send_query ($req)		|| return $this->error ("send_query: $!");	}    }    $this->error ("no response received");}sub error_return ($$){    my ($this,$message) = @_;    $SNMP_Session::errmsg = $message;    unless ($SNMP_Session::suppress_warnings) {	$message =~ s/^/  /mg;	warn ("Error:\n".$message."\n");    }    return undef;}sub error ($$){    my ($this,$message) = @_;    my $session = $this->to_string;    $SNMP_Session::errmsg = $message."\n".$session;    unless ($SNMP_Session::suppress_warnings) {	$session =~ s/^/  /mg;	$message =~ s/^/  /mg;	warn ("SNMP Error:\n".$SNMP_Session::errmsg."\n");    }    return undef;}sub ber_error ($$){  my ($this,$type) = @_;  my ($errmsg) = $BER::errmsg;  $errmsg =~ s/^/  /mg;  return $this->error ("$type:\n$errmsg");}sub map_table ($$$) {    my ($session, $columns, $mapfn) = @_;    return $session->map_table_4 ($columns, $mapfn,				  $session->default_max_repetitions ());}sub map_table_4 ($$$$) {    my ($session, $columns, $mapfn, $max_repetitions) = @_;    return $session->map_table_start_end ($columns, $mapfn,					  "", undef,					  $max_repetitions);}sub map_table_start_end ($$$$$$) {    my ($session, $columns, $mapfn, $start, $end, $max_repetitions) = @_;    my @encoded_oids;    my $call_counter = 0;    my $base_index = $start;    do {	foreach (@encoded_oids = @{$columns}) {	    $_=encode_oid (@{$_},split '\.',$base_index)		|| return $session->ber_error ("encoding OID $base_index");	}	if ($session->getnext_request_response (@encoded_oids)) {	    my $response = $session->pdu_buffer;	    my ($bindings) = $session->decode_get_response ($response);	    my $smallest_index = undef;	    my @collected_values = ();	    my @bases = @{$columns};	    while ($bindings ne '') {		my ($binding, $oid, $value);		my $base = shift @bases;		($binding, $bindings) = decode_sequence ($bindings);		($oid, $value) = decode_by_template ($binding, "%O%@");		my $out_index;		$out_index = &oid_diff ($base, $oid);		my $cmp;		if (!defined $smallest_index		    || ($cmp = index_compare ($out_index,$smallest_index)) == -1) {		    $smallest_index = $out_index;		    grep ($_=undef, @collected_values);		    push @collected_values, $value;		} elsif ($cmp == 1) {		    push @collected_values, undef;		} else {		    push @collected_values, $value;		}	    }	    (++$call_counter,	     &$mapfn ($smallest_index, @collected_values))		if defined $smallest_index;	    $base_index = $smallest_index;	} else {	    return undef;	}    }    while (defined $base_index	   && (!defined $end || index_compare ($base_index, $end) < 0));    $call_counter;}