ZerethShell — File Manager

Message.pm

# -*- mode: perl -*-

# ============================================================================

package Net::SNMP::Message;

# $Id: Message.pm,v 3.1 2010/09/10 00:01:22 dtown Rel $

# Object used to represent a SNMP message.

# This program is free software; you may redistribute it and/or modify it
# under the same terms as the Perl 5 programming language system itself.

# ============================================================================

use strict;
use bytes;

use Math::BigInt();

## Version of the Net::SNMP::Message module

our $VERSION = v3.0.1;

## Handle importing/exporting of symbols

use base qw( Exporter );

our @EXPORT_OK = qw( TRUE FALSE DEBUG_INFO );

our %EXPORT_TAGS = (
   generictrap    => [
      qw( COLD_START WARM_START LINK_DOWN LINK_UP AUTHENTICATION_FAILURE
          EGP_NEIGHBOR_LOSS ENTERPRISE_SPECIFIC )
   ],
   msgFlags       => [
      qw( MSG_FLAGS_NOAUTHNOPRIV MSG_FLAGS_AUTH MSG_FLAGS_PRIV 
          MSG_FLAGS_REPORTABLE MSG_FLAGS_MASK )
   ],
   securityLevels => [
      qw( SECURITY_LEVEL_NOAUTHNOPRIV SECURITY_LEVEL_AUTHNOPRIV
          SECURITY_LEVEL_AUTHPRIV )
   ],
   securityModels => [
      qw( SECURITY_MODEL_ANY SECURITY_MODEL_SNMPV1 SECURITY_MODEL_SNMPV2C
          SECURITY_MODEL_USM )
   ],
   translate      => [
      qw( TRANSLATE_NONE TRANSLATE_OCTET_STRING TRANSLATE_NULL 
          TRANSLATE_TIMETICKS TRANSLATE_OPAQUE TRANSLATE_NOSUCHOBJECT 
          TRANSLATE_NOSUCHINSTANCE TRANSLATE_ENDOFMIBVIEW TRANSLATE_UNSIGNED 
          TRANSLATE_ALL )
   ],
   types          => [
      qw( INTEGER INTEGER32 OCTET_STRING NULL OBJECT_IDENTIFIER SEQUENCE
          IPADDRESS COUNTER COUNTER32 GAUGE GAUGE32 UNSIGNED32 TIMETICKS
          OPAQUE COUNTER64 NOSUCHOBJECT NOSUCHINSTANCE ENDOFMIBVIEW
          GET_REQUEST GET_NEXT_REQUEST GET_RESPONSE SET_REQUEST TRAP
          GET_BULK_REQUEST INFORM_REQUEST SNMPV2_TRAP REPORT )
   ],
   utilities      => [ qw( asn1_ticks_to_time asn1_itoa ) ],
   versions       => [ qw( SNMP_VERSION_1 SNMP_VERSION_2C SNMP_VERSION_3 ) ],
);

Exporter::export_ok_tags(
   qw( generictrap msgFlags securityLevels securityModels translate types 
       utilities versions )
);

$EXPORT_TAGS{ALL} = [ @EXPORT_OK ];

## ASN.1 Basic Encoding Rules type definitions

sub INTEGER                  { 0x02 }  # INTEGER
sub INTEGER32                { 0x02 }  # Integer32           - SNMPv2c
sub OCTET_STRING             { 0x04 }  # OCTET STRING
sub NULL                     { 0x05 }  # NULL
sub OBJECT_IDENTIFIER        { 0x06 }  # OBJECT IDENTIFIER
sub SEQUENCE                 { 0x30 }  # SEQUENCE

sub IPADDRESS                { 0x40 }  # IpAddress
sub COUNTER                  { 0x41 }  # Counter
sub COUNTER32                { 0x41 }  # Counter32           - SNMPv2c
sub GAUGE                    { 0x42 }  # Gauge
sub GAUGE32                  { 0x42 }  # Gauge32             - SNMPv2c
sub UNSIGNED32               { 0x42 }  # Unsigned32          - SNMPv2c
sub TIMETICKS                { 0x43 }  # TimeTicks
sub OPAQUE                   { 0x44 }  # Opaque
sub COUNTER64                { 0x46 }  # Counter64           - SNMPv2c

sub NOSUCHOBJECT             { 0x80 }  # noSuchObject        - SNMPv2c
sub NOSUCHINSTANCE           { 0x81 }  # noSuchInstance      - SNMPv2c
sub ENDOFMIBVIEW             { 0x82 }  # endOfMibView        - SNMPv2c

sub GET_REQUEST              { 0xa0 }  # GetRequest-PDU
sub GET_NEXT_REQUEST         { 0xa1 }  # GetNextRequest-PDU
sub GET_RESPONSE             { 0xa2 }  # GetResponse-PDU
sub SET_REQUEST              { 0xa3 }  # SetRequest-PDU
sub TRAP                     { 0xa4 }  # Trap-PDU
sub GET_BULK_REQUEST         { 0xa5 }  # GetBulkRequest-PDU  - SNMPv2c
sub INFORM_REQUEST           { 0xa6 }  # InformRequest-PDU   - SNMPv2c
sub SNMPV2_TRAP              { 0xa7 }  # SNMPv2-Trap-PDU     - SNMPv2c
sub REPORT                   { 0xa8 }  # Report-PDU          - SNMPv3

## SNMP RFC version definitions

sub SNMP_VERSION_1           { 0x00 }  # RFC 1157 SNMPv1
sub SNMP_VERSION_2C          { 0x01 }  # RFC 1901 Community-based SNMPv2
sub SNMP_VERSION_3           { 0x03 }  # RFC 3411 SNMPv3

## RFC 1157 - generic-trap definitions

sub COLD_START                  { 0 }  # coldStart(0)
sub WARM_START                  { 1 }  # warmStart(1)
sub LINK_DOWN                   { 2 }  # linkDown(2)
sub LINK_UP                     { 3 }  # linkUp(3)
sub AUTHENTICATION_FAILURE      { 4 }  # authenticationFailure(4)
sub EGP_NEIGHBOR_LOSS           { 5 }  # egpNeighborLoss(5)
sub ENTERPRISE_SPECIFIC         { 6 }  # enterpriseSpecific(6)

## RFC 3412 - msgFlags::=OCTET STRING

sub MSG_FLAGS_NOAUTHNOPRIV   { 0x00 }  # Means noAuthNoPriv
sub MSG_FLAGS_AUTH           { 0x01 }  # authFlag
sub MSG_FLAGS_PRIV           { 0x02 }  # privFlag
sub MSG_FLAGS_REPORTABLE     { 0x04 }  # reportableFlag
sub MSG_FLAGS_MASK           { 0x07 }

## RFC 3411 - SnmpSecurityLevel::=TEXTUAL-CONVENTION

sub SECURITY_LEVEL_NOAUTHNOPRIV { 1 }  # noAuthNoPriv
sub SECURITY_LEVEL_AUTHNOPRIV   { 2 }  # authNoPriv
sub SECURITY_LEVEL_AUTHPRIV     { 3 }  # authPriv

