Server IP : 85.214.239.14 / Your IP : 3.135.247.24 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /proc/2/cwd/usr/share/perl5/Net/SNMP/ |
Upload File : |
# -*- 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. # Copyright (c) 2001-2010 David M. Town <dtown@cpan.org> # All rights reserved. # 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]