��ѧۧݧ�ӧ�� ާ֧ߧ֧էا֧�

��ѧۧݧ�ӧ�� ާ֧ߧ֧էا֧� - ��֧էѧܧ�ڧ��ӧѧ�� - /home/ukubnwwtacc0unt/chapelbellstudios.com/uploads/cover/SNMP.zip

��ѧ٧ѧ�
PK��X�\��%����Security/USM.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Security::USM; # $Id: USM.pm,v 4.1 2010/09/10 00:01:22 dtown Rel $ # Object that implements the SNMPv3 User-based Security Model. # 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 Net::SNMP::Security qw( :ALL ); use Net::SNMP::Message qw( :msgFlags asn1_itoa OCTET_STRING SEQUENCE INTEGER SNMP_VERSION_3 TRUE FALSE ); use Crypt::DES(); use Digest::MD5(); use Digest::SHA1(); use Digest::HMAC(); ## Version of the Net::SNMP::Security::USM module our $VERSION = v4.0.1; ## Handle importing/exporting of symbols use base qw( Net::SNMP::Security ); our @EXPORT_OK; our %EXPORT_TAGS = ( authprotos => [ qw( AUTH_PROTOCOL_NONE AUTH_PROTOCOL_HMACMD5 AUTH_PROTOCOL_HMACSHA ) ], levels => [ qw( SECURITY_LEVEL_NOAUTHNOPRIV SECURITY_LEVEL_AUTHNOPRIV SECURITY_LEVEL_AUTHPRIV ) ], models => [ qw( SECURITY_MODEL_ANY SECURITY_MODEL_SNMPV1 SECURITY_MODEL_SNMPV2C SECURITY_MODEL_USM ) ], privprotos => [ qw( PRIV_PROTOCOL_NONE PRIV_PROTOCOL_DES PRIV_PROTOCOL_AESCFB128 PRIV_PROTOCOL_DRAFT_3DESEDE PRIV_PROTOCOL_DRAFT_AESCFB128 PRIV_PROTOCOL_DRAFT_AESCFB192 PRIV_PROTOCOL_DRAFT_AESCFB256 ) ], ); Exporter::export_ok_tags( qw( authprotos levels models privprotos ) ); $EXPORT_TAGS{ALL} = [ @EXPORT_OK ]; ## RCC 3414 - Authentication protocols sub AUTH_PROTOCOL_NONE { '1.3.6.1.6.3.10.1.1.1' } # usmNoAuthProtocol sub AUTH_PROTOCOL_HMACMD5 { '1.3.6.1.6.3.10.1.1.2' } # usmHMACMD5AuthProtocol sub AUTH_PROTOCOL_HMACSHA { '1.3.6.1.6.3.10.1.1.3' } # usmHMACSHAAuthProtocol ## RFC 3414 - Privacy protocols sub PRIV_PROTOCOL_NONE { '1.3.6.1.6.3.10.1.2.1' } # usmNoPrivProtocol sub PRIV_PROTOCOL_DES { '1.3.6.1.6.3.10.1.2.2' } # usmDESPrivProtocol ## RFC 3826 - The AES Cipher Algorithm in the SNMP USM # usmAesCfb128Protocol sub PRIV_PROTOCOL_AESCFB128 { '1.3.6.1.6.3.10.1.2.4' } # The privacy protocols below have been implemented using the draft # specifications intended to extend the User-based Security Model # defined in RFC 3414. Since the object definitions have not been # standardized, they have been based on the Extended Security Options # Consortium MIB found at http://www.snmp.com/eso/esoConsortiumMIB.txt. # Extension to Support Triple-DES EDE <draft-reeder-snmpv3-usm-3desede-00.txt> # Reeder and Gudmunsson; October 1999, expired April 2000 # usm3DESPrivProtocol sub PRIV_PROTOCOL_DRAFT_3DESEDE { '1.3.6.1.4.1.14832.1.1' } # AES Cipher Algorithm in the USM <draft-blumenthal-aes-usm-04.txt> # Blumenthal, Maino, and McCloghrie; October 2002, expired April 2003 # usmAESCfb128PrivProtocol sub PRIV_PROTOCOL_DRAFT_AESCFB128 { '1.3.6.1.4.1.14832.1.2' } # usmAESCfb192PrivProtocol sub PRIV_PROTOCOL_DRAFT_AESCFB192 { '1.3.6.1.4.1.14832.1.3' } # usmAESCfb256PrivProtocol sub PRIV_PROTOCOL_DRAFT_AESCFB256 { '1.3.6.1.4.1.14832.1.4' } ## Package variables our $ENGINE_ID; # Our authoritative snmpEngineID # [public methods] ----------------------------------------------------------- sub new { my ($class, %argv) = @_; # Create a new data structure for the object my $this = bless { '_error' => undef, # Error message '_version' => SNMP_VERSION_3, # version '_authoritative' => FALSE, # Authoritative flag '_discovered' => FALSE, # Engine discovery flag '_synchronized' => FALSE, # Synchronization flag '_engine_id' => q{}, # snmpEngineID '_engine_boots' => 0, # snmpEngineBoots '_engine_time' => 0, # snmpEngineTime '_latest_engine_time' => 0, # latestReceivedEngineTime '_time_epoc' => time(), # snmpEngineBoots epoc '_user_name' => q{}, # securityName '_auth_data' => undef, # Authentication data '_auth_key' => undef, # authKey '_auth_password' => undef, # Authentication password '_auth_protocol' => AUTH_PROTOCOL_HMACMD5, # authProtocol '_priv_data' => undef, # Privacy data '_priv_key' => undef, # privKey '_priv_password' => undef, # Privacy password '_priv_protocol' => PRIV_PROTOCOL_DES, # privProtocol '_security_level' => SECURITY_LEVEL_NOAUTHNOPRIV }, $class; # We first need to find out if we are an authoritative SNMP # engine and set the authProtocol and privProtocol if they # have been provided. foreach (keys %argv) { if (/^-?authoritative$/i) { $this->{_authoritative} = (delete $argv{$_}) ? TRUE : FALSE; } elsif (/^-?authprotocol$/i) { $this->_auth_protocol(delete $argv{$_}); } elsif (/^-?privprotocol$/i) { $this->_priv_protocol(delete $argv{$_}); } if (defined $this->{_error}) { return wantarray ? (undef, $this->{_error}) : undef; } } # Now validate the rest of the passed arguments for (keys %argv) { if (/^-?version$/i) { $this->_version($argv{$_}); } elsif (/^-?debug$/i) { $this->debug($argv{$_}); } elsif ((/^-?engineid$/i) && ($this->{_authoritative})) { $this->_engine_id($argv{$_}); } elsif (/^-?username$/i) { $this->_user_name($argv{$_}); } elsif (/^-?authkey$/i) { $this->_auth_key($argv{$_}); } elsif (/^-?authpassword$/i) { $this->_auth_password($argv{$_}); } elsif (/^-?privkey$/i) { $this->_priv_key($argv{$_}); } elsif (/^-?privpassword$/i) { $this->_priv_password($argv{$_}); } else { $this->_error('The argument "%s" is unknown', $_); } if (defined $this->{_error}) { return wantarray ? (undef, $this->{_error}) : undef; } } # Generate a snmpEngineID and populate the object accordingly # if we are an authoritative snmpEngine. if ($this->{_authoritative}) { $this->_snmp_engine_init(); } # Define the securityParameters if (!defined $this->_security_params()) { return wantarray ? (undef, $this->{_error}) : undef; } # Return the object and an empty error message (in list context) return wantarray ? ($this, q{}) : $this; } sub generate_request_msg { my ($this, $pdu, $msg) = @_; # Clear any previous errors $this->_error_clear(); if (@_ < 3) { return $this->_error('The required PDU and/or Message object is missing'); } # Validate the SNMP version of the PDU if ($pdu->version() != $this->{_version}) { return $this->_error( 'The SNMP version %d was expected, but %d was found', $this->{_version}, $pdu->version() ); } # Validate the securityLevel of the PDU if ($pdu->security_level() > $this->{_security_level}) { return $this->_error( 'The PDU securityLevel %d is greater than the configured value %d', $pdu->security_level(), $this->{_security_level} ); } # Validate PDU type with snmpEngine type if ($pdu->expect_response()) { if ($this->{_authoritative}) { return $this->_error( 'Must be a non-authoritative SNMP engine to generate a %s', asn1_itoa($pdu->pdu_type()) ); } } else { if (!$this->{_authoritative}) { return $this->_error( 'Must be an authoritative SNMP engine to generate a %s', asn1_itoa($pdu->pdu_type()) ); } } # Extract the msgGlobalData out of the message my $msg_global_data = $msg->clear(); # AES in the USM Section 3.1.2.1 - "The 128-bit IV is obtained as # the concatenation of the... ...snmpEngineBoots, ...snmpEngineTime, # and a local 64-bit integer. We store the current snmpEngineBoots # and snmpEngineTime before encrypting the PDU so that the computed # IV matches the transmitted msgAuthoritativeEngineBoots and # msgAuthoritativeEngineTime. my $msg_engine_time = $this->_engine_time(); my $msg_engine_boots = $this->_engine_boots(); # Copy the PDU into a "plain text" buffer my $pdu_buffer = $pdu->copy(); my $priv_params = q{}; # encryptedPDU::=OCTET STRING if ($pdu->security_level() > SECURITY_LEVEL_AUTHNOPRIV) { if (!defined $this->_encrypt_data($msg, $priv_params, $pdu_buffer)) { return $this->_error(); } } # msgPrivacyParameters::=OCTET STRING if (!defined $msg->prepare(OCTET_STRING, $priv_params)) { return $this->_error($msg->error()); } # msgAuthenticationParameters::=OCTET STRING my $auth_params = q{}; my $auth_location = 0; if ($pdu->security_level() > SECURITY_LEVEL_NOAUTHNOPRIV) { # Save the location to fill in msgAuthenticationParameters later $auth_location = $msg->length() + 12 + length $pdu_buffer; # Set the msgAuthenticationParameters to all zeros $auth_params = pack 'x12'; } if (!defined $msg->prepare(OCTET_STRING, $auth_params)) { return $this->_error($msg->error()); } # msgUserName::=OCTET STRING if (!defined $msg->prepare(OCTET_STRING, $pdu->security_name())) { return $this->_error($msg->error()); } # msgAuthoritativeEngineTime::=INTEGER if (!defined $msg->prepare(INTEGER, $msg_engine_time)) { return $this->_error($msg->error()); } # msgAuthoritativeEngineBoots::=INTEGER if (!defined $msg->prepare(INTEGER, $msg_engine_boots)) { return $this->_error($msg->error()); } # msgAuthoritativeEngineID if (!defined $msg->prepare(OCTET_STRING, $this->_engine_id())) { return $this->_error($msg->error()); } # UsmSecurityParameters::= SEQUENCE if (!defined $msg->prepare(SEQUENCE)) { return $this->_error($msg->error()); } # msgSecurityParameters::=OCTET STRING if (!defined $msg->prepare(OCTET_STRING, $msg->clear())) { return $this->_error($msg->error()); } # Append the PDU if (!defined $msg->append($pdu_buffer)) { return $this->_error($msg->error()); } # Prepend the msgGlobalData if (!defined $msg->prepend($msg_global_data)) { return $this->_error($msg->error()); } # version::=INTEGER if (!defined $msg->prepare(INTEGER, $this->{_version})) { return $this->_error($msg->error()); } # message::=SEQUENCE if (!defined $msg->prepare(SEQUENCE)) { return $this->_error($msg->error()); } # Apply authentication if ($pdu->security_level() > SECURITY_LEVEL_NOAUTHNOPRIV) { if (!defined $this->_authenticate_outgoing_msg($msg, $auth_location)) { return $this->_error($msg->error()); } } # Return the Message return $msg; } sub process_incoming_msg { my ($this, $msg) = @_; # Clear any previous errors $this->_error_clear(); return $this->_error('The required Message object is missing') if (@_ < 2); # msgSecurityParameters::=OCTET STRING my $msg_params = $msg->process(OCTET_STRING); return $this->_error($msg->error()) if !defined $msg_params; # Need to move the buffer index back to the begining of the data # portion of the OCTET STRING that contains the msgSecurityParameters. $msg->index($msg->index() - length $msg_params); # UsmSecurityParameters::=SEQUENCE return $this->_error($msg->error()) if !defined $msg->process(SEQUENCE); # msgAuthoritativeEngineID::=OCTET STRING my $msg_engine_id; if (!defined($msg_engine_id = $msg->process(OCTET_STRING))) { return $this->_error($msg->error()); } # msgAuthoritativeEngineBoots::=INTEGER (0..2147483647) my $msg_engine_boots; if (!defined ($msg_engine_boots = $msg->process(INTEGER))) { return $this->_error($msg->error()); } if (($msg_engine_boots < 0) \|\| ($msg_engine_boots > 2147483647)) { return $this->_error( 'The msgAuthoritativeEngineBoots value %d is out of range ' . '(0..2147483647)', $msg_engine_boots ); } # msgAuthoritativeEngineTime::=INTEGER (0..2147483647) my $msg_engine_time; if (!defined ($msg_engine_time = $msg->process(INTEGER))) { return $this->_error($msg->error()); } if (($msg_engine_time < 0) \|\| ($msg_engine_time > 2147483647)) { return $this->_error( 'The msgAuthoritativeEngineTime value %d is out of range ' . '(0..2147483647)', $msg_engine_time ); } # msgUserName::=OCTET STRING (SIZE(0..32)) if (!defined $msg->security_name($msg->process(OCTET_STRING))) { return $this->_error($msg->error()); } # msgAuthenticationParameters::=OCTET STRING my $auth_params; if (!defined ($auth_params = $msg->process(OCTET_STRING))) { return $this->_error($msg->error()); } # We need to zero out the msgAuthenticationParameters in order # to compute the HMAC properly. if (my $len = length $auth_params) { if ($len != 12) { return $this->_error( 'The msgAuthenticationParameters length of %d is invalid', $len ); } substr ${$msg->reference}, ($msg->index() - 12), 12, pack 'x12'; } # msgPrivacyParameters::=OCTET STRING my $priv_params; if (!defined ($priv_params = $msg->process(OCTET_STRING))) { return $this->_error($msg->error()); } # Validate the msgAuthoritativeEngineID and msgUserName if ($this->{_discovered}) { if ($msg_engine_id ne $this->_engine_id()) { return $this->_error( 'The msgAuthoritativeEngineID "%s" was expected, but "%s" was ' . 'found', unpack('H', $this->_engine_id()), unpack 'H', $msg_engine_id ); } if ($msg->security_name() ne $this->_user_name()) { return $this->_error( 'The msgUserName "%s" was expected, but "%s" was found', $this->_user_name(), $msg->security_name() ); } } else { # Handle authoritativeEngineID discovery if (!defined $this->_engine_id_discovery($msg_engine_id)) { return $this->_error(); } } # Validate the incoming securityLevel my $security_level = $msg->security_level(); if ($security_level > $this->{_security_level}) { return $this->_error( 'The message securityLevel %d is greater than the configured ' . 'value %d', $security_level, $this->{_security_level} ); } if ($security_level > SECURITY_LEVEL_NOAUTHNOPRIV) { # Authenticate the message if (!defined $this->_authenticate_incoming_msg($msg, $auth_params)) { return $this->_error(); } # Synchronize the time if (!$this->_synchronize($msg_engine_boots, $msg_engine_time)) { return $this->_error(); } # Check for timeliness if (!defined $this->_timeliness($msg_engine_boots, $msg_engine_time)) { return $this->_error(); } if ($security_level > SECURITY_LEVEL_AUTHNOPRIV) { # Validate the msgPrivacyParameters length. if (length($priv_params) != 8) { return $this->_error( 'The msgPrivacyParameters length of %d is invalid', length $priv_params ); } # AES in the USM Section 3.1.2.1 - "The 128-bit IV is # obtained as the concatenation of the... ...snmpEngineBoots, # ...snmpEngineTime, and a local 64-bit integer. ...The # 64-bit integer must be placed in the msgPrivacyParameters # field..." We must prepend the snmpEngineBoots and # snmpEngineTime as received in order to compute the IV. if (($this->{_priv_protocol} eq PRIV_PROTOCOL_AESCFB128) \|\| ($this->{_priv_protocol} eq PRIV_PROTOCOL_DRAFT_AESCFB192) \|\| ($this->{_priv_protocol} eq PRIV_PROTOCOL_DRAFT_AESCFB256)) { substr $priv_params, 0, 0, pack 'NN', $msg_engine_boots, $msg_engine_time; } # encryptedPDU::=OCTET STRING return $this->_decrypt_data($msg, $priv_params, $msg->process(OCTET_STRING)); } } return TRUE; } sub user_name { return $_[0]->{_user_name}; } sub auth_protocol { my ($this) = @_; if ($this->{_security_level} > SECURITY_LEVEL_NOAUTHNOPRIV) { return $this->{_auth_protocol}; } return AUTH_PROTOCOL_NONE; } sub auth_key { return $_[0]->{_auth_key}; } sub priv_protocol { my ($this) = @_; if ($this->{_security_level} > SECURITY_LEVEL_AUTHNOPRIV) { return $this->{_priv_protocol}; } return PRIV_PROTOCOL_NONE; } sub priv_key { return $_[0]->{_priv_key}; } sub engine_id { return $_[0]->{_engine_id}; } sub engine_boots { goto _engine_boots; } sub engine_time { goto &_engine_time; } sub security_level { return $_[0]->{_security_level}; } sub security_model { # RFC 3411 - SnmpSecurityModel::=TEXTUAL-CONVENTION return SECURITY_MODEL_USM; } sub security_name { goto &_user_name; } sub discovered { my ($this) = @_; if ($this->{_security_level} > SECURITY_LEVEL_NOAUTHNOPRIV) { return ($this->{_discovered} && $this->{_synchronized}); } return $this->{_discovered}; } # [private methods] ---------------------------------------------------------- sub _version { my ($this, $version) = @_; if ($version != SNMP_VERSION_3) { return $this->_error('The SNMP version %s is not supported', $version); } return $this->{_version} = $version; } sub _engine_id { my ($this, $engine_id) = @_; if (@_ < 2) { return $this->{_engine_id}; } if ($engine_id =~ m/^(?:0x)?([A-F0-9]+)$/i) { my $eid = pack 'H', length($1) % 2 ? '0'.$1 : $1; my $len = length $eid; if ($len < 5 \|\| $len > 32) { return $this->_error( 'The authoritativeEngineID length of %d is out of range (5..32)', $len ); } $this->{_engine_id} = $eid; } else { return $this->_error( 'The authoritativeEngineID "%s" is expected in hexadecimal format', $engine_id ); } return $this->{_engine_id}; } sub _user_name { my ($this, $user_name) = @_; if (@_ == 2) { if ($user_name eq q{}) { return $this->_error('An empty userName was specified'); } elsif (length($user_name) > 32) { return $this->_error( 'The userName length of %d is out of range (1..32)', length $user_name ); } $this->{_user_name} = $user_name; } # RFC 3414 Section 4 - "Discovery... ...msgUserName of zero-length..." return ($this->{_discovered}) ? $this->{_user_name} : q{}; } sub _snmp_engine_init { my ($this) = @_; if ($this->{_engine_id} eq q{}) { # Initialize our snmpEngineID using the algorithm described # in RFC 3411 - SnmpEngineID::=TEXTUAL-CONVENTION. # The first bit is set to one to indicate that the RFC 3411 # algorithm is being used. The first fours bytes are to be # the agent's SNMP management private enterprise number, but # they are set to all zeros. The fifth byte is set to one to # indicate that the final four bytes are an IPv4 address. if (!defined $ENGINE_ID) { $ENGINE_ID = eval { require Sys::Hostname; pack('H10', '8000000001') . gethostbyname Sys::Hostname::hostname(); }; # Fallback in case gethostbyname() or hostname() fail if ($@) { $ENGINE_ID = pack 'x11H2', '01'; } } $this->{_engine_id} = $ENGINE_ID; } $this->{_engine_boots} = 1; $this->{_time_epoc} = $^T; $this->{_synchronized} = TRUE; $this->{_discovered} = TRUE; return TRUE; } sub _auth_key { my ($this, $auth_key) = @_; if (@_ == 2) { if ($auth_key =~ m/^(?:0x)?([A-F0-9]+)$/i) { $this->{_auth_key} = pack 'H', length($1) % 2 ? '0'.$1 : $1; if (!defined $this->_auth_key_validate()) { return $this->_error(); } } else { return $this->_error( 'The authKey "%s" is expected in hexadecimal format', $auth_key ); } } return $this->{_auth_key}; } sub _auth_password { my ($this, $auth_password) = @_; if (@_ == 2) { if ($auth_password eq q{}) { return $this->_error('An empty authentication password was specified'); } $this->{_auth_password} = $auth_password; } return $this->{_auth_password}; } { my $protocols = { '(?:hmac-)?md5(?:-96)?', AUTH_PROTOCOL_HMACMD5, quotemeta AUTH_PROTOCOL_HMACMD5, AUTH_PROTOCOL_HMACMD5, '(?:hmac-)?sha(?:-?1\|-96)?', AUTH_PROTOCOL_HMACSHA, quotemeta AUTH_PROTOCOL_HMACSHA, AUTH_PROTOCOL_HMACSHA, }; sub _auth_protocol { my ($this, $proto) = @_; if (@_ < 2) { return $this->{_auth_protocol}; } if ($proto eq q{}) { return $this->_error('An empty authProtocol was specified'); } for (keys %{$protocols}) { if ($proto =~ /^$_$/i) { return $this->{_auth_protocol} = $protocols->{$_}; } } return $this->_error('The authProtocol "%s" is unknown', $proto); } } sub _priv_key { my ($this, $priv_key) = @_; if (@_ == 2) { if ($priv_key =~ m/^(?:0x)?([A-F0-9]+)$/i) { $this->{_priv_key} = pack 'H', length($1) % 2 ? '0'.$1 : $1; if (!defined $this->_priv_key_validate()) { return $this->_error(); } } else { return $this->_error( 'The privKey "%s" is expected in hexadecimal format', $priv_key ); } } return $this->{_priv_key}; } sub _priv_password { my ($this, $priv_password) = @_; if (@_ == 2) { if ($priv_password eq q{}) { return $this->_error('An empty privacy password was specified'); } $this->{_priv_password} = $priv_password; } return $this->{_priv_password}; } { my $protocols = { '(?:cbc-)?des', PRIV_PROTOCOL_DES, quotemeta PRIV_PROTOCOL_DES, PRIV_PROTOCOL_DES, '(?:cbc-)?(?:3\|triple-)des(?:-?ede)?', PRIV_PROTOCOL_DRAFT_3DESEDE, quotemeta PRIV_PROTOCOL_DRAFT_3DESEDE, PRIV_PROTOCOL_DRAFT_3DESEDE, '(?:(?:cfb)?128-?)?aes(?:-?128)?', PRIV_PROTOCOL_AESCFB128, quotemeta PRIV_PROTOCOL_AESCFB128, PRIV_PROTOCOL_AESCFB128, quotemeta PRIV_PROTOCOL_DRAFT_AESCFB128, PRIV_PROTOCOL_AESCFB128, '(?:(?:cfb)?192-?)aes(?:-?128)?', PRIV_PROTOCOL_DRAFT_AESCFB192, quotemeta PRIV_PROTOCOL_DRAFT_AESCFB192, PRIV_PROTOCOL_DRAFT_AESCFB192, '(?:(?:cfb)?256-?)aes(?:-?128)?', PRIV_PROTOCOL_DRAFT_AESCFB256, quotemeta PRIV_PROTOCOL_DRAFT_AESCFB256, PRIV_PROTOCOL_DRAFT_AESCFB256, }; sub _priv_protocol { my ($this, $proto) = @_; if (@_ < 2) { return $this->{_priv_protocol}; } if ($proto eq q{}) { return $this->_error('An empty privProtocol was specified'); } my $priv_proto; for (keys %{$protocols}) { if ($proto =~ /^$_$/i) { $priv_proto = $protocols->{$_}; last; } } if (!defined $priv_proto) { return $this->_error('The privProtocol "%s" is unknown', $proto); } # Validate the support of the AES cipher algorithm. Attempt to # load the Crypt::Rijndael module. If this module is not found, # do not provide support for the AES Cipher Algorithm. if (($priv_proto eq PRIV_PROTOCOL_AESCFB128) \|\| ($priv_proto eq PRIV_PROTOCOL_DRAFT_AESCFB192) \|\| ($priv_proto eq PRIV_PROTOCOL_DRAFT_AESCFB256)) { if (defined (my $error = load_module('Crypt::Rijndael'))) { return $this->_error( 'Support for privProtocol "%s" is unavailable %s', $proto, $error ); } } return $this->{_priv_protocol} = $priv_proto; } } sub _engine_boots { return ($_[0]->{_synchronized}) ? $_[0]->{_engine_boots} : 0; } sub _engine_time { my ($this) = @_; return 0 if (!$this->{_synchronized}); $this->{_engine_time} = time() - $this->{_time_epoc}; if ($this->{_engine_time} > 2147483647) { DEBUG_INFO('snmpEngineTime rollover'); if (++$this->{_engine_boots} == 2147483647) { die 'FATAL: Unable to handle snmpEngineBoots value'; } $this->{_engine_time} -= 2147483647; $this->{_time_epoc} = time() - $this->{_engine_time}; if (!$this->{_authoritative}) { $this->{_synchronized} = FALSE; return $this->{_latest_engine_time} = 0; } } if ($this->{_engine_time} < 0) { die 'FATAL: Unable to handle negative snmpEngineTime value'; } return $this->{_engine_time}; } sub _security_params { my ($this) = @_; # Clear any previous error messages $this->_error_clear(); # We must have an usmUserName if ($this->{_user_name} eq q{}) { return $this->_error('The required userName was not specified'); } # Define the authentication parameters if ((defined $this->{_auth_password}) && ($this->{_discovered})) { if (!defined $this->{_auth_key}) { return $this->_error() if !defined $this->_auth_key_generate(); } $this->{_auth_password} = undef; } if (defined $this->{_auth_key}) { # Validate the key based on the protocol if (!defined $this->_auth_key_validate()) { return $this->_error('The authKey is invalid'); } # Initialize the authentication data if (!defined $this->_auth_data_init()) { return $this->_error('Failed to initialize the authentication data'); } if ($this->{_discovered}) { $this->{_security_level} = SECURITY_LEVEL_AUTHNOPRIV; } } # You must have authentication to have privacy if (!defined ($this->{_auth_key}) && !defined $this->{_auth_password}) { if (defined ($this->{_priv_key}) \|\| defined $this->{_priv_password}) { return $this->_error( 'The securityLevel is unsupported (privacy requires authentication)' ); } } # Define the privacy parameters if ((defined $this->{_priv_password}) && ($this->{_discovered})) { if (!defined $this->{_priv_key}) { return $this->_error() if !defined $this->_priv_key_generate(); } $this->{_priv_password} = undef; } if (defined $this->{_priv_key}) { # Validate the key based on the protocol if (!defined $this->_priv_key_validate()) { return $this->_error('The privKey is invalid'); } # Initialize the privacy data if (!defined $this->_priv_data_init()) { return $this->_error('Failed to initialize the privacy data'); } if ($this->{_discovered}) { $this->{_security_level} = SECURITY_LEVEL_AUTHPRIV; } } DEBUG_INFO('securityLevel = %d', $this->{_security_level}); return $this->{_security_level}; } sub _engine_id_discovery { my ($this, $engine_id) = @_; return TRUE if ($this->{_authoritative}); DEBUG_INFO('engineID = 0x%s', unpack 'H', $engine_id \|\| q{}); if (length($engine_id) < 5 \|\| length($engine_id) > 32) { return $this->_error( 'The msgAuthoritativeEngineID length of %d is out of range (5..32)', length $engine_id ); } $this->{_engine_id} = $engine_id; $this->{_discovered} = TRUE; if (!defined $this->_security_params()) { $this->{_discovered} = FALSE; return $this->_error(); } return TRUE; } sub _synchronize { my ($this, $msg_boots, $msg_time) = @_; return TRUE if ($this->{_authoritative}); return TRUE if ($this->{_security_level} < SECURITY_LEVEL_AUTHNOPRIV); if (($msg_boots > $this->_engine_boots()) \|\| (($msg_boots == $this->_engine_boots()) && ($msg_time > $this->{_latest_engine_time}))) { DEBUG_INFO( 'update: engineBoots = %d, engineTime = %d', $msg_boots, $msg_time ); $this->{_engine_boots} = $msg_boots; $this->{_latest_engine_time} = $this->{_engine_time} = $msg_time; $this->{_time_epoc} = time() - $this->{_engine_time}; if (!$this->{_synchronized}) { $this->{_synchronized} = TRUE; if (!defined $this->_security_params()) { return ($this->{_synchronized} = FALSE); } } return TRUE; } DEBUG_INFO( 'no update: engineBoots = %d, msgBoots = %d; ' . 'latestTime = %d, msgTime = %d', $this->_engine_boots(), $msg_boots, $this->{_latest_engine_time}, $msg_time ); return TRUE; } sub _timeliness { my ($this, $msg_boots, $msg_time) = @_; return TRUE if ($this->{_security_level} < SECURITY_LEVEL_AUTHNOPRIV); # Retrieve a local copy of our snmpEngineBoots and snmpEngineTime # to avoid the possibilty of using different values in each of # the comparisons. my $engine_time = $this->_engine_time(); my $engine_boots = $this->_engine_boots(); if ($engine_boots == 2147483647) { $this->{_synchronized} = FALSE; return $this->_error('The system is not in the time window'); } if (!$this->{_authoritative}) { if ($msg_boots < $engine_boots) { return $this->_error('The message is not in the time window'); } if (($msg_boots == $engine_boots) && ($msg_time < ($engine_time - 150))) { return $this->_error('The message is not in the time window'); } } else { if ($msg_boots != $engine_boots) { return $this->_error('The message is not in the time window'); } if (($msg_time < ($engine_time - 150)) \|\| ($msg_time > ($engine_time + 150))) { return $this->_error('The message is not in the time window'); } } return TRUE; } sub _authenticate_outgoing_msg { my ($this, $msg, $auth_location) = @_; if (!$auth_location) { return $this->_error( 'Authentication failure (Unable to set msgAuthenticationParameters)' ); } # Set the msgAuthenticationParameters substr ${$msg->reference}, -$auth_location, 12, $this->_auth_hmac($msg); return TRUE; } sub _authenticate_incoming_msg { my ($this, $msg, $auth_params) = @_; # Authenticate the message if ($auth_params ne $this->_auth_hmac($msg)) { return $this->_error('Authentication failure'); } DEBUG_INFO('authentication passed'); return TRUE; } sub _auth_hmac { my ($this, $msg) = @_; return q{} if (!defined($this->{_auth_data}) \|\| !defined $msg); return substr $this->{_auth_data}->reset()->add(${$msg->reference()})->digest(), 0, 12; } sub _auth_data_init { my ($this) = @_; if (!defined $this->{_auth_key}) { return $this->_error('The required authKey is not defined'); } return TRUE if defined $this->{_auth_data}; if ($this->{_auth_protocol} eq AUTH_PROTOCOL_HMACMD5) { $this->{_auth_data} = Digest::HMAC->new($this->{_auth_key}, 'Digest::MD5'); } elsif ($this->{_auth_protocol} eq AUTH_PROTOCOL_HMACSHA) { $this->{_auth_data} = Digest::HMAC->new($this->{_auth_key}, 'Digest::SHA1'); } else { return $this->_error( 'The authProtocol "%s" is unknown', $this->{_auth_protocol} ); } return TRUE; } { my $encrypt = { PRIV_PROTOCOL_DES, \&_priv_encrypt_des, PRIV_PROTOCOL_DRAFT_3DESEDE, \&_priv_encrypt_3desede, PRIV_PROTOCOL_AESCFB128, \&_priv_encrypt_aescfbxxx, PRIV_PROTOCOL_DRAFT_AESCFB192, \&_priv_encrypt_aescfbxxx, PRIV_PROTOCOL_DRAFT_AESCFB256, \&_priv_encrypt_aescfbxxx }; sub _encrypt_data { # my ($this, $msg, $priv_params, $plain) = @_; if (!exists $encrypt->{$_[0]->{_priv_protocol}}) { return $_[0]->_error('Encryption error (Unknown protocol)'); } if (!defined $_[1]->prepare( OCTET_STRING, $_[0]->${\$encrypt->{$_[0]->{_priv_protocol}}}($_[2], $_[3]) ) ) { return $_[0]->_error('Encryption error'); } # Set the PDU buffer equal to the encryptedPDU return $_[3] = $_[1]->clear(); } } { my $decrypt = { PRIV_PROTOCOL_DES, \&_priv_decrypt_des, PRIV_PROTOCOL_DRAFT_3DESEDE, \&_priv_decrypt_3desede, PRIV_PROTOCOL_AESCFB128, \&_priv_decrypt_aescfbxxx, PRIV_PROTOCOL_DRAFT_AESCFB192, \&_priv_decrypt_aescfbxxx, PRIV_PROTOCOL_DRAFT_AESCFB256, \&_priv_decrypt_aescfbxxx }; sub _decrypt_data { # my ($this, $msg, $priv_params, $cipher) = @_; # Make sure there is data to decrypt. if (!defined $_[3]) { return $_[0]->_error($_[1]->error() \|\| 'Decryption error (No data)'); } if (!exists $decrypt->{$_[0]->{_priv_protocol}}) { return $_[0]->_error('Decryption error (Unknown protocol)'); } # Clear the Message buffer $_[1]->clear(); # Put the decrypted data back into the Message buffer if (!defined $_[1]->prepend( $_[0]->${\$decrypt->{$_[0]->{_priv_protocol}}}($_[2], $_[3]) ) ) { return $_[0]->_error($_[1]->error()); } return $_[0]->_error($_[1]->error()) if (!$_[1]->length()); # See if the decrypted data starts with a SEQUENCE # and has a reasonable length. my $msglen = $_[1]->process(SEQUENCE); if ((!defined $msglen) \|\| ($msglen > $_[1]->length())) { return $_[0]->_error('Decryption error'); } $_[1]->index(0); # Reset the index DEBUG_INFO('privacy passed'); return TRUE; } } sub _priv_data_init { my ($this) = @_; if (!defined $this->{_priv_key}) { return $this->_error('The required privKey is not defined'); } return TRUE if defined $this->{_priv_data}; my $init = { PRIV_PROTOCOL_DES, \&_priv_data_init_des, PRIV_PROTOCOL_DRAFT_3DESEDE, \&_priv_data_init_3desede, PRIV_PROTOCOL_AESCFB128, \&_priv_data_init_aescfbxxx, PRIV_PROTOCOL_DRAFT_AESCFB192, \&_priv_data_init_aescfbxxx, PRIV_PROTOCOL_DRAFT_AESCFB256, \&_priv_data_init_aescfbxxx }; if (!exists $init->{$this->{_priv_protocol}}) { return $this->_error( 'The privProtocol "%s" is unknown', $this->{_priv_protocol} ); } return $this->${\$init->{$this->{_priv_protocol}}}(); } sub _priv_data_init_des { my ($this) = @_; if (!defined $this->{_priv_key}) { return $this->_error('The required privKey is not defined'); } # Create the DES object $this->{_priv_data}->{des} = Crypt::DES->new(substr $this->{_priv_key}, 0, 8); # Extract the pre-IV $this->{_priv_data}->{pre_iv} = substr $this->{_priv_key}, 8, 8; # Initialize the salt $this->{_priv_data}->{salt} = int rand ~0; return TRUE; } sub _priv_encrypt_des { # my ($this, $priv_params, $plain) = @_; if (!defined $_[0]->{_priv_data}) { return $_[0]->_error('The required privacy data is not defined'); } # Always pad the plain text data. "The actual pad value is # irrelevant..." according RFC 3414 Section 8.1.1.2. However, # there are some agents out there that expect "standard block # padding" where each of the padding byte(s) are set to the size # of the padding (even for data that is a multiple of block size). my $pad = 8 - (length($_[2]) % 8); $_[2] .= pack('C', $pad) x $pad; # Create and set the salt if ($_[0]->{_priv_data}->{salt}++ == ~0) { $_[0]->{_priv_data}->{salt} = 0; } $_[1] = pack 'NN', $_[0]->{_engine_boots}, $_[0]->{_priv_data}->{salt}; # Create the initial vector (IV) my $iv = $_[0]->{_priv_data}->{pre_iv} ^ $_[1]; my $cipher = q{}; # Perform Cipher Block Chaining (CBC) while ($_[2] =~ /(.{8})/gs) { $cipher .= $iv = $_[0]->{_priv_data}->{des}->encrypt($1 ^ $iv); } return $cipher; } sub _priv_decrypt_des { # my ($this, $priv_params, $cipher) = @_; if (!defined $_[0]->{_priv_data}) { return $_[0]->_error('The required privacy data is not defined'); } if (length($_[1]) != 8) { return $_[0]->_error( 'The msgPrivParameters length of %d is invalid', length $_[1] ); } if (length($_[2]) % 8) { return $_[0]->_error( 'The DES cipher length is not a multiple of the block size' ); } # Create the initial vector (IV) my $iv = $_[0]->{_priv_data}->{pre_iv} ^ $_[1]; my $plain = q{}; # Perform Cipher Block Chaining (CBC) while ($_[2] =~ /(.{8})/gs) { $plain .= $iv ^ $_[0]->{_priv_data}->{des}->decrypt($1); $iv = $1; } return $plain; } sub _priv_data_init_3desede { my ($this) = @_; if (!defined $this->{_priv_key}) { return $this->_error('The required privKey is not defined'); } # Create the 3 DES objects $this->{_priv_data}->{des1} = Crypt::DES->new(substr $this->{_priv_key}, 0, 8); $this->{_priv_data}->{des2} = Crypt::DES->new(substr $this->{_priv_key}, 8, 8); $this->{_priv_data}->{des3} = Crypt::DES->new(substr $this->{_priv_key}, 16, 8); # Extract the pre-IV $this->{_priv_data}->{pre_iv} = substr $this->{_priv_key}, 24, 8; # Initialize the salt $this->{_priv_data}->{salt} = int rand ~0; # Assign a hash algorithm to "bit spread" the salt if ($this->{_auth_protocol} eq AUTH_PROTOCOL_HMACMD5) { $this->{_priv_data}->{hash} = Digest::MD5->new(); } elsif ($this->{_auth_protocol} eq AUTH_PROTOCOL_HMACSHA) { $this->{_priv_data}->{hash} = Digest::SHA1->new(); } return TRUE; } sub _priv_encrypt_3desede { # my ($this, $priv_params, $plain) = @_; if (!defined $_[0]->{_priv_data}) { return $_[0]->_error('The required privacy data is not defined'); } # Pad the plain text data using "standard block padding". my $pad = 8 - (length($_[2]) % 8); $_[2] .= pack('C', $pad) x $pad; # Create and set the salt if ($_[0]->{_priv_data}->{salt}++ == ~0) { $_[0]->{_priv_data}->{salt} = 0; } $_[1] = pack 'NN', $_[0]->{_engine_boots}, $_[0]->{_priv_data}->{salt}; # Draft 3DES-EDE for USM Section 5.1.1.1.2 - "To achieve effective # bit spreading, the complete 8-octet 'salt' value SHOULD be # hashed using the usmUserAuthProtocol." if (exists $_[0]->{_priv_data}->{hash}) { $_[1] = substr $_[0]->{_priv_data}->{hash}->add($_[1])->digest(), 0, 8; } # Create the initial vector (IV) my $iv = $_[0]->{_priv_data}->{pre_iv} ^ $_[1]; my $cipher = q{}; # Perform Cipher Block Chaining (CBC) while ($_[2] =~ /(.{8})/gs) { $cipher .= $iv = $_[0]->{_priv_data}->{des3}->encrypt( $_[0]->{_priv_data}->{des2}->decrypt( $_[0]->{_priv_data}->{des1}->encrypt($1 ^ $iv) ) ); } return $cipher; } sub _priv_decrypt_3desede { # my ($this, $priv_params, $cipher) = @_; if (!defined $_[0]->{_priv_data}) { return $_[0]->_error('The required privacy data is not defined'); } if (length($_[1]) != 8) { return $_[0]->_error( 'The msgPrivParameters length of %d is invalid', length $_[1] ); } if (length($_[2]) % 8) { return $_[0]->_error( 'The CBC-3DES-EDE cipher length is not a multiple of the block size' ); } # Create the initial vector (IV) my $iv = $_[0]->{_priv_data}->{pre_iv} ^ $_[1]; my $plain = q{}; # Perform Cipher Block Chaining (CBC) while ($_[2] =~ /(.{8})/gs) { $plain .= $iv ^ $_[0]->{_priv_data}->{des1}->decrypt( $_[0]->{_priv_data}->{des2}->encrypt( $_[0]->{_priv_data}->{des3}->decrypt($1) ) ); $iv = $1; } return $plain; } sub _priv_data_init_aescfbxxx { my ($this) = @_; if (!defined $this->{_priv_key}) { return $this->_error('The required privKey is not defined'); } { # Avoid a "strict subs" error if Crypt::Rijndael is not loaded. no strict 'subs'; # Create the AES (Rijndael) object with a 128, 192, or 256 bit key. $this->{_priv_data}->{aes} = Crypt::Rijndael->new($this->{_priv_key}, Crypt::Rijndael::MODE_CFB()); } # Initialize the salt $this->{_priv_data}->{salt1} = int rand ~0; $this->{_priv_data}->{salt2} = int rand ~0; return TRUE; } sub _priv_encrypt_aescfbxxx { # my ($this, $priv_params, $plain) = @_; if (!defined $_[0]->{_priv_data}) { return $_[0]->_error('The required privacy data is not defined'); } # Validate the plain text length my $length = length $_[2]; if ($length <= 16) { return $_[0]->_error( 'The AES plain text length is not greater than the block size' ); } # Create and set the salt if ($_[0]->{_priv_data}->{salt1}++ == ~0) { $_[0]->{_priv_data}->{salt1} = 0; if ($_[0]->{_priv_data}->{salt2}++ == ~0) { $_[0]->{_priv_data}->{salt2} = 0; } } $_[1] = pack 'NN', $_[0]->{_priv_data}->{salt2}, $_[0]->{_priv_data}->{salt1}; # AES in the USM Section - Section 3.1.3 "The last ciphertext # block is produced by exclusive-ORing the last plaintext segment # of r bits (r is less or equal to 128) with the segment of the r # most significant bits of the last output block." # This operation is identical to those performed on the previous # blocks except for the fact that the block can be less than the # block size. We can just pad the last block and operate on it as # usual and then ignore the padding after encrypting. $_[2] .= "\000" x (16 - ($length % 16)); # Create the IV by concatenating "...the generating SNMP engine's # 32-bit snmpEngineBoots, the SNMP engine's 32-bit snmpEngineTime, # and a local 64-bit integer..." $_[0]->{_priv_data}->{aes}->set_iv( pack('NN', $_[0]->{_engine_boots}, $_[0]->{_engine_time}) . $_[1] ); # Let the Crypt::Rijndael module perform 128 bit Cipher Feedback # (CFB) and return the result minus the "internal" padding. return substr $_[0]->{_priv_data}->{aes}->encrypt($_[2]), 0, $length; } sub _priv_decrypt_aescfbxxx { # my ($this, $priv_params, $cipher) = @_; if (!defined $_[0]->{_priv_data}) { return $_[0]->_error('The required privacy data is not defined'); } # Validate the msgPrivParameters length. We assume that the # msgAuthoritativeEngineBoots and msgAuthoritativeEngineTime # have been prepended to the msgPrivParameters to create the # required 128 bit IV. if (length($_[1]) != 16) { return $_[0]->_error( 'The AES IV length of %d is invalid', length $_[1] ); } # Validate the cipher length my $length = length $_[2]; if ($length <= 16) { return $_[0]->_error( 'The AES cipher length is not greater than the block size' ); } # AES in the USM Section - Section 3.1.4 "The last ciphertext # block (whose size r is less or equal to 128) is less or equal # to 128) is exclusive-ORed with the segment of the r most # significant bits of the last output block to recover the last # plaintext block of r bits." # This operation is identical to those performed on the previous # blocks except for the fact that the block can be less than the # block size. We can just pad the last block and operate on it as # usual and then ignore the padding after decrypting. $_[2] .= "\000" x (16 - ($length % 16)); # Use the msgPrivParameters as the IV. $_[0]->{_priv_data}->{aes}->set_iv($_[1]); # Let the Crypt::Rijndael module perform 128 bit Cipher Feedback # (CFB) and return the result minus the "internal" padding. return substr $_[0]->{_priv_data}->{aes}->decrypt($_[2]), 0, $length; } sub _auth_key_generate { my ($this) = @_; if (!defined($this->{_engine_id}) \|\| !defined $this->{_auth_password}) { return $this->_error('Unable to generate the authKey'); } $this->{_auth_key} = $this->_password_localize($this->{_auth_password}); return $this->{_auth_key}; } sub _auth_key_validate { my ($this) = @_; my $key_len = { AUTH_PROTOCOL_HMACMD5, [ 16, 'HMAC-MD5' ], AUTH_PROTOCOL_HMACSHA, [ 20, 'HMAC-SHA1' ], }; if (!exists $key_len->{$this->{_auth_protocol}}) { return $this->_error( 'The authProtocol "%s" is unknown', $this->{_auth_protocol} ); } if (length($this->{_auth_key}) != $key_len->{$this->{_auth_protocol}}->[0]) { return $this->_error( 'The %s authKey length of %d is invalid, expected %d', $key_len->{$this->{_auth_protocol}}->[1], length($this->{_auth_key}), $key_len->{$this->{_auth_protocol}}->[0] ); } return TRUE; } sub _priv_key_generate { my ($this) = @_; if (!defined($this->{_engine_id}) \|\| !defined $this->{_priv_password}) { return $this->_error('Unable to generate the privKey'); } $this->{_priv_key} = $this->_password_localize($this->{_priv_password}); return $this->_error() if !defined $this->{_priv_key}; if ($this->{_priv_protocol} eq PRIV_PROTOCOL_DRAFT_3DESEDE) { # Draft 3DES-EDE for USM Section 2.1 - "To acquire the necessary # number of key bits, the password-to-key algorithm may be chained # using its output as further input in order to generate an # appropriate number of key bits." $this->{_priv_key} .= $this->_password_localize($this->{_priv_key}); } elsif (($this->{_priv_protocol} eq PRIV_PROTOCOL_DRAFT_AESCFB192) \|\| ($this->{_priv_protocol} eq PRIV_PROTOCOL_DRAFT_AESCFB256)) { # Draft AES in the USM Section 3.1.2.1 - "...if the size of the # localized key is not large enough to generate an encryption # key... ...set Kul = Kul \|\| Hnnn(Kul) where Hnnn is the hash # function for the authentication protocol..." my $hnnn; if ($this->{_auth_protocol} eq AUTH_PROTOCOL_HMACMD5) { $hnnn = Digest::MD5->new(); } elsif ($this->{_auth_protocol} eq AUTH_PROTOCOL_HMACSHA) { $hnnn = Digest::SHA1->new(); } else { return $this->_error( 'The authProtocol "%s" is unknown', $this->{_auth_protocol} ); } $this->{_priv_key} .= $hnnn->add($this->{_priv_key})->digest(); } # Truncate the privKey to the appropriate length. my $key_len = { PRIV_PROTOCOL_DES, 16, # RFC 3414 Section 8.2.1 PRIV_PROTOCOL_DRAFT_3DESEDE, 32, # Draft 3DES for USM Section 5.2.1 PRIV_PROTOCOL_AESCFB128, 16, # AES in the USM Section 3.2.1 PRIV_PROTOCOL_DRAFT_AESCFB192, 24, # Draft AES in the USM Section 3.2.1 PRIV_PROTOCOL_DRAFT_AESCFB256, 32 # Draft AES in the USM Section 3.2.1 }; if (!exists $key_len->{$this->{_priv_protocol}}) { return $this->_error( 'The privProtocol "%s" is unknown', $this->{_priv_protocol} ); } $this->{_priv_key} = substr $this->{_priv_key}, 0, $key_len->{$this->{_priv_protocol}}; return $this->{_priv_key}; } sub _priv_key_validate { my ($this) = @_; my $key_len = { PRIV_PROTOCOL_DES, [ 16, 'CBC-DES' ], PRIV_PROTOCOL_DRAFT_3DESEDE, [ 32, 'CBC-3DES-EDE' ], PRIV_PROTOCOL_AESCFB128, [ 16, 'CFB128-AES-128' ], PRIV_PROTOCOL_DRAFT_AESCFB192, [ 24, 'CFB128-AES-192' ], PRIV_PROTOCOL_DRAFT_AESCFB256, [ 32, 'CFB128-AES-256' ] }; if (!exists $key_len->{$this->{_priv_protocol}}) { return $this->_error( 'The privProtocol "%s" is unknown', $this->{_priv_protocol} ); } if (length($this->{_priv_key}) != $key_len->{$this->{_priv_protocol}}->[0]) { return $this->_error( 'The %s privKey length of %d is invalid, expected %d', $key_len->{$this->{_priv_protocol}}->[1], length($this->{_priv_key}), $key_len->{$this->{_priv_protocol}}->[0] ); } if ($this->{_priv_protocol} eq PRIV_PROTOCOL_DRAFT_3DESEDE) { # Draft 3DES-EDE for USM Section 5.1.1.1.1 "The checks for difference # and weakness... ...should be performed when the key is assigned. # If any of the mandated tests fail, then the whole key MUST be # discarded and an appropriate exception noted." if (substr($this->{_priv_key}, 0, 8) eq substr $this->{_priv_key}, 8, 8) { return $this->_error( 'The CBC-3DES-EDE privKey is invalid (K1 equals K2)' ); } if (substr($this->{_priv_key}, 8, 8) eq substr $this->{_priv_key}, 16, 8) { return $this->_error( 'The CBC-3DES-EDE privKey is invalid (K2 equals K3)' ); } if (substr($this->{_priv_key}, 0, 8) eq substr $this->{_priv_key}, 16, 8) { return $this->_error( 'The CBC-3DES-EDE privKey is invalid (K1 equals K3)' ); } } return TRUE; } sub _password_localize { my ($this, $password) = @_; my $digests = { AUTH_PROTOCOL_HMACMD5, 'Digest::MD5', AUTH_PROTOCOL_HMACSHA, 'Digest::SHA1', }; if (!exists $digests->{$this->{_auth_protocol}}) { return $this->_error( 'The authProtocol "%s" is unknown', $this->{_auth_protocol} ); } my $digest = $digests->{$this->{_auth_protocol}}->new; # Create the initial digest using the password my $d = my $pad = $password x ((2048 / length $password) + 1); for (my $count = 0; $count < 2*20; $count += 2048) { $digest->add(substr $d, 0, 2048, q{}); $d .= $pad; } $d = $digest->digest; # Localize the key with the authoritativeEngineID return $digest->add($d . $this->{_engine_id} . $d)->digest(); } { my %modules; sub load_module { my ($module) = @_; # We attempt to load the required module under the protection of an # eval statement. If there is a failure, typically it is due to a # missing module required by the requested module and we attempt to # simplify the error message by just listing that module. We also # need to track failures since require() only produces an error on # the first attempt to load the module. # NOTE: Contrary to our typical convention, a return value of "undef" # actually means success and a defined value means error. return $modules{$module} if exists $modules{$module}; if (!eval "require $module") { if ($@ =~ /locate (\S+\.pm)/) { $modules{$module} = sprintf '(Required module %s not found)', $1; } else { $modules{$module} = sprintf '(%s)', $@; } } else { $modules{$module} = undef; } return $modules{$module}; } } # ============================================================================ 1; # [end Net::SNMP::Security::USM] PK��X�\�m�FW��W��Security/Community.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Security::Community; # $Id: Community.pm,v 2.0 2009/09/09 15:05:33 dtown Rel $ # Object that implements the SNMPv1/v2c Community-based Security Model. # Copyright (c) 2001-2009 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 Net::SNMP::Security qw( SECURITY_MODEL_SNMPV1 SECURITY_MODEL_SNMPV2C DEBUG_INFO ); use Net::SNMP::Message qw( OCTET_STRING SEQUENCE INTEGER SNMP_VERSION_1 SNMP_VERSION_2C TRUE ); ## Version of the Net::SNMP::Security::Community module our $VERSION = v2.0.0; ## Handle importing/exporting of symbols use base qw( Net::SNMP::Security ); sub import { return Net::SNMP::Security->export_to_level(1, @_); } ## RFC 3584 - snmpCommunityName::=OCTET STRING sub COMMUNITY_DEFAULT { 'public' } # [public methods] ----------------------------------------------------------- sub new { my ($class, %argv) = @_; # Create a new data structure for the object my $this = bless { '_error' => undef, # Error message '_version' => SNMP_VERSION_1, # SNMP version '_community' => COMMUNITY_DEFAULT, # Community name }, $class; # Now validate the passed arguments for (keys %argv) { if (/^-?community$/i) { $this->_community($argv{$_}); } elsif (/^-?debug$/i) { $this->debug($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 the object and an empty error message (in list context) return wantarray ? ($this, q{}) : $this; } sub generate_request_msg { my ($this, $pdu, $msg) = @_; # Clear any previous errors $this->_error_clear(); if (@_ < 3) { return $this->_error('The required PDU and/or Message object is missing'); } if ($pdu->version() != $this->{_version}) { return $this->_error( 'The SNMP version %d was expected, but %d was found', $this->{_version}, $pdu->version() ); } # Append the PDU if (!defined $msg->append($pdu->copy())) { return $this->_error($msg->error()); } # community::=OCTET STRING if (!defined $msg->prepare(OCTET_STRING, $this->{_community})) { return $this->_error($msg->error()); } # version::=INTEGER if (!defined $msg->prepare(INTEGER, $this->{_version})) { return $this->_error($msg->error()); } # message::=SEQUENCE if (!defined $msg->prepare(SEQUENCE)) { return $this->_error($msg->error()); } # Return the message return $msg; } sub process_incoming_msg { my ($this, $msg) = @_; # Clear any previous errors $this->_error_clear(); return $this->_error('The required Message object is missing') if (@_ < 2); if ($msg->security_name() ne $this->{_community}) { return $this->_error( 'The community name "%s" was expected, but "%s" was found', $this->{_community}, $msg->security_name() ); } return TRUE; } sub community { return $_[0]->{_community}; } sub security_model { my ($this) = @_; # RFC 3411 - SnmpSecurityModel::=TEXTUAL-CONVENTION if ($this->{_version} == SNMP_VERSION_2C) { return SECURITY_MODEL_SNMPV2C; } return SECURITY_MODEL_SNMPV1; } sub security_name { return $_[0]->{_community}; } # [private methods] ---------------------------------------------------------- sub _community { my ($this, $community) = @_; return $this->_error('The community is not defined') if !defined $community; $this->{_community} = $community; return TRUE; } sub _version { my ($this, $version) = @_; if (($version != SNMP_VERSION_1) && ($version != SNMP_VERSION_2C)) { return $this->_error('The SNMP version %s is not supported', $version); } $this->{_version} = $version; return TRUE; } # ============================================================================ 1; # [end Net::SNMP::Security::Community] PK��X�\�G�р�� Message.pmnu��[��# -- 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((216) - 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] PK��X�\왜� �� Transport/IPv4.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Transport::IPv4; # $Id: IPv4.pm,v 1.1 2009/09/09 15:08:31 dtown Rel $ # Base object for the IPv4 Transport Domains. # Copyright (c) 2008-2009 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 Net::SNMP::Transport; use IO::Socket qw( INADDR_ANY INADDR_LOOPBACK inet_aton PF_INET sockaddr_in inet_ntoa ); ## Version of the Net::SNMP::Transport::IPv4 module our $VERSION = v1.0.0; # [private methods] ---------------------------------------------------------- sub _socket_create { my ($this) = @_; return IO::Socket->new()->socket($this->_protocol_family(), $this->_protocol_type(), $this->_protocol()); } sub _protocol_family { return PF_INET; } sub _addr_any { return INADDR_ANY; } sub _addr_loopback { return INADDR_LOOPBACK; } sub _hostname_resolve { my ($this, $host, $nh) = @_; $nh->{addr} = undef; # See if the the service/port was included in the address. my $serv = ($host =~ s/:([\w\/]+)$//) ? $1 : undef; if (defined($serv) && (!defined $this->_service_resolve($serv, $nh))) { return $this->_error('Failed to resolve the %s service', $this->type()); } # Resolve the address. if (!defined ($nh->{addr} = inet_aton($_[1] = $host))) { return $this->_error( q{Unable to resolve the %s address "%s"}, $this->type(), $host ); } return $nh->{addr}; } sub _name_pack { return sockaddr_in($_[1]->{port}, $_[1]->{addr}); } sub _address { return inet_ntoa($_[0]->_addr($_[1])); } sub _addr { return (sockaddr_in($_[1]))[1]; } sub _port { return (sockaddr_in($_[1]))[0]; } sub _taddress { return sprintf '%s:%d', $_[0]->_address($_[1]), $_[0]->_port($_[1]); } sub _taddr { return $_[0]->_addr($_[1]) . pack 'n', $_[0]->_port($_[1]); } # ============================================================================ 1; # [end Net::SNMP::Transport::IPv4] PK��X�\��"G� �� Transport/IPv4/UDP.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Transport::IPv4::UDP; # $Id: UDP.pm,v 4.0 2009/09/09 15:05:33 dtown Rel $ # Object that handles the UDP/IPv4 Transport Domain for the SNMP Engine. # Copyright (c) 2001-2009 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 Net::SNMP::Transport qw( DOMAIN_UDPIPV4 ); use IO::Socket qw( SOCK_DGRAM ); ## Version of the Net::SNMP::Transport::IPv4::UDP module our $VERSION = v4.0.0; ## Handle importing/exporting of symbols use base qw( Net::SNMP::Transport::IPv4 Net::SNMP::Transport ); sub import { return Net::SNMP::Transport->export_to_level(1, @_); } ## RFC 3411 - snmpEngineMaxMessageSize::=INTEGER (484..2147483647) sub MSG_SIZE_DEFAULT_UDP4 { 1472 } # Ethernet(1500) - IPv4(20) - UDP(8) # [public methods] ----------------------------------------------------------- sub new { return shift->SUPER::_new(@_); } sub send { my $this = shift; $this->_error_clear(); if (length($_[0]) > $this->{_max_msg_size}) { return $this->_error( 'The message size %d exceeds the maxMsgSize %d', length($_[0]), $this->{_max_msg_size} ); } my $bytes = $this->{_socket}->send($_[0], 0, $this->{_dest_name}); return defined($bytes) ? $bytes : $this->_perror('Send failure'); } sub recv { my $this = shift; $this->_error_clear(); my $name = $this->{_socket}->recv($_[0], $this->_shared_max_size(), 0); return defined($name) ? $name : $this->_perror('Receive failure'); } sub domain { return DOMAIN_UDPIPV4; # transportDomainUdpIpv4 } sub type { return 'UDP/IPv4'; # udpIpv4(1) } sub agent_addr { my ($this) = @_; $this->_error_clear(); my $name = $this->{_socket}->sockname() \|\| $this->{_sock_name}; if ($this->{_socket}->connect($this->{_dest_name})) { $name = $this->{_socket}->sockname() \|\| $this->{_sock_name}; if (!$this->{_socket}->connect((pack('x') x length $name))) { $this->_perror('Failed to disconnect'); } } return $this->_address($name); } # [private methods] ---------------------------------------------------------- sub _protocol_name { return 'udp'; } sub _protocol_type { return SOCK_DGRAM; } sub _msg_size_default { return MSG_SIZE_DEFAULT_UDP4; } sub _tdomain { return DOMAIN_UDPIPV4; } # ============================================================================ 1; # [end Net::SNMP::Transport::IPv4::UDP] PK��X�\�U�?��Transport/IPv4/TCP.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Transport::IPv4::TCP; # $Id: TCP.pm,v 3.0 2009/09/09 15:05:33 dtown Rel $ # Object that handles the TCP/IPv4 Transport Domain for the SNMP Engine. # Copyright (c) 2004-2009 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 Net::SNMP::Transport qw( MSG_SIZE_MAXIMUM DOMAIN_TCPIPV4 TRUE FALSE DEBUG_INFO ); use Net::SNMP::Message qw( SEQUENCE ); use IO::Socket qw( SOCK_STREAM ); ## Version of the Net::SNMP::Transport::IPv4::TCP module our $VERSION = v3.0.0; ## Handle importing/exporting of symbols use base qw( Net::SNMP::Transport::IPv4 Net::SNMP::Transport ); sub import { return Net::SNMP::Transport->export_to_level(1, @_); } ## RFC 3411 - snmpEngineMaxMessageSize::=INTEGER (484..2147483647) sub MSG_SIZE_DEFAULT_TCP4 { 1460 } # Ethernet(1500) - IPv4(20) - TCP(20) # [public methods] ----------------------------------------------------------- sub new { my ($this, $error) = shift->SUPER::_new(@_); if (defined $this) { if (!defined $this->_reasm_init()) { return wantarray ? (undef, $this->error()) : undef; } } return wantarray ? ($this, $error) : $this; } sub accept { my ($this) = @_; $this->_error_clear(); my $socket = $this->{_socket}->accept(); if (!defined $socket) { return $this->_perror('Failed to accept the connection'); } DEBUG_INFO('opened %s socket [%d]', $this->type(), $socket->fileno()); # Create a new object by copying the current object. my $new = bless { %{$this} }, ref $this; # Now update the appropriate fields. $new->{_socket} = $socket; $new->{_dest_name} = $socket->peername(); $new->{_dest_hostname} = $new->sock_address(); if (!defined $new->_reasm_init()) { return $this->_error($new->error()); } # Return the new object. return $new; } sub send { my $this = shift; $this->_error_clear(); if (length($_[0]) > $this->{_max_msg_size}) { return $this->_error( 'The message size %d exceeds the maxMsgSize %d', length($_[0]), $this->{_max_msg_size} ); } if (!defined $this->{_socket}->connected()) { return $this->_error( q{Not connected to the remote host '%s'}, $this->dest_hostname() ); } my $bytes = $this->{_socket}->send($_[0], 0); return defined($bytes) ? $bytes : $this->_perror('Send failure'); } sub recv { my $this = shift; $this->_error_clear(); if (!defined $this->{_socket}->connected()) { $this->_reasm_reset(); return $this->_error( q{Not connected to the remote host '%s'}, $this->dest_hostname() ); } # RCF 3430 Section 2.1 - "It is possible that the underlying TCP # implementation delivers byte sequences that do not align with # SNMP message boundaries. A receiving SNMP engine MUST therefore # use the length field in the BER-encoded SNMP message to separate # multiple requests sent over a single TCP connection (framing). # An SNMP engine which looses framing (for example due to ASN.1 # parse errors) SHOULD close the TCP connection." # If the reassembly bufer is empty then there is no partial message # waiting for completion. We must then process the message length # to properly determine how much data to receive. my $name; if ($this->{_reasm_buffer} eq q{}) { if (!defined $this->{_reasm_object}) { return $this->_error('The reassembly object is not defined'); } # Read enough data to parse the ASN.1 type and length. $name = $this->{_socket}->recv($this->{_reasm_buffer}, 6, 0); if ((!defined $name) \|\| ($!)) { $this->_reasm_reset(); return $this->_perror('Receive failure'); } elsif (!length $this->{_reasm_buffer}) { $this->_reasm_reset(); return $this->_error( q{The connection was closed by the remote host '%s'}, $this->dest_hostname() ); } $this->{_reasm_object}->append($this->{_reasm_buffer}); $this->{_reasm_length} = $this->{_reasm_object}->process(SEQUENCE) \|\| 0; if ((!$this->{_reasm_length}) \|\| ($this->{_reasm_length} > MSG_SIZE_MAXIMUM)) { $this->_reasm_reset(); return $this->_error( q{Message framing was lost with the remote host '%s'}, $this->dest_hostname() ); } # Add in the bytes parsed to define the expected message length. $this->{_reasm_length} += $this->{_reasm_object}->index(); } # Setup a temporary buffer for the message and set the length # based upon the contents of the reassembly buffer. my $buf = q{}; my $buf_len = length $this->{_reasm_buffer}; # Read the rest of the message. $name = $this->{_socket}->recv($buf, ($this->{_reasm_length} - $buf_len), 0); if ((!defined $name) \|\| ($!)) { $this->_reasm_reset(); return $this->_perror('Receive failure'); } elsif (!length $buf) { $this->_reasm_reset(); return $this->_error( q{The connection was closed by the remote host '%s'}, $this->dest_hostname() ); } # Now see if we have the complete message. If it is not complete, # success is returned with an empty buffer. The application must # continue to call recv() until the message is reassembled. $buf_len += length $buf; $this->{_reasm_buffer} .= $buf; if ($buf_len < $this->{_reasm_length}) { DEBUG_INFO( 'message is incomplete (expect %u bytes, have %u bytes)', $this->{_reasm_length}, $buf_len ); $_[0] = q{}; return $name \|\| $this->{_socket}->connected(); } # Validate the maxMsgSize. if ($buf_len > $this->{_max_msg_size}) { $this->_reasm_reset(); return $this->_error( 'Incoming message size %d exceeded the maxMsgSize %d', $buf_len, $this->{_max_msg_size} ); } # The message is complete, copy the buffer to the caller. $_[0] = $this->{_reasm_buffer}; # Clear the reassembly buffer and length. $this->_reasm_reset(); return $name \|\| $this->{_socket}->connected(); } sub connectionless { return FALSE; } sub domain { return DOMAIN_TCPIPV4; # transportDomainTcpIpv4 } sub type { return 'TCP/IPv4'; # tcpIpv4(5) } sub agent_addr { return shift->sock_address(); } # [private methods] ---------------------------------------------------------- sub _protocol_name { return 'tcp'; } sub _protocol_type { return SOCK_STREAM; } sub _msg_size_default { return MSG_SIZE_DEFAULT_TCP4; } sub _reasm_init { my ($this) = @_; my $error; ($this->{_reasm_object}, $error) = Net::SNMP::Message->new(); if (!defined $this->{_reasm_object}) { return $this->_error( 'Failed to create the reassembly object: %s', $error ); } $this->_reasm_reset(); return TRUE; } sub _reasm_reset { my ($this) = @_; if (defined $this->{_reasm_object}) { $this->{_reasm_object}->error(undef); $this->{_reasm_object}->clear(); } $this->{_reasm_buffer} = q{}; $this->{_reasm_length} = 0; return TRUE; } sub _tdomain { return DOMAIN_TCPIPV4; # transportDomainTcpIpv4 } # ============================================================================ 1; # [end Net::SNMP::Transport::IPv4::TCP] PK��X�\��Transport/IPv6/UDP.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Transport::IPv6::UDP; # $Id: UDP.pm,v 3.0 2009/09/09 15:05:33 dtown Rel $ # Object that handles the UDP/IPv6 Transport Domain for the SNMP Engine. # Copyright (c) 2004-2009 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 Net::SNMP::Transport::IPv4::UDP qw( DOMAIN_UDPIPV6 DOMAIN_UDPIPV6Z ); ## Version of the Net::SNMP::Transport::UDP6 module our $VERSION = v3.0.0; ## Handle importing/exporting of symbols use base qw( Net::SNMP::Transport::IPv6 Net::SNMP::Transport::IPv4::UDP ); ## RFC 3411 - snmpEngineMaxMessageSize::=INTEGER (484..2147483647) sub MSG_SIZE_DEFAULT_UDP6 { 1452 } # Ethernet(1500) - IPv6(40) - UDP(8) # [public methods] ----------------------------------------------------------- sub domain { return DOMAIN_UDPIPV6; # transportDomainUdpIpv6 } sub type { return 'UDP/IPv6'; # udpIpv6(2) } # [private methods] ---------------------------------------------------------- sub _msg_size_default { return MSG_SIZE_DEFAULT_UDP6; } sub _tdomain { return $_[0]->_scope_id($_[1]) ? DOMAIN_UDPIPV6Z : DOMAIN_UDPIPV6; } # ============================================================================ 1; # [end Net::SNMP::Transport::IPv6::UDP] PK��X�\5~��Transport/IPv6/TCP.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Transport::IPv6::TCP; # $Id: TCP.pm,v 3.0 2009/09/09 15:05:33 dtown Rel $ # Object that handles the TCP/IPv6 Transport Domain for the SNMP Engine. # Copyright (c) 2004-2009 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 Net::SNMP::Transport::IPv4::TCP qw( DOMAIN_TCPIPV6 DOMAIN_TCPIPV6Z ); ## Version of the Net::SNMP::Transport::IPv6::TCP module our $VERSION = v3.0.0; ## Handle importing/exporting of symbols use base qw( Net::SNMP::Transport::IPv6 Net::SNMP::Transport::IPv4::TCP ); ## RFC 3411 - snmpEngineMaxMessageSize::=INTEGER (484..2147483647) sub MSG_SIZE_DEFAULT_TCP6 { 1440 } # Ethernet(1500) - IPv6(40) - TCP(20) # [public methods] ----------------------------------------------------------- sub domain { return DOMAIN_TCPIPV6; # transportDomainTcpIpv6 } sub type { return 'TCP/IPv6'; # tcpIpv6(6) } # [private methods] ---------------------------------------------------------- sub _msg_size_default { return MSG_SIZE_DEFAULT_TCP6; } sub _tdomain { return $_[0]->_scope_id($_[1]) ? DOMAIN_TCPIPV6Z : DOMAIN_TCPIPV6; } # ============================================================================ 1; # [end Net::SNMP::Transport::TCP6] PK��X�\�wʱ��Transport/IPv6.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Transport::IPv6; # $Id: IPv6.pm,v 1.1 2009/09/09 15:08:31 dtown Rel $ # Base object for the IPv6 Transport Domains. # Copyright (c) 2008-2009 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 Net::SNMP::Transport qw( DEBUG_INFO ); use Socket6 0.23 qw( PF_INET6 AF_INET6 in6addr_any in6addr_loopback getaddrinfo pack_sockaddr_in6_all unpack_sockaddr_in6_all inet_pton inet_ntop ); ## Version of the Net::SNMP::Transport::IPv6 module our $VERSION = v1.0.0; # [public methods] ----------------------------------------------------------- sub agent_addr { return '0.0.0.0'; } sub sock_flowinfo { return $_[0]->_flowinfo($_[0]->sock_name()); } sub sock_scope_id { return $_[0]->_scope_id($_[0]->sock_name()); } sub sock_tzone { goto &sock_scope_id; } sub dest_flowinfo { return $_[0]->_flowinfo($_[0]->dest_name()); } sub dest_scope_id { return $_[0]->_scope_id($_[0]->dest_name()); } sub dest_tzone { goto &dest_scope_id; } sub peer_flowinfo { return $_[0]->_flowinfo($_[0]->peer_name()); } sub peer_scope_id { return $_[0]->_scope_id($_[0]->peer_name()); } sub peer_tzone { goto &peer_scope_id; } # [private methods] ---------------------------------------------------------- sub _protocol_family { return PF_INET6; } sub _addr_any { return in6addr_any; } sub _addr_loopback { return in6addr_loopback; } sub _hostname_resolve { my ($this, $host, $nh) = @_; $nh->{addr} = undef; # See if the service/port was included in the address. my $serv = ($host =~ s/^\[(.+)\]:([\w\/]+)$/$1/) ? $2 : undef; if (defined($serv) && (!defined $this->_service_resolve($serv, $nh))) { return $this->_error('Failed to resolve the %s service', $this->type()); } # See if the scope zone index was included in the address. $nh->{scope_id} = ($host =~ s/%(\d+)$//) ? $1 : 0; # <address>%<index> # Resolve the address. my @info = getaddrinfo(($_[1] = $host), q{}, PF_INET6); if (@info >= 5) { if ($host =~ s/(.)%.$/$1/) { # <address>%<ifName> $_[1] = $1; } while (@info >= 5) { if ($info[0] == PF_INET6) { $nh->{flowinfo} = $this->_flowinfo($info[3]); $nh->{scope_id} \|\|= $this->_scope_id($info[3]); return $nh->{addr} = $this->_addr($info[3]); } DEBUG_INFO('family = %d, sin = %s', $info[0], unpack 'H', $info[3]); splice @info, 0, 5; } } else { DEBUG_INFO('getaddrinfo(): %s', $info[0]); if ((my @host = split /:/, $host) == 2) { # <hostname>:<service> $_[1] = sprintf '[%s]:%s', @host; return $this->_hostname_resolve($_[1], $nh); } } # Last attempt to resolve the address. if (!defined $nh->{addr}) { $nh->{addr} = inet_pton(AF_INET6, $host); } if (!defined $nh->{addr}) { return $this->_error( q{Unable to resolve the %s address "%s"}, $this->type(), $host ); } return $nh->{addr}; } sub _name_pack { return pack_sockaddr_in6_all( $_[1]->{port}, $_[1]->{flowinfo} \|\| 0, $_[1]->{addr}, $_[1]->{scope_id} \|\| 0 ); } sub _address { return inet_ntop(AF_INET6, $_[0]->_addr($_[1])); } sub _addr { return (unpack_sockaddr_in6_all($_[1]))[2]; } sub _port { return (unpack_sockaddr_in6_all($_[1]))[0]; } sub _taddress { my $s = $_[0]->_scope_id($_[1]); $s = $s ? sprintf('%%%u', $s) : q{}; return sprintf '[%s%s]:%u', $_[0]->_address($_[1]), $s, $_[0]->_port($_[1]); } sub _taddr { my $s = $_[0]->_scope_id($_[1]); $s = $s ? pack('N', $s) : q{}; return $_[0]->_addr($_[1]) . $s . pack 'n', $_[0]->_port($_[1]); } sub _scope_id { return (unpack_sockaddr_in6_all($_[1]))[3]; } sub _flowinfo { return (unpack_sockaddr_in6_all($_[1]))[1]; } # ============================================================================ 1; # [end Net::SNMP::Transport::IPv6] PK��X�\��=U�i��i��PDU.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::PDU; # $Id: PDU.pm,v 3.1 2010/09/10 00:01:22 dtown Rel $ # Object used to represent a SNMP PDU. # 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 Net::SNMP::Message qw( :types :versions asn1_itoa ENTERPRISE_SPECIFIC TRUE FALSE DEBUG_INFO ); use Net::SNMP::Transport qw( DOMAIN_UDPIPV4 DOMAIN_TCPIPV4 ); ## Version of the Net::SNMP::PDU module our $VERSION = v3.0.1; ## Handle importing/exporting of symbols use base qw( Net::SNMP::Message ); sub import { return Net::SNMP::Message->export_to_level(1, @_); } # [public methods] ----------------------------------------------------------- sub new { my $class = shift; # We play some games here to allow us to "convert" a Message into a PDU. my $this = ref($_[0]) ? bless shift(@_), $class : $class->SUPER::new(); # Override or initialize fields inherited from the base class $this->{_error_status} = 0; $this->{_error_index} = 0; $this->{_scoped} = FALSE; $this->{_var_bind_list} = undef; $this->{_var_bind_names} = []; $this->{_var_bind_types} = undef; my (%argv) = @_; # Validate the passed arguments for (keys %argv) { if (/^-?callback$/i) { $this->callback($argv{$_}); } elsif (/^-?contextengineid/i) { $this->context_engine_id($argv{$_}); } elsif (/^-?contextname/i) { $this->context_name($argv{$_}); } elsif (/^-?debug$/i) { $this->debug($argv{$_}); } elsif (/^-?leadingdot$/i) { $this->leading_dot($argv{$_}); } elsif (/^-?maxmsgsize$/i) { $this->max_msg_size($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; } } if (!defined $this->{_transport}) { $this->_error('The Transport Domain object is not defined'); return wantarray ? (undef, $this->{_error}) : undef; } return wantarray ? ($this, q{}) : $this; } sub prepare_get_request { my ($this, $oids) = @_; $this->_error_clear(); return $this->prepare_pdu(GET_REQUEST, $this->_create_oid_null_pairs($oids)); } sub prepare_get_next_request { my ($this, $oids) = @_; $this->_error_clear(); return $this->prepare_pdu(GET_NEXT_REQUEST, $this->_create_oid_null_pairs($oids)); } sub prepare_get_response { my ($this, $trios) = @_; $this->_error_clear(); return $this->prepare_pdu(GET_RESPONSE, $this->_create_oid_value_pairs($trios)); } sub prepare_set_request { my ($this, $trios) = @_; $this->_error_clear(); return $this->prepare_pdu(SET_REQUEST, $this->_create_oid_value_pairs($trios)); } sub prepare_trap { my ($this, $enterprise, $addr, $generic, $specific, $time, $trios) = @_; $this->_error_clear(); return $this->_error('Insufficient arguments for a Trap-PDU') if (@_ < 6); # enterprise if (!defined $enterprise) { # Use iso(1).org(3).dod(6).internet(1).private(4).enterprises(1) # for the default enterprise. $this->{_enterprise} = '1.3.6.1.4.1'; } elsif ($enterprise !~ m/^\.?\d+(?:\.\d+)* $/) { return $this->_error( 'The enterprise OBJECT IDENTIFIER "%s" is expected in dotted ' . 'decimal notation', $enterprise ); } else { $this->{_enterprise} = $enterprise; } # agent-addr if (!defined $addr) { # See if we can get the agent-addr from the Transport # Layer. If not, we return an error. if (defined $this->{_transport}) { if (($this->{_transport}->domain() ne DOMAIN_UDPIPV4) && ($this->{_transport}->domain() ne DOMAIN_TCPIPV4)) { $this->{_agent_addr} = '0.0.0.0'; } else { $this->{_agent_addr} = $this->{_transport}->agent_addr(); if ($this->{_agent_addr} eq '0.0.0.0') { delete $this->{_agent_addr}; } } } if (!exists $this->{_agent_addr}) { return $this->_error('Unable to resolve the local agent-addr'); } } elsif ($addr !~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { return $this->_error( 'The agent-addr "%s" is expected in dotted decimal notation', $addr ); } else { $this->{_agent_addr} = $addr; } # generic-trap if (!defined $generic) { # Use enterpriseSpecific(6) for the generic-trap type. $this->{_generic_trap} = ENTERPRISE_SPECIFIC; } elsif ($generic !~ /^\d+$/) { return $this->_error( 'The generic-trap value "%s" is expected in positive numeric format', $generic ); } else { $this->{_generic_trap} = $generic; } # specific-trap if (!defined $specific) { $this->{_specific_trap} = 0; } elsif ($specific !~ /^\d+$/) { return $this->_error( 'The specific-trap value "%s" is expected in positive numeric format', $specific ); } else { $this->{_specific_trap} = $specific; } # time-stamp if (!defined $time) { # Use the "uptime" of the script for the time-stamp. $this->{_time_stamp} = ((time() - $^T) 100); } elsif ($time !~ /^\d+$/) { return $this->_error( 'The time-stamp value "%s" is expected in positive numeric format', $time ); } else { $this->{_time_stamp} = $time; } return $this->prepare_pdu(TRAP, $this->_create_oid_value_pairs($trios)); } sub prepare_get_bulk_request { my ($this, $repeaters, $repetitions, $oids) = @_; $this->_error_clear(); if (@_ < 3) { return $this->_error('Insufficient arguments for a GetBulkRequest-PDU'); } # non-repeaters if (!defined $repeaters) { $this->{_error_status} = 0; } elsif ($repeaters !~ /^\d+$/) { return $this->_error( 'The non-repeaters value "%s" is expected in positive numeric format', $repeaters ); } elsif ($repeaters > 2147483647) { return $this->_error( 'The non-repeaters value %s is out of range (0..2147483647)', $repeaters ); } else { $this->{_error_status} = $repeaters; } # max-repetitions if (!defined $repetitions) { $this->{_error_index} = 0; } elsif ($repetitions !~ /^\d+$/) { return $this->_error( 'The max-repetitions value "%s" is expected in positive numeric ' . 'format', $repetitions ); } elsif ($repetitions > 2147483647) { return $this->_error( 'The max-repetitions value %s is out of range (0..2147483647)', $repetitions ); } else { $this->{_error_index} = $repetitions; } # Some sanity checks if (defined($oids) && (ref($oids) eq 'ARRAY')) { if ($this->{_error_status} > @{$oids}) { return $this->_error( 'The non-repeaters value %d is greater than the number of ' . 'variable-bindings %d', $this->{_error_status}, scalar @{$oids} ); } if (($this->{_error_status} == @{$oids}) && ($this->{_error_index})) { return $this->_error( 'The non-repeaters value %d equals the number of variable-' . 'bindings and max-repetitions is not equal to zero', $this->{_error_status} ); } } return $this->prepare_pdu(GET_BULK_REQUEST, $this->_create_oid_null_pairs($oids)); } sub prepare_inform_request { my ($this, $trios) = @_; $this->_error_clear(); return $this->prepare_pdu(INFORM_REQUEST, $this->_create_oid_value_pairs($trios)); } sub prepare_snmpv2_trap { my ($this, $trios) = @_; $this->_error_clear(); return $this->prepare_pdu(SNMPV2_TRAP, $this->_create_oid_value_pairs($trios)); } sub prepare_report { my ($this, $trios) = @_; $this->_error_clear(); return $this->prepare_pdu(REPORT, $this->_create_oid_value_pairs($trios)); } sub prepare_pdu { my ($this, $type, $var_bind) = @_; # Clear the buffer $this->clear(); # Clear the "scoped" indication $this->{_scoped} = FALSE; # VarBindList::=SEQUENCE OF VarBind if (!defined $this->_prepare_var_bind_list($var_bind \|\| [])) { return $this->_error(); } # PDU::=SEQUENCE if (!defined $this->_prepare_pdu_sequence($type)) { return $this->_error(); } return TRUE; } sub prepare_var_bind_list { my ($this, $var_bind) = @_; return $this->_prepare_var_bind_list($var_bind \|\| []); } sub prepare_pdu_sequence { goto &_prepare_pdu_sequence; } sub prepare_pdu_scope { goto &_prepare_pdu_scope; } sub process_pdu { my ($this) = @_; # Clear any errors $this->_error_clear(); # PDU::=SEQUENCE return $this->_error() if !defined $this->_process_pdu_sequence(); # VarBindList::=SEQUENCE OF VarBind return $this->_process_var_bind_list(); } sub process_pdu_scope { goto &_process_pdu_scope; } sub process_pdu_sequence { goto &_process_pdu_sequence; } sub process_var_bind_list { goto &_process_var_bind_list; } sub expect_response { my ($this) = @_; if (($this->{_pdu_type} == GET_RESPONSE) \|\| ($this->{_pdu_type} == TRAP) \|\| ($this->{_pdu_type} == SNMPV2_TRAP) \|\| ($this->{_pdu_type} == REPORT)) { return FALSE; } return TRUE; } sub pdu_type { return $_[0]->{_pdu_type}; } sub error_status { my ($this, $status) = @_; # error-status::=INTEGER { noError(0) .. inconsistentName(18) } if (@_ == 2) { if (!defined $status) { return $this->_error('The error-status value is not defined'); } if (($status < 0) \|\| ($status > (($this->version > SNMP_VERSION_1) ? 18 : 5))) { return $this->_error( 'The error-status %s is out of range (0..%d)', $status, ($this->version > SNMP_VERSION_1) ? 18 : 5 ); } $this->{_error_status} = $status; } return $this->{_error_status} \|\| 0; # noError(0) } sub error_index { my ($this, $index) = @_; # error-index::=INTEGER (0..max-bindings) if (@_ == 2) { if (!defined $index) { return $this->_error('The error-index value is not defined'); } if (($index < 0) \|\| ($index > 2147483647)) { return $this->_error( 'The error-index value %s is out of range (0.. 2147483647)', $index ); } $this->{_error_index} = $index; } return $this->{_error_index} \|\| 0; } sub non_repeaters { # non-repeaters::=INTEGER (0..max-bindings) return $_[0]->{_error_status} \|\| 0; } sub max_repetitions { # max-repetitions::=INTEGER (0..max-bindings) return $_[0]->{_error_index} \|\| 0; } sub enterprise { return $_[0]->{_enterprise}; } sub agent_addr { return $_[0]->{_agent_addr}; } sub generic_trap { return $_[0]->{_generic_trap}; } sub specific_trap { return $_[0]->{_specific_trap}; } sub time_stamp { return $_[0]->{_time_stamp}; } sub var_bind_list { my ($this, $vbl, $types) = @_; return if defined $this->{_error}; if (@_ > 1) { # The VarBindList HASH is being updated from an external # source. We need to update the VarBind names ARRAY to # correspond to the new keys of the HASH. If the updated # information is valid, we will use lexicographical ordering # for the ARRAY entries since we do not have a PDU to use # to determine the ordering. The ASN.1 types HASH is also # updated here if a cooresponding HASH is passed. We double # check the mapping by populating the hash with the keys of # the VarBindList HASH. if (!defined($vbl) \|\| (ref($vbl) ne 'HASH')) { $this->{_var_bind_list} = undef; $this->{_var_bind_names} = []; $this->{_var_bind_types} = undef; } else { $this->{_var_bind_list} = $vbl; @{$this->{_var_bind_names}} = map { $_->[0] } sort { $a->[1] cmp $b->[1] } map { my $oid = $_; $oid =~ s/^\.//; $oid =~ s/ /\.0/g; [$_, pack 'N', split m/\./, $oid] } keys %{$vbl}; if (!defined($types) \|\| (ref($types) ne 'HASH')) { $types = {}; } for (keys %{$vbl}) { $this->{_var_bind_types}->{$_} = exists($types->{$_}) ? $types->{$_} : undef; } } } return $this->{_var_bind_list}; } sub var_bind_names { my ($this) = @_; return [] if defined($this->{_error}) \|\| !defined $this->{_var_bind_names}; return $this->{_var_bind_names}; } sub var_bind_types { my ($this) = @_; return if defined $this->{_error}; return $this->{_var_bind_types}; } sub scoped { return $_[0]->{_scoped}; } # [private methods] ---------------------------------------------------------- sub _prepare_pdu_scope { my ($this) = @_; return TRUE if (($this->{_version} < SNMP_VERSION_3) \|\| ($this->{_scoped})); # contextName::=OCTET STRING if (!defined $this->prepare(OCTET_STRING, $this->context_name())) { return $this->_error(); } # contextEngineID::=OCTET STRING if (!defined $this->prepare(OCTET_STRING, $this->context_engine_id())) { return $this->_error(); } # ScopedPDU::=SEQUENCE if (!defined $this->prepare(SEQUENCE)) { return $this->_error(); } # Indicate that this PDU has been scoped and return success. return $this->{_scoped} = TRUE; } sub _prepare_pdu_sequence { my ($this, $type) = @_; # Do not do anything if there has already been an error return $this->_error() if defined $this->{_error}; # Make sure the PDU type was passed return $this->_error('The SNMP PDU type is not defined') if (@_ != 2); # Set the PDU type $this->{_pdu_type} = $type; # Make sure the request-id has been set if (!exists $this->{_request_id}) { $this->{_request_id} = int rand 2147483648; } # We need to encode everything in reverse order so the # objects end up in the correct place. if ($this->{_pdu_type} != TRAP) { # PDU::=SEQUENCE # error-index/max-repetitions::=INTEGER if (!defined $this->prepare(INTEGER, $this->{_error_index})) { return $this->_error(); } # error-status/non-repeaters::=INTEGER if (!defined $this->prepare(INTEGER, $this->{_error_status})) { return $this->_error(); } # request-id::=INTEGER if (!defined $this->prepare(INTEGER, $this->{_request_id})) { return $this->_error(); } } else { # Trap-PDU::=IMPLICIT SEQUENCE # time-stamp::=TimeTicks if (!defined $this->prepare(TIMETICKS, $this->{_time_stamp})) { return $this->_error(); } # specific-trap::=INTEGER if (!defined $this->prepare(INTEGER, $this->{_specific_trap})) { return $this->_error(); } # generic-trap::=INTEGER if (!defined $this->prepare(INTEGER, $this->{_generic_trap})) { return $this->_error(); } # agent-addr::=NetworkAddress if (!defined $this->prepare(IPADDRESS, $this->{_agent_addr})) { return $this->_error(); } # enterprise::=OBJECT IDENTIFIER if (!defined $this->prepare(OBJECT_IDENTIFIER, $this->{_enterprise})) { return $this->_error(); } } # PDUs::=CHOICE if (!defined $this->prepare($this->{_pdu_type})) { return $this->_error(); } return TRUE; } sub _prepare_var_bind_list { my ($this, $var_bind) = @_; # The passed array is expected to consist of groups of four values # consisting of two sets of ASN.1 types and their values. if (@{$var_bind} % 4) { $this->var_bind_list(undef); return $this->_error( 'The VarBind list size of %d is not a factor of 4', scalar @{$var_bind} ); } # Initialize the "var_bind_" data. $this->{_var_bind_list} = {}; $this->{_var_bind_names} = []; $this->{_var_bind_types} = {}; # Use the object's buffer to build each VarBind SEQUENCE and then append # it to a local buffer. The local buffer will then be used to create # the VarBindList SEQUENCE. my ($buffer, $name_type, $name_value, $syntax_type, $syntax_value) = (q{}); while (@{$var_bind}) { # Pull a quartet of ASN.1 types and values from the passed array. ($name_type, $name_value, $syntax_type, $syntax_value) = splice @{$var_bind}, 0, 4; # Reverse the order of the fields because prepare() does a prepend. # value::=ObjectSyntax if (!defined $this->prepare($syntax_type, $syntax_value)) { $this->var_bind_list(undef); return $this->_error(); } # name::=ObjectName if ($name_type != OBJECT_IDENTIFIER) { $this->var_bind_list(undef); return $this->_error( 'An ObjectName type of 0x%02x was expected, but 0x%02x was found', OBJECT_IDENTIFIER, $name_type ); } if (!defined $this->prepare($name_type, $name_value)) { $this->var_bind_list(undef); return $this->_error(); } # VarBind::=SEQUENCE if (!defined $this->prepare(SEQUENCE)) { $this->var_bind_list(undef); return $this->_error(); } # Append the VarBind to the local buffer and clear it. $buffer .= $this->clear(); # Populate the "var_bind_" data so we can provide consistent # output for the methods regardless of whether we are a request # or a response PDU. Make sure the HASH key is unique if in # case duplicate OBJECT IDENTIFIERs are provided. while (exists $this->{_var_bind_list}->{$name_value}) { $name_value .= q{ }; # Pad with spaces } $this->{_var_bind_list}->{$name_value} = $syntax_value; $this->{_var_bind_types}->{$name_value} = $syntax_type; push @{$this->{_var_bind_names}}, $name_value; } # VarBindList::=SEQUENCE OF VarBind if (!defined $this->prepare(SEQUENCE, $buffer)) { $this->var_bind_list(undef); return $this->_error(); } return TRUE; } sub _create_oid_null_pairs { my ($this, $oids) = @_; return [] if !defined $oids; if (ref($oids) ne 'ARRAY') { return $this->_error( 'The OBJECT IDENTIFIER list is expected as an array reference' ); } my $pairs = []; for (@{$oids}) { push @{$pairs}, OBJECT_IDENTIFIER, $_, NULL, q{}; } return $pairs; } sub _create_oid_value_pairs { my ($this, $trios) = @_; return [] if !defined $trios; if (ref($trios) ne 'ARRAY') { return $this->_error('The trio list is expected as an array reference'); } if (@{$trios} % 3) { return $this->_error( 'The [OBJECT IDENTIFIER, ASN.1 type, object value] trio is expected' ); } my $pairs = []; for (my $i = 0; $i < $#{$trios}; $i += 3) { push @{$pairs}, OBJECT_IDENTIFIER, $trios->[$i], $trios->[$i+1], $trios->[$i+2]; } return $pairs; } sub _process_pdu_scope { my ($this) = @_; return TRUE if ($this->{_version} < SNMP_VERSION_3); # ScopedPDU::=SEQUENCE return $this->_error() if !defined $this->process(SEQUENCE); # contextEngineID::=OCTET STRING if (!defined $this->context_engine_id($this->process(OCTET_STRING))) { return $this->_error(); } # contextName::=OCTET STRING if (!defined $this->context_name($this->process(OCTET_STRING))) { return $this->_error(); } # Indicate that this PDU is scoped and return success. return $this->{_scoped} = TRUE; } sub _process_pdu_sequence { my ($this) = @_; # PDUs::=CHOICE if (!defined ($this->{_pdu_type} = $this->process())) { return $this->_error(); } if ($this->{_pdu_type} != TRAP) { # PDU::=SEQUENCE # request-id::=INTEGER if (!defined ($this->{_request_id} = $this->process(INTEGER))) { return $this->_error(); } # error-status::=INTEGER if (!defined ($this->{_error_status} = $this->process(INTEGER))) { return $this->_error(); } # error-index::=INTEGER if (!defined ($this->{_error_index} = $this->process(INTEGER))) { return $this->_error(); } # Indicate that we have an SNMP error, but do not return an error. if (($this->{_error_status}) && ($this->{_pdu_type} == GET_RESPONSE)) { $this->_error( 'Received %s error-status at error-index %d', _error_status_itoa($this->{_error_status}), $this->{_error_index} ); } } else { # Trap-PDU::=IMPLICIT SEQUENCE # enterprise::=OBJECT IDENTIFIER if (!defined ($this->{_enterprise} = $this->process(OBJECT_IDENTIFIER))) { return $this->_error(); } # agent-addr::=NetworkAddress if (!defined ($this->{_agent_addr} = $this->process(IPADDRESS))) { return $this->_error(); } # generic-trap::=INTEGER if (!defined ($this->{_generic_trap} = $this->process(INTEGER))) { return $this->_error(); } # specific-trap::=INTEGER if (!defined ($this->{_specific_trap} = $this->process(INTEGER))) { return $this->_error(); } # time-stamp::=TimeTicks if (!defined ($this->{_time_stamp} = $this->process(TIMETICKS))) { return $this->_error(); } } return TRUE; } sub _process_var_bind_list { my ($this) = @_; my $value; # VarBindList::=SEQUENCE if (!defined($value = $this->process(SEQUENCE))) { return $this->_error(); } # Using the length of the VarBindList SEQUENCE, # calculate the end index. my $end = $this->index() + $value; $this->{_var_bind_list} = {}; $this->{_var_bind_names} = []; $this->{_var_bind_types} = {}; my ($oid, $type); while ($this->index() < $end) { # VarBind::=SEQUENCE if (!defined $this->process(SEQUENCE)) { return $this->_error(); } # name::=ObjectName if (!defined ($oid = $this->process(OBJECT_IDENTIFIER))) { return $this->_error(); } # value::=ObjectSyntax if (!defined ($value = $this->process(undef, $type))) { return $this->_error(); } # Create a hash consisting of the OBJECT IDENTIFIER as a # key and the ObjectSyntax as the value. If there is a # duplicate OBJECT IDENTIFIER in the VarBindList, we pad # that OBJECT IDENTIFIER with spaces to make a unique # key in the hash. while (exists $this->{_var_bind_list}->{$oid}) { $oid .= q{ }; # Pad with spaces } DEBUG_INFO('{ %s => %s: %s }', $oid, asn1_itoa($type), $value); $this->{_var_bind_list}->{$oid} = $value; $this->{_var_bind_types}->{$oid} = $type; # Create an array with the ObjectName OBJECT IDENTIFIERs # so that the order in which the VarBinds where encoded # in the PDU can be retrieved later. push @{$this->{_var_bind_names}}, $oid; } # Return an error based on the contents of the VarBindList # if we received a Report-PDU. if ($this->{_pdu_type} == REPORT) { return $this->_report_pdu_error(); } # Return the var_bind_list hash return $this->{_var_bind_list}; } { my @error_status = qw( noError tooBig noSuchName badValue readOnly genError noAccess wrongType wrongLength wrongEncoding wrongValue noCreation inconsistentValue resourceUnavailable commitFailed undoFailed authorizationError notWritable inconsistentName ); sub _error_status_itoa { return '??' if (@_ != 1); if (($_[0] > $#error_status) \|\| ($_[0] < 0)) { return sprintf '??(%d)', $_[0]; } return sprintf '%s(%d)', $error_status[$_[0]], $_[0]; } } { my %report_oids = ( '1.3.6.1.6.3.11.2.1.1' => 'snmpUnknownSecurityModels', '1.3.6.1.6.3.11.2.1.2' => 'snmpInvalidMsgs', '1.3.6.1.6.3.11.2.1.3' => 'snmpUnknownPDUHandlers', '1.3.6.1.6.3.12.1.4' => 'snmpUnavailableContexts', '1.3.6.1.6.3.12.1.5' => 'snmpUnknownContexts', '1.3.6.1.6.3.15.1.1.1' => 'usmStatsUnsupportedSecLevels', '1.3.6.1.6.3.15.1.1.2' => 'usmStatsNotInTimeWindows', '1.3.6.1.6.3.15.1.1.3' => 'usmStatsUnknownUserNames', '1.3.6.1.6.3.15.1.1.4' => 'usmStatsUnknownEngineIDs', '1.3.6.1.6.3.15.1.1.5' => 'usmStatsWrongDigests', '1.3.6.1.6.3.15.1.1.6' => 'usmStatsDecryptionErrors', ); sub _report_pdu_error { my ($this) = @_; # Remove the leading dot (if present) and replace the dotted notation # of the OBJECT IDENTIFIER with the text ObjectName based upon an # expected list of report OBJECT IDENTIFIERs. my %var_bind_list; for my $oid (@{$this->{_var_bind_names}}) { my $text = $oid; $text =~ s/^\.//; for (keys %report_oids) { if ($text =~ s/\Q$_/$report_oids{$_}/) { last; } } $var_bind_list{$text} = $this->{_var_bind_list}->{$oid}; } my $count = keys %var_bind_list; if ($count == 1) { # Return the OBJECT IDENTIFIER and value. my $text = (keys %var_bind_list)[0]; return $this->_error( 'Received %s Report-PDU with value %s', $text, $var_bind_list{$text} ); } elsif ($count > 1) { # Return a list of OBJECT IDENTIFIERs. return $this->_error( 'Received Report-PDU [%s]', join ', ', keys %var_bind_list ); } else { return $this->_error('Received empty Report-PDU'); } } } # ============================================================================ 1; # [end Net::SNMP::PDU] PK��X�\<\ͩ�4��4��MessageProcessing.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::MessageProcessing; # $Id: MessageProcessing.pm,v 3.1 2010/09/10 00:01:22 dtown Rel $ # Object that implements the Message Processing module. # 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 Net::SNMP::PDU qw( :types :msgFlags :securityLevels asn1_itoa SNMP_VERSION_3 TRUE FALSE ); srand( time() ^ ($$ + ($$ <<15)) ); ## Version of the Net::SNMP::MessageProcessing module our $VERSION = v3.0.1; ## Package variables our $INSTANCE; # Reference to the Singleton object our $DEBUG = FALSE; # Debug flag ## Object array indexes sub _ERROR { 0 } # Error message sub _HANDLES { 1 } # Cached request messages BEGIN { # See if there is a better pseudorandom number generator (PRNG) available. if (eval 'require Math::Random::MT::Auto') { Math::Random::MT::Auto->import('rand'); } } # [public methods] ----------------------------------------------------------- sub instance { return $INSTANCE \|\|= Net::SNMP::MessageProcessing->_new(); } sub prepare_outgoing_msg { my ($this, $pdu) = @_; # Clear any previous errors $this->_error_clear(); if ((@_ != 2) \|\| (!ref $pdu)) { return $this->_error('The PDU object is missing or invalid'); } # We must have a Security Model in order to prepare the message. if (!defined $pdu->security()) { return $this->_error('The Security Model object is not defined'); } # Create a new Message my ($msg, $error) = Net::SNMP::Message->new( -callback => $pdu->callback(), -leadingdot => $pdu->leading_dot(), -requestid => $pdu->request_id(), -security => $pdu->security(), -translate => $pdu->translate(), -transport => $pdu->transport(), -version => $pdu->version() ); return $this->_error($error) if !defined $msg; if ($pdu->version() == SNMP_VERSION_3) { # ScopedPDU::=SEQUENCE if (!defined $pdu->prepare_pdu_scope()) { return $this->_error($pdu->error()); } # We need to copy the contextEngineID and contextName to the # request message so that they are available for comparison # with the response message. $msg->context_engine_id($pdu->context_engine_id()); $msg->context_name($pdu->context_name()); # Set a new msgID for each message unless the PDU type is a # GetResponse-PDU or a Report-PDU. if (($pdu->pdu_type() != GET_RESPONSE) && ($pdu->pdu_type() != REPORT)) { $pdu->msg_id($this->msg_handle_alloc()); } # msgGlobalData::=SEQUENCE if (!defined $this->_prepare_global_data($pdu, $msg)) { return $this->_error(); } } # Pass off to the Security Model if (!defined $pdu->security()->generate_request_msg($pdu, $msg)) { return $this->_error($pdu->security()->error()); } # If a response to the message is expected, add the message to the # cache using the msgId (request-id) has the lookup "handle". if ($pdu->expect_response()) { $this->[_HANDLES]->{$msg->msg_id()} = $msg; } # Return the new message. return $msg; } sub prepare_data_elements { my ($this, $msg) = @_; # Clear any previous errors $this->_error_clear(); if ((@_ != 2) \|\| (!ref $msg)) { return $this->_error('The Message object is missing or invalid'); } # message::=SEQUENCE return $this->_error($msg->error()) if !defined $msg->process(SEQUENCE); # version::=INTEGER if (!defined $msg->version($msg->process(INTEGER))) { return $this->_error($msg->error()); } # Find the request message in the cache. We are assuming this # message is a response to an outstanding request. my $request; if ($msg->version() == SNMP_VERSION_3) { # msgGlobalData::=SEQUENCE if (!defined $this->_process_global_data($msg)) { return $this->_error(); } $request = $this->msg_handle_delete($msg->msg_id()); } else { # community::=OCTET STRING if (!defined $msg->security_name($msg->process(OCTET_STRING))) { return $this->_error($msg->error()); } # Cast the Message to a PDU if (!defined($msg = Net::SNMP::PDU->new($msg))) { return $this->_error('Failed to allocate a new PDU object'); } # PDU::=SEQUENCE if (!defined $msg->process_pdu_sequence()) { return $this->_error($msg->error()); } if ($msg->pdu_type() != GET_RESPONSE) { return $this->_error( 'A %s was expected, but %s was found', asn1_itoa(GET_RESPONSE), asn1_itoa($msg->pdu_type()) ); } $request = $this->msg_handle_delete($msg->request_id()); } # Was a matching request found? if (!defined $request) { return $this->_error('No matching request message was found'); } # Update the received message with the relevant request data. $msg->callback($request->callback()); $msg->timeout_id($request->timeout_id()); $msg->transport($request->transport()); # Now that we have found the matching request for this response # we return a FALSE error instead of undefined so that the error # gets propagated back to the user. # Compare the Security Models if ($msg->msg_security_model() != $request->msg_security_model()) { $this->_error( 'The msgSecurityModel %d was expected, but %d was found', $request->msg_security_model(), $msg->msg_security_model() ); return FALSE; } $msg->security($request->security()); # Pass off to the Security Model if (!defined $request->security()->process_incoming_msg($msg)) { $this->_error($request->security()->error()); return FALSE; } if ($msg->version() == SNMP_VERSION_3) { # Adjust our maxMsgSize if necessary if ($msg->msg_max_size() < $request->max_msg_size()) { DEBUG_INFO('new maxMsgSize = %d', $msg->msg_max_size()); if (!defined $request->max_msg_size($msg->msg_max_size())) { $this->_error($request->error()); return FALSE; } } # Cast the Message to a PDU if (!defined($msg = Net::SNMP::PDU->new($msg))) { $this->_error('Failed to allocate new PDU object'); return FALSE; } # ScopedPDU::=SEQUENCE if (!defined $msg->process_pdu_scope()) { $this->_error($msg->error()); return FALSE; } # PDU::=SEQUENCE if (!defined $msg->process_pdu_sequence()) { $this->_error($msg->error()); return FALSE; } if ($msg->pdu_type() != REPORT) { if ($msg->pdu_type() != GET_RESPONSE) { $this->_error( 'A %s was expected, but %s was found', asn1_itoa(GET_RESPONSE), asn1_itoa($msg->pdu_type()) ); return FALSE; } # Compare the contextEngineID if ($msg->context_engine_id() ne $request->context_engine_id()) { $this->_error( 'The contextEngineID "%s" was expected, but "%s" was found', unpack('H', $request->context_engine_id()), unpack('H', $msg->context_engine_id()), ); return FALSE; } # Compare the contextName if ($msg->context_name() ne $request->context_name()) { $this->_error( 'The contextName "%s" was expected, but "%s" was found', $request->context_name(), $msg->context_name() ); return FALSE; } # Check the request-id if ($msg->request_id() != $request->request_id()) { $this->_error( 'The request-id %d was expected, but %d was found', $request->request_id(), $msg->request_id() ); return FALSE; } } } # Now update the message with format parameters. $msg->leading_dot($request->leading_dot()); $msg->translate($request->translate()); # VarBindList::=SEQUENCE OF VarBind if (!defined $msg->process_var_bind_list()) { $this->_error($msg->error()); return FALSE; } # Return the PDU return $msg; } sub msg_handle_alloc { my ($this) = @_; # Limit message handles by RFC 3412 - msgID::=INTEGER (0..2147483647) my $handle = int rand(2147483648); while (exists $this->[_HANDLES]->{$handle} && keys %{$this->[_HANDLES]->{$handle}} < 2147483648) { $handle = int rand(2147483648); } return $handle; } sub msg_handle_delete { my ($this, $handle) = @_; # Clear any previous errors $this->_error_clear(); return $this->_error('No msgHandle was specified') if (@_ < 2); if (!exists $this->[_HANDLES]->{$handle}) { return $this->_error('The msgHandle %d was not found', $handle); } return delete $this->[_HANDLES]->{$handle}; } sub error { return $_[0]->[_ERROR] \|\| q{}; } sub debug { return (@_ == 2) ? $DEBUG = ($_[1]) ? TRUE : FALSE : $DEBUG; } # [private methods] ---------------------------------------------------------- sub _new { my ($class) = @_; # The constructor is private since we only want one MessageProcessing # object. We also reserve message handle (request-id/msgID) 0 so that # it is not used for valid messages. return bless [ undef, { 0, undef } ], $class; } sub _prepare_global_data { my ($this, $pdu, $msg) = @_; # msgSecurityModel::=INTEGER if (!defined $msg->prepare( INTEGER, $msg->msg_security_model($pdu->msg_security_model()) ) ) { return $this->_error($msg->error()); } # msgFlags::=OCTET STRING my $security_level = $pdu->security_level(); my $msg_flags = MSG_FLAGS_NOAUTHNOPRIV \| MSG_FLAGS_REPORTABLE; if ($security_level > SECURITY_LEVEL_NOAUTHNOPRIV) { $msg_flags \|= MSG_FLAGS_AUTH; if ($security_level > SECURITY_LEVEL_AUTHNOPRIV) { $msg_flags \|= MSG_FLAGS_PRIV; } } if (!$pdu->expect_response()) { $msg_flags &= ~MSG_FLAGS_REPORTABLE; } if (!defined $msg->prepare(OCTET_STRING, pack 'C', $msg_flags)) { $this->_error($msg->error()); } $msg->msg_flags($msg_flags); # msgMaxSize::=INTEGER if (!defined $msg->prepare(INTEGER, $msg->msg_max_size($pdu->max_msg_size())) ) { return $this->_error($msg->error()); } # msgID::=INTEGER if (!defined $msg->prepare(INTEGER, $msg->msg_id($pdu->msg_id()))) { return $this->_error($msg->error()); } # msgGlobalData::=SEQUENCE if (!defined $msg->prepare(SEQUENCE)) { return $this->_error($msg->error()); } return TRUE; } sub _process_global_data { my ($this, $msg) = @_; # msgGlobalData::=SEQUENCE return $this->_error($msg->error()) if !defined $msg->process(SEQUENCE); # msgID::=INTEGER if (!defined $msg->msg_id($msg->process(INTEGER))) { return $this->_error($msg->error()); } # msgMaxSize::=INTEGER if (!defined $msg->msg_max_size($msg->process(INTEGER))) { return $this->_error($msg->error()); } # msgFlags::=OCTET STRING my $msg_flags = $msg->process(OCTET_STRING); if (!defined $msg_flags) { return $this->_error($msg->error()); } if (CORE::length($msg_flags) != 1) { return $this->_error( 'The msgFlags length of %d is invalid', CORE::length($msg_flags) ); } $msg->msg_flags($msg_flags = unpack 'C', $msg_flags); # Validate the msgFlags and derive the securityLevel. my $security_level = SECURITY_LEVEL_NOAUTHNOPRIV; if ($msg_flags & MSG_FLAGS_AUTH) { $security_level = SECURITY_LEVEL_AUTHNOPRIV; if ($msg_flags & MSG_FLAGS_PRIV) { $security_level = SECURITY_LEVEL_AUTHPRIV; } } elsif ($msg_flags & MSG_FLAGS_PRIV) { # RFC 3412 - Section 7.2 1d: "If the authFlag is not set # and privFlag is set... ...the message is discarded..." return $this->_error('The msgFlags value 0x%02x is invalid', $msg_flags); } # RFC 3412 - Section 7.2 1e: "Any other bits... ...are ignored." if ($msg_flags & ~MSG_FLAGS_MASK) { DEBUG_INFO('questionable msgFlags value 0x%02x', $msg_flags); } $msg->security_level($security_level); # msgSecurityModel::=INTEGER if (!defined $msg->msg_security_model($msg->process(INTEGER))) { return $this->_error($msg->error()); } return TRUE; } 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; } 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::MessageProcessing] PK��X�\!zh�Y��Y��Transport.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Transport; # $Id: Transport.pm,v 3.0 2009/09/09 15:05:33 dtown Rel $ # Base object for the Net::SNMP Transport Domain objects. # Copyright (c) 2004-2009 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; ## Version of the Net::SNMP::Transport module our $VERSION = v3.0.0; ## Handle importing/exporting of symbols use base qw( Exporter ); our @EXPORT_OK = qw( TRUE FALSE DEBUG_INFO ); our %EXPORT_TAGS = ( domains => [ qw( DOMAIN_UDP DOMAIN_UDPIPV4 DOMAIN_UDPIPV6 DOMAIN_UDPIPV6Z DOMAIN_TCPIPV4 DOMAIN_TCPIPV6 DOMAIN_TCPIPV6Z ) ], msgsize => [ qw( MSG_SIZE_DEFAULT MSG_SIZE_MINIMUM MSG_SIZE_MAXIMUM ) ], ports => [ qw( SNMP_PORT SNMP_TRAP_PORT ) ], retries => [ qw( RETRIES_DEFAULT RETRIES_MINIMUM RETRIES_MAXIMUM ) ], timeout => [ qw( TIMEOUT_DEFAULT TIMEOUT_MINIMUM TIMEOUT_MAXIMUM ) ], ); Exporter::export_ok_tags( qw( domains msgsize ports retries timeout ) ); $EXPORT_TAGS{ALL} = [ @EXPORT_OK ]; ## Transport Layer Domain definitions # RFC 3417 Transport Mappings for SNMP # Presuhn, Case, McCloghrie, Rose, and Waldbusser; December 2002 sub DOMAIN_UDP { '1.3.6.1.6.1.1' } # snmpUDPDomain # RFC 3419 Textual Conventions for Transport Addresses # Consultant, Schoenwaelder, and Braunschweig; December 2002 sub DOMAIN_UDPIPV4 { '1.3.6.1.2.1.100.1.1' } # transportDomainUdpIpv4 sub DOMAIN_UDPIPV6 { '1.3.6.1.2.1.100.1.2' } # transportDomainUdpIpv6 sub DOMAIN_UDPIPV6Z { '1.3.6.1.2.1.100.1.4' } # transportDomainUdpIpv6z sub DOMAIN_TCPIPV4 { '1.3.6.1.2.1.100.1.5' } # transportDomainTcpIpv4 sub DOMAIN_TCPIPV6 { '1.3.6.1.2.1.100.1.6' } # transportDomainTcpIpv6 sub DOMAIN_TCPIPV6Z { '1.3.6.1.2.1.100.1.8' } # transportDomainTcpIpv6z ## SNMP well-known ports sub SNMP_PORT { 161 } sub SNMP_TRAP_PORT { 162 } ## RFC 3411 - snmpEngineMaxMessageSize::=INTEGER (484..2147483647) sub MSG_SIZE_DEFAULT { 484 } sub MSG_SIZE_MINIMUM { 484 } sub MSG_SIZE_MAXIMUM { 65535 } # 2147483647 is not reasonable sub RETRIES_DEFAULT { 1 } sub RETRIES_MINIMUM { 0 } sub RETRIES_MAXIMUM { 20 } sub TIMEOUT_DEFAULT { 5.0 } sub TIMEOUT_MINIMUM { 1.0 } sub TIMEOUT_MAXIMUM { 60.0 } ## Truth values sub TRUE { 0x01 } sub FALSE { 0x00 } ## Shared socket array indexes sub _SHARED_SOCKET { 0 } # Shared Socket object sub _SHARED_REFC { 1 } # Reference count sub _SHARED_MAXSIZE { 2 } # Shared maxMsgSize ## Package variables our $DEBUG = FALSE; # Debug flag our $AUTOLOAD; # Used by the AUTOLOAD method our $SOCKETS = {}; # List of shared sockets # [public methods] ----------------------------------------------------------- { my $domains = { 'udp/?(?:ip)?v?4?', DOMAIN_UDPIPV4, quotemeta DOMAIN_UDP, DOMAIN_UDPIPV4, quotemeta DOMAIN_UDPIPV4, DOMAIN_UDPIPV4, 'udp/?(?:ip)?v?6', DOMAIN_UDPIPV6, quotemeta DOMAIN_UDPIPV6, DOMAIN_UDPIPV6, quotemeta DOMAIN_UDPIPV6Z, DOMAIN_UDPIPV6, 'tcp/?(?:ip)?v?4?', DOMAIN_TCPIPV4, quotemeta DOMAIN_TCPIPV4, DOMAIN_TCPIPV4, 'tcp/?(?:ip)?v?6', DOMAIN_TCPIPV6, quotemeta DOMAIN_TCPIPV6, DOMAIN_TCPIPV6, quotemeta DOMAIN_TCPIPV6Z, DOMAIN_TCPIPV6, }; sub new { my ($class, %argv) = @_; my $domain = DOMAIN_UDPIPV4; my $error = q{}; # See if a Transport Layer Domain argument has been passed. for (keys %argv) { if (/^-?domain$/i) { my $key = $argv{$_}; $domain = undef; for (keys %{$domains}) { if ($key =~ /^$_$/i) { $domain = $domains->{$_}; last; } } if (!defined $domain) { $error = err_msg( 'The transport domain "%s" is unknown', $argv{$_} ); return wantarray ? (undef, $error) : undef; } $argv{$_} = $domain; } } # Return the appropriate object based on the Transport Domain. To # avoid consuming unnecessary resources, only load the appropriate # module when requested. Some modules require non-core modules and # if these modules are not present, we gracefully return an error. if ($domain eq DOMAIN_UDPIPV6) { if (defined ($error = load_module('Net::SNMP::Transport::IPv6::UDP'))) { $error = 'UDP/IPv6 support is unavailable ' . $error; return wantarray ? (undef, $error) : undef; } return Net::SNMP::Transport::IPv6::UDP->new(%argv); } elsif ($domain eq DOMAIN_TCPIPV6) { if (defined ($error = load_module('Net::SNMP::Transport::IPv6::TCP'))) { $error = 'TCP/IPv6 support is unavailable ' . $error; return wantarray ? (undef, $error) : undef; } return Net::SNMP::Transport::IPv6::TCP->new(%argv); } elsif ($domain eq DOMAIN_TCPIPV4) { if (defined ($error = load_module('Net::SNMP::Transport::IPv4::TCP'))) { $error = 'TCP/IPv4 support is unavailable ' . $error; return wantarray ? (undef, $error) : undef; } return Net::SNMP::Transport::IPv4::TCP->new(%argv); } # Load the default Transport Domain module without eval protection. require Net::SNMP::Transport::IPv4::UDP; return Net::SNMP::Transport::IPv4::UDP->new(%argv); } } sub max_msg_size { my ($this, $size) = @_; if (@_ < 2) { return $this->{_max_msg_size}; } $this->_error_clear(); if ($size !~ m/^\d+$/) { return $this->_error( 'The maxMsgSize value "%s" is expected in positive numeric format', $size ); } if ($size < MSG_SIZE_MINIMUM \|\| $size > MSG_SIZE_MAXIMUM) { return $this->_error( 'The maxMsgSize value %s is out of range (%d..%d)', $size, MSG_SIZE_MINIMUM, MSG_SIZE_MAXIMUM ); } # Adjust the share maximum size if necessary. $this->_shared_max_size($size); return $this->{_max_msg_size} = $size; } sub timeout { my ($this, $timeout) = @_; if (@_ < 2) { return $this->{_timeout}; } $this->_error_clear(); if ($timeout !~ m/^\d+(?:\.\d+)?$/) { return $this->_error( 'The timeout value "%s" is expected in positive numeric format', $timeout ); } if ($timeout < TIMEOUT_MINIMUM \|\| $timeout > TIMEOUT_MAXIMUM) { return $this->_error( 'The timeout value %s is out of range (%d..%d)', $timeout, TIMEOUT_MINIMUM, TIMEOUT_MAXIMUM ); } return $this->{_timeout} = $timeout; } sub retries { my ($this, $retries) = @_; if (@_ < 2) { return $this->{_retries}; } $this->_error_clear(); if ($retries !~ m/^\d+$/) { return $this->_error( 'The retries value "%s" is expected in positive numeric format', $retries ); } if ($retries < RETRIES_MINIMUM \|\| $retries > RETRIES_MAXIMUM) { return $this->_error( 'The retries value %s is out of range (%d..%d)', $retries, RETRIES_MINIMUM, RETRIES_MAXIMUM ); } return $this->{_retries} = $retries; } sub agent_addr { return '0.0.0.0'; } sub connectionless { return TRUE; } sub debug { return (@_ == 2) ? $DEBUG = ($_[1]) ? TRUE : FALSE : $DEBUG; } sub domain { return '0.0'; } sub error { return $_[0]->{_error} \|\| q{}; } sub fileno { return defined($_[0]->{_socket}) ? $_[0]->{_socket}->fileno() : undef; } sub socket { return $_[0]->{_socket}; } sub type { return '<unknown>'; # unknown(0) } sub sock_name { if (defined $_[0]->{_socket}) { return $_[0]->{_socket}->sockname() \|\| $_[0]->{_sock_name}; } else { return $_[0]->{_sock_name}; } } sub sock_hostname { return $_[0]->{_sock_hostname} \|\| $_[0]->sock_address(); } sub sock_address { return $_[0]->_address($_[0]->sock_name()); } sub sock_addr { return $_[0]->_addr($_[0]->sock_name()); } sub sock_port { return $_[0]->_port($_[0]->sock_name()); } sub sock_taddress { return $_[0]->_taddress($_[0]->sock_name()); } sub sock_taddr { return $_[0]->_taddr($_[0]->sock_name()); } sub sock_tdomain { return $_[0]->_tdomain($_[0]->sock_name()); } sub dest_name { return $_[0]->{_dest_name}; } sub dest_hostname { return $_[0]->{_dest_hostname} \|\| $_[0]->dest_address(); } sub dest_address { return $_[0]->_address($_[0]->dest_name()); } sub dest_addr { return $_[0]->_addr($_[0]->dest_name()); } sub dest_port { return $_[0]->_port($_[0]->dest_name()); } sub dest_taddress { return $_[0]->_taddress($_[0]->dest_name()); } sub dest_taddr { return $_[0]->_taddr($_[0]->dest_name()); } sub dest_tdomain { return $_[0]->_tdomain($_[0]->dest_name()); } sub peer_name { if (defined $_[0]->{_socket}) { return $_[0]->{_socket}->peername() \|\| $_[0]->dest_name(); } else { return $_[0]->dest_name(); } } sub peer_hostname { return $_[0]->peer_address(); } sub peer_address { return $_[0]->_address($_[0]->peer_name()); } sub peer_addr { return $_[0]->_addr($_[0]->peer_name()); } sub peer_port { return $_[0]->_port($_[0]->peer_name()); } sub peer_taddress { return $_[0]->_taddress($_[0]->peer_name()); } sub peer_taddr { return $_[0]->_taddr($_[0]->peer_name()); } sub peer_tdomain { return $_[0]->_tdomain($_[0]->peer_name()); } sub AUTOLOAD { my $this = shift; return if $AUTOLOAD =~ /::DESTROY$/; $AUTOLOAD =~ s/.://; if (ref $this) { if (defined($this->{_socket}) && ($this->{_socket}->can($AUTOLOAD))) { return $this->{_socket}->$AUTOLOAD(@_); } else { $this->_error_clear(); return $this->_error( 'The method "%s" is not supported by this Transport Domain', $AUTOLOAD ); } } else { require Carp; Carp::croak(sprintf 'The function "%s" is not supported', $AUTOLOAD); } # Never get here. return; } sub DESTROY { my ($this) = @_; # Connection-oriented transports do not share sockets. return if !$this->connectionless(); # If the shared socket structure exists, decrement the reference count # and clear the shared socket structure if it is no longer being used. if (defined($this->{_sock_name}) && exists $SOCKETS->{$this->{_sock_name}}) { if (--$SOCKETS->{$this->{_sock_name}}->[_SHARED_REFC] < 1) { delete $SOCKETS->{$this->{_sock_name}}; } } return; } ## Obsolete methods - previous deprecated sub OBSOLETE { my ($this, $method) = splice @_, 0, 2; require Carp; Carp::croak( sprintf '%s() is obsolete, use %s() instead', (caller 1)[3], $method ); # Never get here. return $this->${\$method}(@_); } sub name { return $_[0]->OBSOLETE('type'); } sub srcaddr { return $_[0]->OBSOLETE('sock_addr'); } sub srcport { return $_[0]->OBSOLETE('sock_port'); } sub srchost { return $_[0]->OBSOLETE('sock_address'); } sub srcname { return $_[0]->OBSOLETE('sock_address'); } sub dstaddr { return $_[0]->OBSOLETE('dest_addr'); } sub dstport { return $_[0]->OBSOLETE('dest_port'); } sub dsthost { return $_[0]->OBSOLETE('dest_address'); } sub dstname { return $_[0]->OBSOLETE('dest_hostname'); } sub recvaddr { return $_[0]->OBSOLETE('peer_addr'); } sub recvport { return $_[0]->OBSOLETE('peer_port'); } sub recvhost { return $_[0]->OBSOLETE('peer_address'); } # [private methods] ---------------------------------------------------------- sub _new { my ($class, %argv) = @_; my $this = bless { '_dest_hostname' => 'localhost', # Destination hostname '_dest_name' => undef, # Destination sockaddr '_error' => undef, # Error message '_max_msg_size' => $class->_msg_size_default(), # maxMsgSize '_retries' => RETRIES_DEFAULT, # Number of retries '_socket' => undef, # Socket object '_sock_hostname' => q{}, # Socket hostname '_sock_name' => undef, # Socket sockaddr '_timeout' => TIMEOUT_DEFAULT, # Timeout period (secs) }, $class; # Default the values for the "name (sockaddr) hashes". my $sock_nh = { port => 0, addr => $this->_addr_any() }; my $dest_nh = { port => SNMP_PORT, addr => $this->_addr_loopback() }; # Validate the "port" arguments first to allow for a consistency # check with any values passed with the "address" arguments. my ($dest_port, $sock_port, $listen) = (undef, undef, 0); for (keys %argv) { if (/^-?debug$/i) { $this->debug(delete $argv{$_}); } elsif (/^-?(?:de?st\|peer)?port$/i) { $this->_service_resolve(delete($argv{$_}), $dest_nh); $dest_port = $dest_nh->{port}; } elsif (/^-?(?:src\|sock\|local)port$/i) { $this->_service_resolve(delete($argv{$_}), $sock_nh); $sock_port = $sock_nh->{port}; } if (defined $this->{_error}) { return wantarray ? (undef, $this->{_error}) : undef; } } # Validate the rest of the arguments. for (keys %argv) { if (/^-?domain$/i) { if ($argv{$_} ne $this->domain()) { $this->_error( 'The domain value "%s" was expected, but "%s" was found', $this->domain(), $argv{$_} ); } } elsif ((/^-?hostname$/i) \|\| (/^-?(?:de?st\|peer)?addr$/i)) { $this->_hostname_resolve( $this->{_dest_hostname} = $argv{$_}, $dest_nh ); if (defined($dest_port) && ($dest_port != $dest_nh->{port})) { $this->_error( 'Inconsistent %s port information was specified (%d != %d)', $this->type(), $dest_port, $dest_nh->{port} ); } } elsif (/^-?(?:src\|sock\|local)addr$/i) { $this->_hostname_resolve( $this->{_sock_hostname} = $argv{$_}, $sock_nh ); if (defined($sock_port) && ($sock_port != $sock_nh->{port})) { $this->_error( 'Inconsistent %s port information was specified (%d != %d)', $this->type(), $sock_port, $sock_nh->{port} ); } } elsif (/^-?listen$/i) { if (($argv{$_} !~ /^\d+$/) \|\| ($argv{$_} < 1)) { $this->_error( 'The listen queue size value "%s" was expected in positive ' . 'non-zero numeric format', $argv{$_} ); } elsif (!$this->connectionless()) { $listen = $argv{$_}; } } elsif ((/^-?maxmsgsize$/i) \|\| (/^-?mtu$/i)) { $this->max_msg_size($argv{$_}); } elsif (/^-?retries$/i) { $this->retries($argv{$_}); } elsif (/^-?timeout$/i) { $this->timeout($argv{$_}); } else { $this->_error('The argument "%s" is unknown', $_); } if (defined $this->{_error}) { return wantarray ? (undef, $this->{_error}) : undef; } } # Pack the socket name (sockaddr) information. $this->{_sock_name} = $this->_name_pack($sock_nh); # Pack the destination name (sockaddr) information. $this->{_dest_name} = $this->_name_pack($dest_nh); # For all connection-oriented transports and for each unique source # address for connectionless transports, create a new socket. if (!$this->connectionless() \|\| !exists $SOCKETS->{$this->{_sock_name}}) { # Create a new IO::Socket object. if (!defined ($this->{_socket} = $this->_socket_create())) { $this->_perror('Failed to open %s socket', $this->type()); return wantarray ? (undef, $this->{_error}) : undef } DEBUG_INFO('opened %s socket [%d]', $this->type(), $this->fileno()); # Bind the socket. if (!defined $this->{_socket}->bind($this->{_sock_name})) { $this->_perror('Failed to bind %s socket', $this->type()); return wantarray ? (undef, $this->{_error}) : undef } # For connection-oriented transports, we either listen or connect. if (!$this->connectionless()) { if ($listen) { if (!defined $this->{_socket}->listen($listen)) { $this->_perror('Failed to listen on %s socket', $this->type()); return wantarray ? (undef, $this->{_error}) : undef } } else { if (!defined $this->{_socket}->connect($this->{_dest_name})) { $this->_perror( q{Failed to connect to remote host '%s'}, $this->dest_hostname() ); return wantarray ? (undef, $this->{_error}) : undef } } } # Flag the socket as non-blocking outside of socket creation or # the object instantiation fails on some systems (e.g. MSWin32). $this->{_socket}->blocking(FALSE); # Add the socket to the global socket list with a reference # count to track when to close the socket and the maxMsgSize # associated with this new object for connectionless transports. if ($this->connectionless()) { $SOCKETS->{$this->{_sock_name}} = [ $this->{_socket}, # Shared Socket object 1, # Reference count $this->{_max_msg_size}, # Shared maximum message size ]; } } else { # Bump up the reference count. $SOCKETS->{$this->{_sock_name}}->[_SHARED_REFC]++; # Assign the socket to the object. $this->{_socket} = $SOCKETS->{$this->{_sock_name}}->[_SHARED_SOCKET]; # Adjust the shared maxMsgSize if necessary. $this->_shared_max_size($this->{_max_msg_size}); DEBUG_INFO('reused %s socket [%d]', $this->type(), $this->fileno()); } # Return the object and empty error message (in list context) return wantarray ? ($this, q{}) : $this; } sub _service_resolve { my ($this, $serv, $nh) = @_; $nh->{port} = undef; if ($serv !~ /^\d+$/) { my $port = ($serv =~ s/$(\d+)$$//) ? ($1 > 65535) ? undef : $1 : undef; $nh->{port} = getservbyname($serv, $this->_protocol_name()) \|\| $port; if (!defined $nh->{port}) { return $this->_error( 'Unable to resolve the %s service name "%s"', $this->type(), $_[1] ); } } elsif ($serv > 65535) { return $this->_error( 'The %s port number %s is out of range (0..65535)', $this->type(), $serv ); } else { $nh->{port} = $serv; } return $nh->{port}; } sub _protocol { return (getprotobyname $_[0]->_protocol_name())[2]; } sub _shared_max_size { my ($this, $size) = @_; # Connection-oriented transports do not share sockets. if (!$this->connectionless()) { return $this->{_max_msg_size}; } if (@_ == 2) { # Handle calls during object creation. if (!defined $this->{_sock_name}) { return $this->{_max_msg_size}; } # Update the shared maxMsgSize if the passed # value is greater than the current size. if ($size > $SOCKETS->{$this->{_sock_name}}->[_SHARED_MAXSIZE]) { $SOCKETS->{$this->{_sock_name}}->[_SHARED_MAXSIZE] = $size; } } return $SOCKETS->{$this->{_sock_name}}->[_SHARED_MAXSIZE]; } sub _msg_size_default { return MSG_SIZE_DEFAULT; } 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 strerror { if ($! =~ /^Unknown error/) { return sprintf '%s', $^E if ($^E); require Errno; for (keys (%!)) { if ($!{$_}) { return sprintf 'Error %s', $_; } } return sprintf '%s (%d)', $!, $!; } return $! ? sprintf('%s', $!) : 'No error'; } sub _perror { my $this = shift; if (!defined $this->{_error}) { $this->{_error} = ((@_ > 1) ? sprintf(shift(@_), @_) : $_[0]) \|\| q{}; $this->{_error} .= (($this->{_error}) ? ': ' : q{}) . strerror(); if ($this->debug()) { printf "error: [%d] %s(): %s\n", (caller 0)[2], (caller 1)[3], $this->{_error}; } } return; } sub _error_clear { $! = 0; return $_[0]->{_error} = undef; } { my %modules; sub load_module { my ($module) = @_; # We attempt to load the required module under the protection of an # eval statement. If there is a failure, typically it is due to a # missing module required by the requested module and we attempt to # simplify the error message by just listing that module. We also # need to track failures since require() only produces an error on # the first attempt to load the module. # NOTE: Contrary to our typical convention, a return value of "undef" # actually means success and a defined value means error. return $modules{$module} if exists $modules{$module}; if (!eval "require $module") { if ($@ =~ /locate (\S+\.pm)/) { $modules{$module} = err_msg('(Required module %s not found)', $1); } elsif ($@ =~ /(.)\n/) { $modules{$module} = err_msg('(%s)', $1); } else { $modules{$module} = err_msg('(%s)', $@); } } else { $modules{$module} = undef; } return $modules{$module}; } } sub err_msg { my $msg = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0]; if ($DEBUG) { printf "error: [%d] %s(): %s\n", (caller 0)[2], (caller 1)[3], $msg; } return $msg; } 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::Transport] PK��X�\i��A�G��G�� Dispatcher.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Dispatcher; # $Id: Dispatcher.pm,v 4.1 2010/09/10 00:01:22 dtown Rel $ # Object that dispatches SNMP messages and handles the scheduling of events. # 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 Errno; use Net::SNMP::MessageProcessing(); use Net::SNMP::Message qw( TRUE FALSE ); ## Version of the Net::SNMP::Dispatcher module our $VERSION = v4.0.1; ## Package variables our $INSTANCE; # Reference to our Singleton object our $DEBUG = FALSE; # Debug flag our $MESSAGE_PROCESSING; # Reference to the Message Processing object ## Event array indexes sub _ACTIVE { 0 } # State of the event sub _TIME { 1 } # Execution time sub _CALLBACK { 2 } # Callback reference sub _PREVIOUS { 3 } # Previous event sub _NEXT { 4 } # Next event BEGIN { # Use a higher resolution of time() and possibly a monotonically # increasing time value if the Time::HiRes module is available. if (eval 'require Time::HiRes') { Time::HiRes->import('time'); no warnings; if (eval 'Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC())' > 0) { time = sub () { Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC()); }; } } # Validate the creation of the Message Processing object. if (!defined($MESSAGE_PROCESSING = Net::SNMP::MessageProcessing->instance())) { die 'FATAL: Failed to create Message Processing instance'; } } # [public methods] ----------------------------------------------------------- sub instance { return $INSTANCE \|\|= Net::SNMP::Dispatcher->_new(); } sub loop { my ($this) = @_; return TRUE if ($this->{_active}); $this->{_active} = TRUE; # Process while there are events and file descriptor handlers. while (defined $this->{_event_queue_h} \|\| keys %{$this->{_descriptors}}) { $this->_event_handle(undef); } return $this->{_active} = FALSE; } sub one_event { my ($this) = @_; return TRUE if ($this->{_active}); if (defined $this->{_event_queue_h} \|\| keys %{$this->{_descriptors}}) { $this->{_active} = TRUE; $this->_event_handle(0); $this->{_active} = FALSE; } return (defined $this->{_event_queue_h} \|\| keys %{$this->{_descriptors}}); } sub activate { goto &loop; } sub listen { goto &loop; } sub send_pdu { my ($this, $pdu, $delay) = @_; # Clear any previous errors $this->_error_clear(); if ((@_ < 2) \|\| !ref $pdu) { return $this->_error('The required PDU object is missing or invalid'); } # If the Dispatcher is active and the delay value is negative, # send the message immediately. if ($delay < 0) { if ($this->{_active}) { return $this->_send_pdu($pdu, $pdu->retries()); } $delay = 0; } $this->schedule($delay, [\&_send_pdu, $pdu, $pdu->retries()]); return TRUE; } sub return_response_pdu { my ($this, $pdu) = @_; return $this->send_pdu($pdu, -1); } sub msg_handle_alloc { return $MESSAGE_PROCESSING->msg_handle_alloc(); } sub schedule { my ($this, $time, $callback) = @_; return $this->_event_create($time, $this->_callback_create($callback)); } sub cancel { my ($this, $event) = @_; return $this->_event_delete($event); } sub register { my ($this, $transport, $callback) = @_; # Transport Domain and file descriptor must be valid. my $fileno; if (!defined($transport) \|\| !defined($fileno = $transport->fileno())) { return $this->_error('The Transport Domain object is invalid'); } # NOTE: The callback must read the data associated with the # file descriptor or the Dispatcher will continuously # call the callback and get stuck in an infinite loop. if (!exists $this->{_descriptors}->{$fileno}) { # Make sure that the "readable" vector is defined. if (!defined $this->{_rin}) { $this->{_rin} = q{}; } # Add the file descriptor to the list. $this->{_descriptors}->{$fileno} = [ $this->_callback_create($callback), # Callback $transport, # Transport Domain object 1 # Reference count ]; # Add the file descriptor to the "readable" vector. vec($this->{_rin}, $fileno, 1) = 1; DEBUG_INFO('added handler for descriptor [%d]', $fileno); } else { # Bump up the reference count. $this->{_descriptors}->{$fileno}->[2]++; } return $transport; } sub deregister { my ($this, $transport) = @_; # Transport Domain and file descriptor must be valid. my $fileno; if (!defined($transport) \|\| !defined($fileno = $transport->fileno())) { return $this->_error('The Transport Domain object is invalid'); } if (exists $this->{_descriptors}->{$fileno}) { # Check reference count. if (--$this->{_descriptors}->{$fileno}->[2] < 1) { # Remove the file descriptor from the list. delete $this->{_descriptors}->{$fileno}; # Remove the file descriptor from the "readable" vector. vec($this->{_rin}, $fileno, 1) = 0; # Undefine the vector if there are no file descriptors, # some systems expect this to make select() work properly. if (!keys %{$this->{_descriptors}}) { $this->{_rin} = undef; } DEBUG_INFO('removed handler for descriptor [%d]', $fileno); } } else { return $this->_error('The Transport Domain object is not registered'); } return $transport; } sub error { return $_[0]->{_error} \|\| q{}; } sub debug { return (@_ == 2) ? $DEBUG = ($_[1]) ? TRUE : FALSE : $DEBUG; } # [private methods] ---------------------------------------------------------- sub _new { my ($class) = @_; # The constructor is private since we only want one # Dispatcher object. return bless { '_active' => FALSE, # State of this Dispatcher object '_error' => undef, # Error message '_event_queue_h' => undef, # Head of the event queue '_event_queue_t' => undef, # Tail of the event queue '_rin' => undef, # Readable vector for select() '_descriptors' => {}, # List of file descriptors to monitor }, $class; } sub _send_pdu { my ($this, $pdu, $retries) = @_; # Pass the PDU to Message Processing so that it can # create the new outgoing message. my $msg = $MESSAGE_PROCESSING->prepare_outgoing_msg($pdu); if (!defined $msg) { # Inform the command generator about the Message Processing error. $pdu->status_information($MESSAGE_PROCESSING->error()); return; } # Actually send the message. if (!defined $msg->send()) { # Delete the msgHandle. if ($pdu->expect_response()) { $MESSAGE_PROCESSING->msg_handle_delete($msg->msg_id()); } # A crude attempt to recover from temporary failures. if (($retries-- > 0) && ($!{EAGAIN} \|\| $!{EWOULDBLOCK})) { DEBUG_INFO('attempting recovery from temporary failure'); $this->schedule($pdu->timeout(), [\&_send_pdu, $pdu, $retries]); return FALSE; } # Inform the command generator about the send() error. $pdu->status_information($msg->error()); return; } # Schedule the timeout handler if the message expects a response. if ($pdu->expect_response()) { $this->register($msg->transport(), [\&_transport_response_received]); $msg->timeout_id( $this->schedule( $pdu->timeout(), [\&_transport_timeout, $pdu, $retries, $msg->msg_id()] ) ); } return TRUE; } sub _transport_timeout { my ($this, $pdu, $retries, $handle) = @_; # Stop waiting for responses. $this->deregister($pdu->transport()); # Delete the msgHandle. $MESSAGE_PROCESSING->msg_handle_delete($handle); if ($retries-- > 0) { # Resend a new message. DEBUG_INFO('retries left %d', $retries); return $this->_send_pdu($pdu, $retries); } else { # Inform the command generator about the timeout. $pdu->status_information( q{No response from remote host "%s"}, $pdu->hostname() ); return; } } sub _transport_response_received { my ($this, $transport) = @_; # Clear any previous errors $this->_error_clear(); if (!ref $transport) { die 'FATAL: The Transport Domain object is invalid'; } # Create a new Message object to receive the response my ($msg, $error) = Net::SNMP::Message->new(-transport => $transport); if (!defined $msg) { die sprintf 'Failed to create Message object: %s', $error; } # Read the message from the Transport Layer if (!defined $msg->recv()) { if (!$transport->connectionless()) { $this->deregister($transport); } return $this->_error($msg->error()); } # For connection-oriented Transport Domains, it is possible to # "recv" an empty buffer if reassembly is required. if (!$msg->length()) { DEBUG_INFO('ignoring zero length message'); return FALSE; } # Hand the message over to Message Processing. if (!defined $MESSAGE_PROCESSING->prepare_data_elements($msg)) { return $this->_error($MESSAGE_PROCESSING->error()); } # Set the error if applicable. if ($MESSAGE_PROCESSING->error()) { $msg->error($MESSAGE_PROCESSING->error()); } # Cancel the timeout. $this->cancel($msg->timeout_id()); # Stop waiting for responses. $this->deregister($transport); # Notify the command generator to process the response. return $msg->process_response_pdu(); } sub _event_create { my ($this, $time, $callback) = @_; # Create a new event anonymous array and add it to the queue. # The event is initialized based on the currrent state of the # Dispatcher object. If the Dispatcher is not currently running # the event needs to be created such that it will get properly # initialized when the Dispatcher is started. return $this->_event_insert( [ $this->{_active}, # State of the object $this->{_active} ? time() + $time : $time, # Execution time $callback, # Callback reference undef, # Previous event undef, # Next event ] ); } sub _event_insert { my ($this, $event) = @_; # If the head of the list is not defined, we _must_ be the only # entry in the list, so create a new head and tail reference. if (!defined $this->{_event_queue_h}) { DEBUG_INFO('created new head and tail [%s]', $event); return $this->{_event_queue_h} = $this->{_event_queue_t} = $event; } # Estimate the midpoint of the list by calculating the average of # the time associated with the head and tail of the list. Based # on this value either start at the head or tail of the list to # search for an insertion point for the new Event. my $midpoint = (($this->{_event_queue_h}->[_TIME] + $this->{_event_queue_t}->[_TIME]) / 2); if ($event->[_TIME] >= $midpoint) { # Search backwards from the tail of the list for (my $e = $this->{_event_queue_t}; defined $e; $e = $e->[_PREVIOUS]) { if ($e->[_TIME] <= $event->[_TIME]) { $event->[_PREVIOUS] = $e; $event->[_NEXT] = $e->[_NEXT]; if ($e eq $this->{_event_queue_t}) { DEBUG_INFO('modified tail [%s]', $event); $this->{_event_queue_t} = $event; } else { DEBUG_INFO('inserted [%s] into list', $event); $e->[_NEXT]->[_PREVIOUS] = $event; } return $e->[_NEXT] = $event; } } DEBUG_INFO('added [%s] to head of list', $event); $event->[_NEXT] = $this->{_event_queue_h}; $this->{_event_queue_h} = $this->{_event_queue_h}->[_PREVIOUS] = $event; } else { # Search forward from the head of the list for (my $e = $this->{_event_queue_h}; defined $e; $e = $e->[_NEXT]) { if ($e->[_TIME] > $event->[_TIME]) { $event->[_NEXT] = $e; $event->[_PREVIOUS] = $e->[_PREVIOUS]; if ($e eq $this->{_event_queue_h}) { DEBUG_INFO('modified head [%s]', $event); $this->{_event_queue_h} = $event; } else { DEBUG_INFO('inserted [%s] into list', $event); $e->[_PREVIOUS]->[_NEXT] = $event; } return $e->[_PREVIOUS] = $event; } } DEBUG_INFO('added [%s] to tail of list', $event); $event->[_PREVIOUS] = $this->{_event_queue_t}; $this->{_event_queue_t} = $this->{_event_queue_t}->[_NEXT] = $event; } return $event; } sub _event_delete { my ($this, $event) = @_; my $info = q{}; # Update the previous event if (defined $event->[_PREVIOUS]) { $event->[_PREVIOUS]->[_NEXT] = $event->[_NEXT]; } elsif ($event eq $this->{_event_queue_h}) { if (defined ($this->{_event_queue_h} = $event->[_NEXT])) { $info = sprintf ', defined new head [%s]', $event->[_NEXT]; } else { DEBUG_INFO('deleted [%s], list is now empty', $event); $this->{_event_queue_t} = undef @{$event}; return FALSE; # Indicate queue is empty } } else { die 'FATAL: Attempted to delete Event object with an invalid head'; } # Update the next event if (defined $event->[_NEXT]) { $event->[_NEXT]->[_PREVIOUS] = $event->[_PREVIOUS]; } elsif ($event eq $this->{_event_queue_t}) { $info .= sprintf ', defined new tail [%s]', $event->[_PREVIOUS]; $this->{_event_queue_t} = $event->[_PREVIOUS]; } else { die 'FATAL: Attempted to delete Event object with an invalid tail'; } DEBUG_INFO('deleted [%s]%s', $event, $info); undef @{$event}; # Indicate queue still has entries return TRUE; } sub _event_init { my ($this, $event) = @_; DEBUG_INFO('initializing event [%s]', $event); # Save the time and callback because they will be cleared. my ($time, $callback) = @{$event}[_TIME, _CALLBACK]; # Remove the event from the queue. $this->_event_delete($event); # Update the appropriate fields. $event->[_ACTIVE] = $this->{_active}; $event->[_TIME] = $this->{_active} ? time() + $time : $time; $event->[_CALLBACK] = $callback; # Insert the event back into the queue. $this->_event_insert($event); return TRUE; } sub _event_handle { my ($this, $timeout) = @_; my $time = time(); if (defined (my $event = $this->{_event_queue_h})) { # If the event was inserted with a non-zero delay while the # Dispatcher was not active, the scheduled time of the event # needs to be updated. if (!$event->[_ACTIVE] && $event->[_TIME]) { return $this->_event_init($event); } if ($event->[_TIME] <= $time) { # If the scheduled time of the event is past, execute it and # set the timeout to zero to poll the descriptors immediately. $this->_callback_execute($event->[_CALLBACK]); $this->_event_delete($event); $timeout = 0; } elsif (!defined $timeout) { # Calculate the timeout for the next event unless one was # specified by the caller. $timeout = $event->[_TIME] - $time; DEBUG_INFO('event [%s], timeout = %.04f', $event, $timeout); } } # Check the file descriptors for activity. my $nfound = select(my $rout = $this->{_rin}, undef, undef, $timeout); if (!defined $nfound \|\| $nfound < 0) { if ($!{EINTR}) { # Recoverable error return FALSE; } else { die sprintf 'FATAL: select() error: %s', $!; } } elsif ($nfound > 0) { # Find out which file descriptors have data ready for reading. if (defined $rout) { for (keys %{$this->{_descriptors}}) { if (vec $rout, $_, 1) { DEBUG_INFO('descriptor [%d] ready for read', $_); $this->_callback_execute(@{$this->{_descriptors}->{$_}}[0,1]); } } } } return TRUE; } sub _callback_create { my ($this, $callback) = @_; # Callbacks can be passed in two different ways. If the callback # has options, the callback must be passed as an ARRAY reference # with the first element being a CODE reference and the remaining # elements the arguments. If the callback has no options it is # just passed as a CODE reference. if ((ref($callback) eq 'ARRAY') && (ref($callback->[0]) eq 'CODE')) { return $callback; } elsif (ref($callback) eq 'CODE') { return [$callback]; } else { return []; } } sub _callback_execute { my ($this, @argv) = @_; # The callback is invoked passing a reference to this object # with the parameters passed by the user next and then any # parameters that the caller provides. my ($callback, @user_argv) = @{shift @argv}; # Protect ourselves from user error. eval { $callback->($this, @user_argv, @argv); }; return ($@) ? $this->_error($@) : TRUE; } 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; } 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::Dispatcher] PK��X�\]dC��Security.pmnu��[��# -- mode: perl -- # ============================================================================ package Net::SNMP::Security; # $Id: Security.pm,v 2.0 2009/09/09 15:05:33 dtown Rel $ # Base object that implements the Net::SNMP Security Models. # Copyright (c) 2001-2009 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 Net::SNMP::Message qw( :securityLevels :securityModels :versions TRUE FALSE ); ## Version of the Net::SNMP::Security module our $VERSION = v2.0.0; ## Handle importing/exporting of symbols use base qw( Exporter ); our @EXPORT_OK = qw( DEBUG_INFO ); our %EXPORT_TAGS = ( levels => [ qw( SECURITY_LEVEL_NOAUTHNOPRIV SECURITY_LEVEL_AUTHNOPRIV SECURITY_LEVEL_AUTHPRIV ) ], models => [ qw( SECURITY_MODEL_ANY SECURITY_MODEL_SNMPV1 SECURITY_MODEL_SNMPV2C SECURITY_MODEL_USM ) ] ); Exporter::export_ok_tags( qw( levels models ) ); $EXPORT_TAGS{ALL} = [ @EXPORT_OK ]; ## Package variables our $DEBUG = FALSE; # Debug flag our $AUTOLOAD; # Used by the AUTOLOAD method #perl2exe_include Net::SNMP::Security::USM # [public methods] ----------------------------------------------------------- sub new { my ($class, %argv) = @_; my $version = SNMP_VERSION_1; # See if a SNMP version has been passed for (keys %argv) { if (/^-?version$/i) { if (($argv{$_} == SNMP_VERSION_1) \|\| ($argv{$_} == SNMP_VERSION_2C) \|\| ($argv{$_} == SNMP_VERSION_3)) { $version = $argv{$_}; } } } # Return the appropriate object based upon the SNMP version. To # avoid consuming unnecessary resources, only load the appropriate # module when requested. The Net::SNMP::Security::USM module # requires four non-core modules. If any of these modules are not # present, we gracefully return an error. if ($version == SNMP_VERSION_3) { if (defined(my $error = load_module('Net::SNMP::Security::USM'))) { $error = 'SNMPv3 support is unavailable ' . $error; return wantarray ? (undef, $error) : undef; } return Net::SNMP::Security::USM->new(%argv); } # Load the default Security module without eval protection. require Net::SNMP::Security::Community; return Net::SNMP::Security::Community->new(%argv); } sub version { my ($this) = @_; if (@_ > 1) { $this->_error_clear(); return $this->_error('The SNMP version is not modifiable'); } return $this->{_version}; } sub discovered { return TRUE; } sub security_model { # RFC 3411 - SnmpSecurityModel::=TEXTUAL-CONVENTION return SECURITY_MODEL_ANY; } sub security_level { # RFC 3411 - SnmpSecurityLevel::=TEXTUAL-CONVENTION return SECURITY_LEVEL_NOAUTHNOPRIV; } sub security_name { return q{}; } sub debug { return (@_ == 2) ? $DEBUG = ($_[1]) ? TRUE : FALSE : $DEBUG; } sub error { return $_[0]->{_error} \|\| q{}; } 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 by this Security Model', $AUTOLOAD ); } else { require Carp; Carp::croak(sprintf 'The function "%s" is not supported', $AUTOLOAD); } # Never get here. return; } # [private methods] ---------------------------------------------------------- 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; } { my %modules; sub load_module { my ($module) = @_; # We attempt to load the required module under the protection of an # eval statement. If there is a failure, typically it is due to a # missing module required by the requested module and we attempt to # simplify the error message by just listing that module. We also # need to track failures since require() only produces an error on # the first attempt to load the module. # NOTE: Contrary to our typical convention, a return value of "undef" # actually means success and a defined value means error. return $modules{$module} if exists $modules{$module}; if (!eval "require $module") { if ($@ =~ m/locate (\S+\.pm)/) { $modules{$module} = err_msg('(Required module %s not found)', $1); } elsif ($@ =~ m/(.)\n/) { $modules{$module} = err_msg('(%s)', $1); } else { $modules{$module} = err_msg('(%s)', $@); } } else { $modules{$module} = undef; } return $modules{$module}; } } sub err_msg { my $msg = (@_ > 1) ? sprintf(shift(@_), @_) : $_[0]; if ($DEBUG) { printf "error: [%d] %s(): %s\n", (caller 0)[2], (caller 1)[3], $msg; } return $msg; } sub DEBUG_INFO { return if (!$DEBUG); return printf sprintf('debug: [%d] %s(): ', (caller 0)[2], (caller 1)[3]) . ((@_ > 1) ? shift(@_) : '%s') . "\n", @_; } # ============================================================================ 1; # [end Net::SNMP::Security] PK��X�\��%����Security/USM.pmnu��[��PK��X�\�m�FW��W��i��Security/Community.pmnu��[��PK��X�\�G�р�� Message.pmnu��[��PK��X�\왜� �� Transport/IPv4.pmnu��[��PK��X�\��"G� �� Transport/IPv4/UDP.pmnu��[��PK��X�\�U�?�� Transport/IPv4/TCP.pmnu��[��PK��X�\��j��Transport/IPv6/UDP.pmnu��[��PK��X�\5~��Transport/IPv6/TCP.pmnu��[��PK��X�\�wʱ��Transport/IPv6.pmnu��[��PK��X�\��=U�i��i��PDU.pmnu��[��PK��X�\<\ͩ�4��4��=a�MessageProcessing.pmnu��[��PK��X�\!zh�Y��Y��K��Transport.pmnu��[��PK��X�\i��A�G��G�� Dispatcher.pmnu��[��PK��X�\]dC��7�Security.pmnu��[��PK��b��M��

| ver. 1.4 | Github | . | PHP 8.1.34 | ��֧ߧ֧�ѧ�ڧ� ��ѧߧڧ��: 0.2 | proxy | phpinfo | ��ѧ��ۧܧ