## RFC 3411 - SnmpSecurityModel::=TEXTUAL-CONVENTION

sub SECURITY_MODEL_ANY          { 0 }  # Reserved for 'any'
sub SECURITY_MODEL_SNMPV1       { 1 }  # Reserved for SNMPv1
sub SECURITY_MODEL_SNMPV2C      { 2 }  # Reserved for SNMPv2c
sub SECURITY_MODEL_USM          { 3 }  # User-Based Security Model (USM)

## Translation masks

sub TRANSLATE_NONE           { 0x00 }  # Bit masks used to determine
sub TRANSLATE_OCTET_STRING   { 0x01 }  # if a specific ASN.1 type is
sub TRANSLATE_NULL           { 0x02 }  # translated into a "human
sub TRANSLATE_TIMETICKS      { 0x04 }  # readable" form.
sub TRANSLATE_OPAQUE         { 0x08 }
sub TRANSLATE_NOSUCHOBJECT   { 0x10 }
sub TRANSLATE_NOSUCHINSTANCE { 0x20 }
sub TRANSLATE_ENDOFMIBVIEW   { 0x40 }
sub TRANSLATE_UNSIGNED       { 0x80 }
sub TRANSLATE_ALL            { 0xff }

## Truth values

sub TRUE                     { 0x01 }
sub FALSE                    { 0x00 }

## Package variables

our $DEBUG = FALSE;                    # Debug flag

our $AUTOLOAD;                         # Used by the AUTOLOAD method

## Initialize the request-id/msgID.

our $ID = int rand((2**16) - 1) + ($^T & 0xff);

# [public methods] -----------------------------------------------------------

sub new
{
   my ($class, %argv) = @_;

# Create a new data structure for the object
   my $this = bless {
      '_buffer'      =>  q{},             # Serialized message buffer
      '_error'       =>  undef,           # Error message
      '_index'       =>  0,               # Buffer index
      '_leading_dot' =>  FALSE,           # Prepend leading dot on OIDs
      '_length'      =>  0,               # Buffer length
      '_security'    =>  undef,           # Security Model object
      '_translate'   =>  TRANSLATE_NONE,  # Translation mode
      '_transport'   =>  undef,           # Transport Layer object
      '_version'     =>  SNMP_VERSION_1,  # SNMP version
   }, $class;

# Validate the passed arguments

for (keys %argv) {

if (/^-?callback$/i) {
         $this->callback($argv{$_});
      } elsif (/^-?debug$/i) {
         $this->debug($argv{$_});
      } elsif (/^-?leadingdot$/i) {
         $this->leading_dot($argv{$_});
      } elsif (/^-?msgid$/i) {
         $this->msg_id($argv{$_});
      } elsif (/^-?requestid$/i) {
         $this->request_id($argv{$_});
      } elsif (/^-?security$/i) {
         $this->security($argv{$_});
      } elsif (/^-?translate$/i) {
         $this->translate($argv{$_});
      } elsif (/^-?transport$/i) {
         $this->transport($argv{$_});
      } elsif (/^-?version$/i) {
         $this->version($argv{$_});
      } else {
         $this->_error('The argument "%s" is unknown', $_);
      }

if (defined $this->{_error}) {
         return wantarray ? (undef, $this->{_error}) : undef;
      }

}

return wantarray ? ($this, q{}) : $this;
}

{
   my $prepare_methods = {
      INTEGER,            \&_prepare_integer,
      OCTET_STRING,       \&_prepare_octet_string,
      NULL,               \&_prepare_null,
      OBJECT_IDENTIFIER,  \&_prepare_object_identifier,
      SEQUENCE,           \&_prepare_sequence,
      IPADDRESS,          \&_prepare_ipaddress,
      COUNTER,            \&_prepare_counter,
      GAUGE,              \&_prepare_gauge,
      TIMETICKS,          \&_prepare_timeticks,
      OPAQUE,             \&_prepare_opaque,
      COUNTER64,          \&_prepare_counter64,
      NOSUCHOBJECT,       \&_prepare_nosuchobject,
      NOSUCHINSTANCE,     \&_prepare_nosuchinstance,
      ENDOFMIBVIEW,       \&_prepare_endofmibview,
      GET_REQUEST,        \&_prepare_get_request,
      GET_NEXT_REQUEST,   \&_prepare_get_next_request,
      GET_RESPONSE,       \&_prepare_get_response,
      SET_REQUEST,        \&_prepare_set_request,
      TRAP,               \&_prepare_trap,
      GET_BULK_REQUEST,   \&_prepare_get_bulk_request,
      INFORM_REQUEST,     \&_prepare_inform_request,
      SNMPV2_TRAP,        \&_prepare_v2_trap,
      REPORT,             \&_prepare_report
   };

sub prepare
   {
#     my ($this, $type, $value) = @_;

return $_[0]->_error() if defined $_[0]->{_error};

if (!defined $_[1]) {
         return $_[0]->_error('The ASN.1 type is not defined');
      }

if (!exists $prepare_methods->{$_[1]}) {
         return $_[0]->_error('The ASN.1 type "%s" is unknown', $_[1]);
      }

return $_[0]->${\$prepare_methods->{$_[1]}}($_[2]);
   }
}

{
   my $process_methods = {
      INTEGER,            \&_process_integer32,
      OCTET_STRING,       \&_process_octet_string,
      NULL,               \&_process_null,
      OBJECT_IDENTIFIER,  \&_process_object_identifier,
      SEQUENCE,           \&_process_sequence,
      IPADDRESS,          \&_process_ipaddress,
      COUNTER,            \&_process_counter,
      GAUGE,              \&_process_gauge,
      TIMETICKS,          \&_process_timeticks,
      OPAQUE,             \&_process_opaque,
      COUNTER64,          \&_process_counter64,
      NOSUCHOBJECT,       \&_process_nosuchobject,
      NOSUCHINSTANCE,     \&_process_nosuchinstance,
      ENDOFMIBVIEW,       \&_process_endofmibview,
      GET_REQUEST,        \&_process_get_request,
      GET_NEXT_REQUEST,   \&_process_get_next_request,
      GET_RESPONSE,       \&_process_get_response,
      SET_REQUEST,        \&_process_set_request,
      TRAP,               \&_process_trap,
      GET_BULK_REQUEST,   \&_process_get_bulk_request,
      INFORM_REQUEST,     \&_process_inform_request,
      SNMPV2_TRAP,        \&_process_v2_trap,
      REPORT,             \&_process_report
   };

sub process
   {
#     my ($this, $expected, $found) = @_;

# XXX: If present, $found is updated as a side effect.

return $_[0]->_error() if defined $_[0]->{_error};

return $_[0]->_error() if !defined (my $type = $_[0]->_buffer_get(1));

$type = unpack 'C', $type;

if (!exists $process_methods->{$type}) {
         return $_[0]->_error('The ASN.1 type 0x%02x is unknown', $type);
      }

# Check to see if a specific ASN.1 type was expected.
      if ((@_ > 1) && (defined $_[1]) && ($type != $_[1])) {
         return $_[0]->_error(
            'Expected %s, but found %s', asn1_itoa($_[1]), asn1_itoa($type)
         );
      }

# Update the found ASN.1 type, if the argument is present. 
      if (@_ == 3) {
         $_[2] = $type;
      }

return $_[0]->${\$process_methods->{$type}}($type);
   }
}

sub context_engine_id
{
   my ($this, $engine_id) = @_;

# RFC 3412 - contextEngineID::=OCTET STRING

if (@_ == 2) {
      if (!defined $engine_id) {
         return $this->_error('The contextEngineID value is not defined');
      }
      $this->{_context_engine_id} = $engine_id;
   }

if (exists $this->{_context_engine_id}) {
      return $this->{_context_engine_id} || q{};
   } elsif (defined $this->{_security}) {
      return $this->{_security}->engine_id() || q{};
   }

return q{};
}

sub context_name
{
   my ($this, $name) = @_;

# RFC 3412 - contextName::=OCTET STRING

if (@_ == 2) {
      if (!defined $name) {
         return $this->_error('The contextName value is not defined');
      }
      $this->{_context_name} = $name;
   }

return exists($this->{_context_name}) ? $this->{_context_name} : q{};
}

sub msg_flags
{
   my ($this, $flags) = @_;

# RFC 3412 - msgFlags::=OCTET STRING (SIZE(1))

# NOTE: The stored value is not an OCTET STRING.

if (@_ == 2) {
      if (!defined $flags) {
         return $this->_error('The msgFlags value is not defined');
      }
      $this->{_msg_flags} = $flags;
   }

if (exists $this->{_msg_flags}) {
      return $this->{_msg_flags};
   }

return MSG_FLAGS_NOAUTHNOPRIV;
}

sub msg_id
{
   my ($this, $msg_id) = @_;

# RFC 3412 - msgID::=INTEGER (0..2147483647)

if (@_ == 2) {
      if (!defined $msg_id) {
         return $this->_error('The msgID value is not defined');
      }
      if (($msg_id < 0) || ($msg_id > 2147483647)) {
         return $this->_error(
            'The msgId %d is out of range (0..2147483647)', $msg_id
         );
      }
      $this->{_msg_id} = $msg_id;
   }

if (exists $this->{_msg_id}) {
      return $this->{_msg_id};
   } elsif (exists $this->{_request_id}) {
      return $this->{_request_id};
   }

return 0;
}

sub msg_max_size
{
   my ($this, $size) = @_;

# RFC 3412 - msgMaxSize::=INTEGER (484..2147483647)

if (@_ == 2) {
      if (!defined $size) {
         return $this->_error('The msgMaxSize value is not defined');
      }
      if (($size < 484) || ($size > 2147483647)) {
         return $this->_error(
            'The msgMaxSize %d is out of range (484..2147483647)', $size
         );
      }
      $this->{_msg_max_size} = $size;
   }

return $this->{_msg_max_size} || 484;
}

sub msg_security_model
{
   my ($this, $model) = @_;

# RFC 3412 - msgSecurityModel::=INTEGER (1..2147483647)

if (@_ == 2) {
      if (!defined $model) {
         return $this->_error('The msgSecurityModel value is not defined');
      }
      if (($model < 1) || ($model > 2147483647)) {
         return $this->_error(
            'The msgSecurityModel %d is out of range (1..2147483647)', $model
         );
      }
      $this->{_security_model} = $model;
   }

if (exists $this->{_security_model}) {
      return $this->{_security_model};
   } elsif (defined $this->{_security}) {
      return $this->{_security}->security_model();
   } else {
      if ($this->{_version} == SNMP_VERSION_1) {
         return SECURITY_MODEL_SNMPV1;
      } elsif ($this->{_version} == SNMP_VERSION_2C) {
         return SECURITY_MODEL_SNMPV2C;
      } elsif ($this->{_version} == SNMP_VERSION_3) {
         return SECURITY_MODEL_USM;
      }
   }

return SECURITY_MODEL_ANY;
}

sub request_id
{
   my ($this, $request_id) = @_;

# request-id::=INTEGER

if (@_ == 2) {
      if (!defined $request_id) {
         return $this->_error('The request-id value is not defined');
      }
      $this->{_request_id} = $request_id;
   }

return exists($this->{_request_id}) ? $this->{_request_id} : 0;
}

sub security_level
{
   my ($this, $level) = @_;

# RFC 3411 - SnmpSecurityLevel::=INTEGER { noAuthNoPriv(1), 
   #                                          authNoPriv(2),
   #                                          authPriv(3) }

if (@_ == 2) {
      if (!defined $level) {
         return $this->_error('The securityLevel value is not defined');
      }
      if (($level < SECURITY_LEVEL_NOAUTHNOPRIV) ||
          ($level > SECURITY_LEVEL_AUTHPRIV))
      {
         return $this->_error(
            'The securityLevel %d is out of range (%d..%d)', $level,
            SECURITY_LEVEL_NOAUTHNOPRIV, SECURITY_LEVEL_AUTHPRIV
         );
      }
      $this->{_security_level} = $level;
   }

if (exists $this->{_security_level}) {
      return $this->{_security_level};
   } elsif (defined $this->{_security}) {
      return $this->{_security}->security_level();
   }

return SECURITY_LEVEL_NOAUTHNOPRIV;
}

sub security_name
{
   my ($this, $name) = @_;

if (@_ == 2) {
      if (!defined $name) {
         return $this->_error('The securityName value is not defined');
      }
      # No length checks due to no limits by RFC 1157 for community name.
      $this->{_security_name} = $name;
   }

if (exists $this->{_security_name}) {
      return $this->{_security_name};
   } elsif (defined $this->{_security}) {
      return $this->{_security}->security_name();
   }

return q{};
}

sub version
{
   my ($this, $version) = @_;

if (@_ == 2) {
      if (($version == SNMP_VERSION_1)  ||
          ($version == SNMP_VERSION_2C) ||
          ($version == SNMP_VERSION_3))
      {
         $this->{_version} = $version;
      } else {
         return $this->_error('The SNMP version %d is not supported', $version);
      }
   }

return $this->{_version};
}

sub error_status
{
   return 0; # noError(0) 
}

sub error_index
{
   return 0;
}

sub var_bind_list
{
   return undef;
}

sub var_bind_names
{
   return [];
}

sub var_bind_types
{
   return undef;
}

#
# Security Model accessor methods
#

sub security
{
   my ($this, $security) = @_;

if (@_ == 2) {
      if (defined $security) {
         $this->{_security} = $security;
      } else {
         $this->_error_clear();
         return $this->_error('The Security Model object is not defined');
      }
   }

return $this->{_security};
}

#
# Transport Domain accessor methods
#

sub transport
{
   my ($this, $transport) = @_;

if (@_ == 2) {
      if (defined $transport) {
         $this->{_transport} = $transport;
      } else {
         $this->_error_clear();
         return $this->_error('The Transport Domain object is not defined');
      }
   }

return $this->{_transport};
}

sub hostname
{
   my ($this) = @_;

if (defined $this->{_transport}) {
      return $this->{_transport}->dest_hostname();
   }

return q{};
}

sub dstname
{
   require Carp;
   Carp::croak(
      sprintf '%s::dstname() is obsolete, use hostname() instead', ref $_[0]
   );

# Never get here.
   return shift->hostname(@_);
}

sub max_msg_size
{
   my ($this, $size) = @_;

if (!defined $this->{_transport}) {
      return 0;
   }

if (@_ == 2) {
      $this->_error_clear();
      if (defined ($size = $this->{_transport}->max_msg_size($size))) {
         return $size;
      }
      return $this->_error($this->{_transport}->error());
   }

return $this->{_transport}->max_msg_size();
}

sub retries
{
   return defined($_[0]->{_transport}) ? $_[0]->{_transport}->retries() : 0;
}

sub timeout
{
   return defined($_[0]->{_transport}) ? $_[0]->{_transport}->timeout() : 0;
}

sub send
{
   my ($this) = @_;

$this->_error_clear();

if (!defined $this->{_transport}) {
      return $this->_error('The Transport Domain object is not defined');
   }

DEBUG_INFO('transport address %s', $this->{_transport}->dest_taddress());
   $this->_buffer_dump();

if (defined (my $bytes = $this->{_transport}->send($this->{_buffer}))) {
      return $bytes;
   }

return $this->_error($this->{_transport}->error());
}

sub recv
{
   my ($this) = @_;

$this->_error_clear();

if (!defined $this->{_transport}) {
      return $this->_error('The Transport Domain object is not defined');
   }

my $name = $this->{_transport}->recv($this->{_buffer});

if (defined $name) {
      $this->{_length} = CORE::length($this->{_buffer});
      DEBUG_INFO('transport address %s', $this->{_transport}->peer_taddress());
      $this->_buffer_dump();
      return $name;
   }

return $this->_error($this->{_transport}->error());
}

#
# Data representation methods
#

sub translate
{
   return (@_ == 2) ? $_[0]->{_translate} = $_[1] : $_[0]->{_translate};
}

sub leading_dot
{
   return (@_ == 2) ? $_[0]->{_leading_dot} = $_[1] : $_[0]->{_leading_dot};
}

#
# Callback handler methods
#

sub callback
{
   my ($this, $callback) = @_;

if (@_ == 2) {
      if (ref($callback) eq 'CODE') {
         $this->{_callback} = $callback;
      } elsif (!defined $callback) {
         $this->{_callback} = undef;
      } else {
         DEBUG_INFO('unexpected callback format');
      }
   }

return $this->{_callback};
}

sub callback_execute
{
   my ($this) = @_;

if (!defined $this->{_callback}) {
      DEBUG_INFO('no callback');
      return TRUE;
   }

# Protect ourselves from user error.
   eval { $this->{_callback}->($this); };

# We clear the callback in case it was a closure which might hold
   # up the reference count of the calling object.

$this->{_callback} = undef;

return ($@) ? $this->_error($@) : TRUE;
}

sub status_information
{
   my $this = shift;

if (@_) {
      $this->{_error} = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0];
      if ($this->debug()) {
         printf "error: [%d] %s(): %s\n",
                (caller 0)[2], (caller 1)[3], $this->{_error};
      }
      $this->callback_execute();
   }

return $this->{_error} || q{};
}

sub process_response_pdu
{
   goto &callback_execute;
}

sub timeout_id
{
   return (@_ == 2) ? $_[0]->{_timeout_id} = $_[1] : $_[0]->{_timeout_id};
}

#
# Buffer manipulation methods
#

sub index
{
   my ($this, $index) = @_;

if ((@_ == 2) && ($index >= 0) && ($index <= $this->{_length})) {
      $this->{_index} = $index;
   }

return $this->{_index};
}

sub length
{
   return $_[0]->{_length};
}

sub prepend
{
   goto &_buffer_put;
}

sub append
{
   goto &_buffer_append;
}

sub copy
{
   return $_[0]->{_buffer};
}

sub reference
{
   return \$_[0]->{_buffer};
}

sub clear
{
   my ($this) = @_;

$this->{_index}  = 0;
   $this->{_length} = 0;

return substr $this->{_buffer}, 0, CORE::length($this->{_buffer}), q{};
}

sub dump
{
   goto &_buffer_dump;
}

#
# Debug/error handling methods
#

sub error
{
   my $this = shift;

if (@_) {
      if (defined $_[0]) {
         $this->{_error} = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0];
         if ($this->debug()) {
            printf "error: [%d] %s(): %s\n",
                (caller 0)[2], (caller 1)[3], $this->{_error};
         }
      } else {
         $this->{_error} = undef;
      }
   }

return $this->{_error} || q{};
}

sub debug
{
   return (@_ == 2) ? $DEBUG = ($_[1]) ? TRUE : FALSE : $DEBUG;
}

sub AUTOLOAD
{
   my ($this) = @_;

return if $AUTOLOAD =~ /::DESTROY$/;

$AUTOLOAD =~ s/.*://;

if (ref $this) {
      $this->_error_clear();
      return $this->_error('The method "%s" is not supported', $AUTOLOAD);
   } else {
      require Carp;
      Carp::croak(sprintf 'The function "%s" is not supported', $AUTOLOAD);
   }

# Never get here.
   return;
}

# [private methods] ----------------------------------------------------------

#
# Basic Encoding Rules (BER) prepare methods
#

sub _prepare_type_length
{
#  my ($this, $type, $value) = @_;

if (!defined $_[1]) {
      return $_[0]->_error('The ASN.1 type is not defined');
   }

my $length = CORE::length($_[2]);

if ($length < 0x80) {
      return $_[0]->_buffer_put(pack('C2', $_[1], $length) . $_[2]);
   } elsif ($length <= 0xff) {
      return $_[0]->_buffer_put(pack('C3', $_[1], 0x81, $length) . $_[2]);
   } elsif ($length <= 0xffff) {
      return $_[0]->_buffer_put(pack('CCn', $_[1], 0x82, $length) . $_[2]);
   }

return $_[0]->_error('Unable to prepare the ASN.1 length');
}

sub _prepare_integer
{
   my ($this, $value) = @_;

if (!defined $value) {
      return $this->_error('The INTEGER value is not defined');
   }

if ($value !~ /^-?\d+$/) {
      return $this->_error(
         'The INTEGER value "%s" is expected in numeric format', $value
      );
   }

if ($value < -2147483648 || $value > 4294967295) {
      return $this->_error(
         'The INTEGER value "%s" is out of range (-2147483648..4294967295)',
         $value
      );
   }

return $this->_prepare_integer32(INTEGER, $value);
}

sub _prepare_unsigned32
{
   my ($this, $type, $value) = @_;

if (!defined $value) {
      return $this->_error('The %s value is not defined', asn1_itoa($type));
   }

if ($value !~ /^\d+$/) {
      return $this->_error(
         'The %s value "%s" is expected in positive numeric format',
         asn1_itoa($type), $value
      );
   }

if ($value < 0 || $value > 4294967295) {
      return $this->_error(
         'The %s value "%s" is out of range (0..4294967295)',
         asn1_itoa($type), $value
      );
   }

return $this->_prepare_integer32($type, $value);
}

sub _prepare_integer32
{
   my ($this, $type, $value) = @_;

# Determine if the value is positive or negative
   my $negative = ($value < 0);

# Check to see if the most significant bit is set, if it is we
   # need to prefix the encoding with a zero byte.

my $size   = 4;     # Assuming 4 byte integers
   my $prefix = FALSE;
   my $bytes  = q{};

if ((($value & 0xff000000) & 0x80000000) && (!$negative)) {
      $size++;
      $prefix = TRUE;
   }

# Remove occurances of nine consecutive ones (if negative) or zeros
   # from the most significant end of the two's complement integer.

while ((((!($value & 0xff800000))) ||
           ((($value & 0xff800000) == 0xff800000) && ($negative))) &&
           ($size > 1))
   {
      $size--;
      $value <<= 8;
   }

# Add a zero byte so the integer is decoded as a positive value
   if ($prefix) {
      $bytes = pack 'x';
      $size--;
   }

# Build the integer
   while ($size-- > 0) {
      $bytes .= pack 'C*', (($value & 0xff000000) >> 24);
      $value <<= 8;
   }

# Encode ASN.1 header
   return $this->_prepare_type_length($type, $bytes);
}

sub _prepare_octet_string
{
   my ($this, $value) = @_;

if (!defined $value) {
      return $this->_error('The OCTET STRING value is not defined');
   }

return $this->_prepare_type_length(OCTET_STRING, $value);
}

sub _prepare_null
{
   return $_[0]->_prepare_type_length(NULL, q{});
}

sub _prepare_object_identifier
{
   my ($this, $value) = @_;

if (!defined $value) {
      return $this->_error('The OBJECT IDENTIFIER value not defined');
   }

# The OBJECT IDENTIFIER is expected in dotted notation.
   if ($value !~ m/^\.?\d+(?:\.\d+)* *$/) {
      return $this->_error(
         'The OBJECT IDENTIFIER value "%s" is expected in dotted decimal ' .
         'notation', $value
      );
   }

# Break it up into sub-identifiers.
   my @subids = split /\./, $value;

# If there was a leading dot on _any_ OBJECT IDENTIFIER passed to
   # a prepare method, return a leading dot on _all_ of the OBJECT
   # IDENTIFIERs in the process methods.

if ($subids[0] eq q{}) {
      DEBUG_INFO('leading dot present');
      $this->{_leading_dot} = TRUE;
      shift @subids;
   }

# RFC 2578 Section 3.5 - "...there are at most 128 sub-identifiers in
   # a value, and each sub-identifier has a maximum value of 2^32-1..."

if (@subids > 128) {
      return $this->_error(
         'The OBJECT IDENTIFIER value "%s" contains more than the maximum ' .
         'of 128 sub-identifiers allowed', $value
      );
   }

if (grep { $_ < 0 || $_ > 4294967295; } @subids) {
      return $this->_error(
         'The OBJECT IDENTIFIER value "%s" contains a sub-identifier which ' .
         'is out of range (0..4294967295)', $value
      );
   }

# ISO/IEC 8825 - Specification of Basic Encoding Rules for Abstract
   # Syntax Notation One (ASN.1) dictates that the first two sub-identifiers
   # are encoded into the first identifier using the the equation:
   # subid = ((first * 40) + second).  Pad the OBJECT IDENTIFIER to at
   # least two sub-identifiers.

while (@subids < 2) {
      push @subids, 0;
   }

# The first sub-identifiers are limited to ccitt(0), iso(1), and
   # joint-iso-ccitt(2) as defined by RFC 2578.

if ($subids[0] > 2) {
      return $this->_error(
         'The OBJECT IDENTIFIER value "%s" must begin with either 0 ' .
         '(ccitt), 1 (iso), or 2 (joint-iso-ccitt)', $value
      );
   }

# If the first sub-identifier is 0 or 1, the second is limited to 0 - 39.

if (($subids[0] < 2) && ($subids[1] >= 40)) {
      return $this->_error(
         'The second sub-identifier in the OBJECT IDENTIFIER value "%s" ' .
         'must be less than 40', $value
      );
   } elsif ($subids[1] >= (4294967295 - 80)) {
      return $this->_error(
         'The second sub-identifier in the OBJECT IDENTIFIER value "%s" ' .
         'must be less than %u', $value, (4294967295 - 80)
      );
   }

# Now apply: subid = ((first * 40) + second)

$subids[1] += (shift(@subids) * 40);

# Encode each sub-identifier in base 128, most significant digit first,
   # with as few digits as possible.  Bit eight (the high bit) is set on
   # each byte except the last.

# Encode the ASN.1 header
   return $this->_prepare_type_length(OBJECT_IDENTIFIER, pack 'w*', @subids);
}

sub _prepare_sequence
{
   return $_[0]->_prepare_implicit_sequence(SEQUENCE, $_[1]);
}

sub _prepare_implicit_sequence
{
   my ($this, $type, $value) = @_;

if (defined $value) {
      return $this->_prepare_type_length($type, $value);
   }

# If the passed value is undefined, we assume that the value of
   # the IMPLICIT SEQUENCE is the data currently in the serial buffer.

if ($this->{_length} < 0x80) {
      return $this->_buffer_put(pack 'C2', $type, $this->{_length});
   } elsif ($this->{_length} <= 0xff) {
      return $this->_buffer_put(pack 'C3', $type, 0x81, $this->{_length});
   } elsif ($this->{_length} <= 0xffff) {
      return $this->_buffer_put(pack 'CCn', $type, 0x82, $this->{_length});
   }

return $this->_error('Unable to prepare the ASN.1 SEQUENCE length');
}

sub _prepare_ipaddress
{
   my ($this, $value) = @_;

if (!defined $value) {
      return $this->_error('IpAddress is not defined');
   }

if ($value !~ /^\d+\.\d+\.\d+\.\d+$/) {
      return $this->_error(
         'The IpAddress value "%s" is expected in dotted decimal notation',
         $value
      );
   }

my @octets = split /\./, $value;

if (grep { $_ > 255; } @octets) {
      return $this->_error('The IpAddress value "%s" is invalid', $value);
   }

return $this->_prepare_type_length(IPADDRESS, pack 'C4', @octets);
}

sub _prepare_counter
{
   return $_[0]->_prepare_unsigned32(COUNTER, $_[1]);
}

sub _prepare_gauge
{
   return $_[0]->_prepare_unsigned32(GAUGE, $_[1]);
}

sub _prepare_timeticks
{
   return $_[0]->_prepare_unsigned32(TIMETICKS, $_[1]);
}

sub _prepare_opaque
{
   my ($this, $value) = @_;

if (!defined $value) {
      return $this->_error('The Opaque value is not defined');
   }

return $this->_prepare_type_length(OPAQUE, $value);
}

sub _prepare_counter64
{
   my ($this, $value) = @_;

# Validate the SNMP version
   if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The Counter64 type is not supported in SNMPv1');
   }

# Validate the passed value
   if (!defined $value) {
      return $this->_error('The Counter64 value is not defined');
   }

if ($value !~ /^\+?\d+$/) {
      return $this->_error(
         'The Counter64 value "%s" is expected in positive numeric format',
         $value
      );
   }

$value = Math::BigInt->new($value);

if ($value eq 'NaN') {
      return $this->_error('The Counter64 value "%s" is invalid', $value);
   }

# Make sure the value is no more than 8 bytes long
   if ($value->bcmp('18446744073709551615') > 0) {
      return $this->_error(
          'The Counter64 value "%s" is out of range (0..18446744073709551615)',
          $value
      );
   }

my ($quotient, $remainder, @bytes);

# Handle a value of zero
   if ($value == 0) {
      unshift @bytes, 0x00;
   }

while ($value > 0) {
      ($quotient, $remainder) = $value->bdiv(256);
      $value = Math::BigInt->new($quotient);
      unshift @bytes, $remainder;
   }

# Make sure that the value is encoded as a positive value
   if ($bytes[0] & 0x80) {
      unshift @bytes, 0x00;
   }

return $this->_prepare_type_length(COUNTER64, pack 'C*', @bytes);
}

sub _prepare_nosuchobject
{
   my ($this) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The noSuchObject type is not supported in SNMPv1');
   }

return $this->_prepare_type_length(NOSUCHOBJECT, q{});
}

sub _prepare_nosuchinstance
{
   my ($this) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error(
         'The noSuchInstance type is not supported in SNMPv1'
      );
   }

return $this->_prepare_type_length(NOSUCHINSTANCE, q{});
}

sub _prepare_endofmibview
{
   my ($this) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The endOfMibView type is not supported in SNMPv1');
   }

return $this->_prepare_type_length(ENDOFMIBVIEW, q{});
}

sub _prepare_get_request
{
   return $_[0]->_prepare_implicit_sequence(GET_REQUEST, $_[1]);
}

sub _prepare_get_next_request
{
   return $_[0]->_prepare_implicit_sequence(GET_NEXT_REQUEST, $_[1]);
}

sub _prepare_get_response
{
   return $_[0]->_prepare_implicit_sequence(GET_RESPONSE, $_[1]);
}

sub _prepare_set_request
{
   return $_[0]->_prepare_implicit_sequence(SET_REQUEST, $_[1]);
}

sub _prepare_trap
{
   my ($this, $value) = @_;

if ($this->{_version} != SNMP_VERSION_1) {
      return $this->_error('The Trap-PDU is only supported in SNMPv1');
   }

return $this->_prepare_implicit_sequence(TRAP, $value);
}

sub _prepare_get_bulk_request
{
   my ($this, $value) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error(
         'The GetBulkRequest-PDU is not supported in SNMPv1'
      );
   }

return $this->_prepare_implicit_sequence(GET_BULK_REQUEST, $value);
}

sub _prepare_inform_request
{
   my ($this, $value) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The InformRequest-PDU is not supported in SNMPv1');
   }

return $this->_prepare_implicit_sequence(INFORM_REQUEST, $value);
}

sub _prepare_v2_trap
{
   my ($this, $value) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The SNMPv2-Trap-PDU is not supported in SNMPv1');
   }

return $this->_prepare_implicit_sequence(SNMPV2_TRAP, $value);
}

sub _prepare_report
{
   my ($this, $value) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The Report-PDU is not supported in SNMPv1');
   }

return $this->_prepare_implicit_sequence(REPORT, $value);
}

#
# Basic Encoding Rules (BER) process methods
#

sub _process_length
{
   my ($this) = @_;

return $this->_error() if defined $this->{_error};

my $length = $this->_buffer_get(1);

if (!defined $length) {
      return $this->_error();
   }

$length = unpack 'C', $length;

if (!($length & 0x80)) { # "Short" length
      return $length;
   }

my $byte_cnt = $length & 0x7f;

if ($byte_cnt == 0) {
      return $this->_error('Indefinite ASN.1 lengths are not supported');
   } elsif ($byte_cnt > 4) {
      return $this->_error(
         'The ASN.1 length is too long (%u bytes)', $byte_cnt
      );
   }

if (!defined($length = $this->_buffer_get($byte_cnt))) {
      return $this->_error();
   }

return unpack 'N', ("\000" x (4 - $byte_cnt) . $length);
}

sub _process_integer32
{
   my ($this, $type) = @_;

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

# Return an error if the object length is zero?
   if ($length < 1) {
      return $this->_error('The %s length is equal to zero', asn1_itoa($type));
   }

# Retrieve the whole byte stream outside of the loop.
   return $this->_error() if !defined(my $bytes = $this->_buffer_get($length));

my @bytes = unpack 'C*', $bytes;
   my $negative = FALSE;
   my $int32 = 0;

# Validate the length of the Integer32
   if (($length > 5) || (($length > 4) && ($bytes[0] != 0x00))) {
      return $this->_error(
         'The %s length is too long (%u bytes)', asn1_itoa($type), $length
      );
   }

# If the first bit is set, the Integer32 is negative
   if ($bytes[0] & 0x80) {
      $int32 = -1;
      $negative = TRUE;
   }

# Build the Integer32
   map { $int32 = (($int32 << 8) | $_) } @bytes;

if ($negative) {
      if (($type == INTEGER) || (!($this->{_translate} & TRANSLATE_UNSIGNED))) {
         return unpack 'l', pack 'l', $int32;
      } else {
         DEBUG_INFO('translating negative %s value', asn1_itoa($type));
         return unpack 'L', pack 'l', $int32;
      }
   }

return unpack 'L', pack 'L', $int32;
}

sub _process_octet_string
{
   my ($this, $type) = @_;

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

# Get the string
   return $this->_error() if !defined(my $s = $this->_buffer_get($length));

# Set the translation mask
   my $mask = ($type == OPAQUE) ? TRANSLATE_OPAQUE : TRANSLATE_OCTET_STRING;

#
   # Translate based on the definition of a DisplayString in RFC 2579.
   #
   #  DisplayString ::= TEXTUAL-CONVENTION
   # 
   #  - the graphics characters (32-126) are interpreted as
   #    US ASCII
   #  - NUL, LF, CR, BEL, BS, HT, VT and FF have the special
   #    meanings specified in RFC 854
   #  - the sequence 'CR x' for any x other than LF or NUL is
   #    illegal.
   #

if ($this->{_translate} & $mask) {
      $type = asn1_itoa($type);
      if ($s =~ m{
          #  The values other than NUL, LF, CR, BEL, BS, HT, VT, FF,
          #  and the graphic characters (32-126) trigger translation.
             [\x01-\x06\x0e-\x1f\x7f-\xff]|
          #  The sequence 'CR x' for any x other than LF or NUL
          #  also triggers translation.
             \x0d(?![\x00\x0a])
          }x)
      {
         DEBUG_INFO(
            'translating %s to hexadecimal formatted DisplayString', $type
         );
         return sprintf '0x%s', unpack 'H*', $s;
      } else {
         DEBUG_INFO(
            'not translating %s, all octets are allowed in a DisplayString',
            $type
         );
      }
   }

return $s;
}

sub _process_null
{
   my ($this) = @_;

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

return $this->_error('NULL length is not equal to zero') if ($length != 0);

if ($this->{_translate} & TRANSLATE_NULL) {
      DEBUG_INFO(q{translating NULL to 'NULL' string});
      return 'NULL';
   }

return q{};
}

sub _process_object_identifier
{
   my ($this) = @_;

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

# Return an error if the length is equal to zero?
   if ($length < 1) {
      return $this->_error('The OBJECT IDENTIFIER length is equal to zero');
   }

# Retrieve the whole byte stream (by Niilo Neuvo).

return $this->_error() if !defined(my $bytes = $this->_buffer_get($length));

my @oid = ( 0, eval { unpack 'w129', $bytes } );

# RFC 2578 Section 3.5 - "...there are at most 128 sub-identifiers in
   # a value, and each sub-identifier has a maximum value of 2^32-1..."

if ($@ || (grep { $_ > 4294967295; } @oid)) {
      return $this->_error(
         'The OBJECT IDENTIFIER contains a sub-identifier which is out of ' .
         'range (0..4294967295)'
      );
   }

if (@oid > 128) {
      return $this->_error(
         'The OBJECT IDENTIFIER contains more than the maximum of 128 ' .
         'sub-identifiers allowed'
      );
   }

# The first two sub-identifiers are encoded into the first identifier
   # using the the equation: subid = ((first * 40) + second).

if ($oid[1] == 0x2b) {   # Handle the most common case
      $oid[0] = 1;          # first [iso(1).org(3)]
      $oid[1] = 3;
   } elsif ($oid[1] < 40) {
      $oid[0] = 0;
   } elsif ($oid[1] < 80) {
      $oid[0] = 1;
      $oid[1] -= 40;
   } else {
      $oid[0] = 2;
      $oid[1] -= 80;
   }

# Return the OID in dotted notation (optionally with a 
   # leading dot if one was passed to the prepare routine).

if ($this->{_leading_dot}) {
      DEBUG_INFO('adding leading dot');
      unshift @oid, q{};
   }

return join q{.}, @oid;
}

sub _process_sequence
{
   # Return the length, instead of the value
   goto &_process_length;
}

sub _process_ipaddress
{
   my ($this) = @_;

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

if ($length != 4) {
      return $this->_error('The IpAddress length of %d is invalid', $length);
   }

if (defined(my $ipaddress = $this->_buffer_get(4))) {
      return sprintf '%vd', $ipaddress;
   }

return $this->_error();
}

sub _process_counter
{
   goto &_process_integer32;
}

sub _process_gauge
{
   goto &_process_integer32;
}

sub _process_timeticks
{
   my ($this) = @_;

if (defined(my $ticks = $this->_process_integer32(TIMETICKS))) {
      if ($this->{_translate} & TRANSLATE_TIMETICKS) {
         DEBUG_INFO('translating %u TimeTicks to time', $ticks);
         return asn1_ticks_to_time($ticks);
      } else {
         return $ticks;
      }
   }

return $this->_error();
}

sub _process_opaque
{
   goto &_process_octet_string;
}

sub _process_counter64
{
   my ($this, $type) = @_;

# Verify the SNMP version
   if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The Counter64 type is not supported in SNMPv1');
   }

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

# Return an error if the object length is zero?
   if ($length < 1) {
      return $this->_error('The Counter64 length is equal to zero');
   }

# Retrieve the whole byte stream outside of the loop.
   return $this->_error() if !defined(my $bytes = $this->_buffer_get($length));

my @bytes = unpack 'C*', $bytes;
   my $negative = FALSE;

# Validate the length of the Counter64
   if (($length > 9) || (($length > 8) && ($bytes[0] != 0x00))) {
      return $_[0]->_error(
          'The Counter64 length is too long (%u bytes)', $length
      );
   }

# If the first bit is set, the integer is negative
   if ($bytes[0] & 0x80) {
      $bytes[0] ^= 0xff;
      $negative = TRUE;
   }

# Build the Counter64
   my $int64 = Math::BigInt->new(shift @bytes);
   map {
      if ($negative) { $_ ^= 0xff; }
      $int64 *= 256;
      $int64 += $_;
   } @bytes;

# If the value is negative the other end incorrectly encoded
   # the Counter64 since it should always be a positive value.

if ($negative) {
      $int64 = Math::BigInt->new('-1') - $int64;
      if ($this->{_translate} & TRANSLATE_UNSIGNED) {
         DEBUG_INFO('translating negative Counter64 value');
         $int64 += Math::BigInt->new('18446744073709551616');
      }
   }

# Perl 5.6.0 (force to string or substitution does not work).
   $int64 .= q{};

# Remove the plus sign (or should we leave it to imply Math::BigInt?)
   $int64 =~ s/^\+//;

return $int64;
}

sub _process_nosuchobject
{
   my ($this) = @_;

# Verify the SNMP version
   if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The noSuchObject type is not supported in SNMPv1');
   }

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

if ($length != 0) {
      return $this->_error('The noSuchObject length is not equal to zero');
   }

if ($this->{_translate} & TRANSLATE_NOSUCHOBJECT) {
      DEBUG_INFO(q{translating noSuchObject to 'noSuchObject' string});
      return 'noSuchObject';
   }

# XXX: Releases greater than v5.2.0 longer set the error-status.
   # $this->{_error_status} = NOSUCHOBJECT;

return q{};
}

sub _process_nosuchinstance
{
   my ($this) = @_;

# Verify the SNMP version
   if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error(
         'The noSuchInstance type is not supported in SNMPv1'
      );
   }

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

if ($length != 0) {
      return $this->_error('The noSuchInstance length is not equal to zero');
   }

if ($this->{_translate} & TRANSLATE_NOSUCHINSTANCE) {
      DEBUG_INFO(q{translating noSuchInstance to 'noSuchInstance' string});
      return 'noSuchInstance';
   }

# XXX: Releases greater than v5.2.0 longer set the error-status. 
   # $this->{_error_status} = NOSUCHINSTANCE;

return q{};
}

sub _process_endofmibview
{
   my ($this) = @_;

# Verify the SNMP version
   if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The endOfMibView type is not supported in SNMPv1');
   }

# Decode the length
   return $this->_error() if !defined(my $length = $this->_process_length());

if ($length != 0) {
      return $this->_error('The endOfMibView length is not equal to zero');
   }

if ($this->{_translate} & TRANSLATE_ENDOFMIBVIEW) {
      DEBUG_INFO(q{translating endOfMibView to 'endOfMibView' string});
      return 'endOfMibView';
   }

# XXX: Releases greater than v5.2.0 longer set the error-status.
   # $this->{_error_status} = ENDOFMIBVIEW;

return q{};
}

sub _process_pdu_type
{
   my ($this, $type) = @_;

# Generic methods used to process the PDU type.  The ASN.1 type is
   # returned by the method as passed by the generic process routine.

return defined($this->_process_length()) ? $type : $this->_error();
}

sub _process_get_request
{
   goto &_process_pdu_type;
}

sub _process_get_next_request
{
   goto &_process_pdu_type;
}

sub _process_get_response
{
   goto &_process_pdu_type;
}

sub _process_set_request
{
   goto &_process_pdu_type;
}

sub _process_trap
{
   my ($this) = @_;

if ($this->{_version} != SNMP_VERSION_1) {
      return $this->_error('The Trap-PDU is only supported in SNMPv1');
   }

goto &_process_pdu_type;
}

sub _process_get_bulk_request
{
   my ($this) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The GetBulkRequest-PDU is not supported in SNMPv1');
   }

goto &_process_pdu_type;
}

sub _process_inform_request
{
   my ($this) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The InformRequest-PDU is not supported in SNMPv1');
   }

goto &_process_pdu_type;
}

sub _process_v2_trap
{
   my ($this) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The SNMPv2-Trap-PDU is not supported in SNMPv1');
   }

goto &_process_pdu_type;
}

sub _process_report
{
   my ($this) = @_;

if ($this->{_version} == SNMP_VERSION_1) {
      return $this->_error('The Report-PDU is not supported in SNMPv1');
   }

goto &_process_pdu_type;
}

#
# Abstract Syntax Notation One (ASN.1) utility functions
#

{
   my $types = {
      INTEGER,            'INTEGER',
      OCTET_STRING,       'OCTET STRING',
      NULL,               'NULL',
      OBJECT_IDENTIFIER,  'OBJECT IDENTIFIER',
      SEQUENCE,           'SEQUENCE',
      IPADDRESS,          'IpAddress',
      COUNTER,            'Counter',
      GAUGE,              'Gauge',
      TIMETICKS,          'TimeTicks',
      OPAQUE,             'Opaque',
      COUNTER64,          'Counter64',
      NOSUCHOBJECT,       'noSuchObject',
      NOSUCHINSTANCE,     'noSuchInstance',
      ENDOFMIBVIEW,       'endOfMibView',
      GET_REQUEST,        'GetRequest-PDU',
      GET_NEXT_REQUEST,   'GetNextRequest-PDU',
      GET_RESPONSE,       'GetResponse-PDU',
      SET_REQUEST,        'SetRequest-PDU',
      TRAP,               'Trap-PDU',
      GET_BULK_REQUEST,   'GetBulkRequest-PDU',
      INFORM_REQUEST,     'InformRequest-PDU',
      SNMPV2_TRAP,        'SNMPv2-Trap-PDU',
      REPORT,             'Report-PDU'
   };

sub asn1_itoa
   {
      my ($type) = @_;

return q{??} if (@_ != 1);

if (!exists $types->{$type}) {
         return sprintf '?? [0x%02x]', $type;
      }

return $types->{$type};
   }
}

sub asn1_ticks_to_time
{
   my $ticks = shift || 0;

my $days = int($ticks / (24 * 60 * 60 * 100));
   $ticks %= (24 * 60 * 60 * 100);

my $hours = int($ticks / (60 * 60 * 100));
   $ticks %= (60 * 60 * 100);

my $minutes = int($ticks / (60 * 100));
   $ticks %= (60 * 100);

my $seconds = ($ticks / 100);

if ($days != 0){
      return sprintf '%d day%s, %02d:%02d:%05.02f', $days,
         ($days == 1 ? q{} : 's'), $hours, $minutes, $seconds;
   } elsif ($hours != 0) {
      return sprintf '%d hour%s, %02d:%05.02f', $hours,
         ($hours == 1 ? q{} : 's'), $minutes, $seconds;
   } elsif ($minutes != 0) {
      return sprintf '%d minute%s, %05.02f', $minutes,
         ($minutes == 1 ? q{} : 's'), $seconds;
   } else {
      return sprintf '%04.02f second%s', $seconds, ($seconds == 1 ? q{} : 's');
   }
}

#
# Error handlers
#

sub _error
{
   my $this = shift;

if (!defined $this->{_error}) {
      $this->{_error} = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0];
      if ($this->debug()) {
         printf "error: [%d] %s(): %s\n",
                (caller 0)[2], (caller 1)[3], $this->{_error};
      }
   }

return;
}

sub _error_clear
{
   return $_[0]->{_error} = undef;
}

#
# Buffer manipulation methods
#

sub _buffer_append
{
#  my ($this, $value) = @_;

return $_[0]->_error() if defined $_[0]->{_error};

# Always reset the index when the buffer is modified
   $_[0]->{_index} = 0;

# Update our length
   $_[0]->{_length} += CORE::length($_[1]);

# Append to the current buffer
   return $_[0]->{_buffer} .= $_[1];
}

sub _buffer_get
{
   my ($this, $requested) = @_;

return $this->_error() if defined $this->{_error};

# Return the number of bytes requested at the current index or 
   # clear and return the whole buffer if no argument is passed.

if (@_ == 2) {

if (($this->{_index} += $requested) > $this->{_length}) {
         $this->{_index} -= $requested;
         if ($this->{_length} >= $this->max_msg_size()) {
            return $this->_error(
               'The message size exceeded the buffer maxMsgSize of %d',
               $this->max_msg_size()
            );
         }
         return $this->_error('Unexpected end of message buffer');
      }

return substr $this->{_buffer}, $this->{_index} - $requested, $requested;
   }

# Always reset the index when the buffer is modified
   $this->{_index} = 0;

# Update our length to 0, the whole buffer is about to be cleared.
   $this->{_length} = 0;

return substr $this->{_buffer}, 0, CORE::length($this->{_buffer}), q{};
}

sub _buffer_put
{
#  my ($this, $value) = @_;

return $_[0]->_error() if defined $_[0]->{_error};

# Always reset the index when the buffer is modified
   $_[0]->{_index} = 0;

# Update our length
   $_[0]->{_length} += CORE::length($_[1]);

# Add the prefix to the current buffer
   substr $_[0]->{_buffer}, 0, 0, $_[1];

return $_[0]->{_buffer};
}

sub _buffer_dump
{
   my ($this) = @_;

return $DEBUG if (!$DEBUG);

DEBUG_INFO('%d byte%s', $this->{_length}, $this->{_length} != 1 ? 's' : q{});

my ($offset, $hex, $text) = (0, q{}, q{});

while ($this->{_buffer} =~ /(.{1,16})/gs) {
      $hex  = unpack 'H*', ($text = $1);
      $hex .= q{ } x (32 - CORE::length($hex));
      $hex  = sprintf '%s %s %s %s  ' x 4, unpack 'a2' x 16, $hex;
      $text =~ s/[\x00-\x1f\x7f-\xff]/./g;
      printf "[%04d]  %s %s\n", $offset, uc($hex), $text;
      $offset += 16;
   }

return $DEBUG;
}

sub DEBUG_INFO
{
   return $DEBUG if (!$DEBUG);

return printf
      sprintf('debug: [%d] %s(): ', (caller 0)[2], (caller 1)[3]) .
      ((@_ > 1) ? shift(@_) : '%s') .
      "\n",
      @_;
}

# ============================================================================
1; # [end Net::SNMP::Message]

Vazgeç